1package Text::Password::Pronounceable; 2 3use strict; 4use warnings; 5use Carp; 6 7our $VERSION = '0.30'; 8 9# frequency of English digraphs (from D Edwards 1/27/66) 10my $frequency = [ 11 [ 12 4, 20, 28, 52, 2, 11, 28, 4, 32, 4, 6, 62, 23, 167, 13 2, 14, 0, 83, 76, 127, 7, 25, 8, 1, 9, 1 14 ], # aa - az 15 [ 16 13, 0, 0, 0, 55, 0, 0, 0, 8, 2, 0, 22, 0, 0, 17 11, 0, 0, 15, 4, 2, 13, 0, 0, 0, 15, 0 18 ], # ba - bz 19 [ 20 32, 0, 7, 1, 69, 0, 0, 33, 17, 0, 10, 9, 1, 0, 21 50, 3, 0, 10, 0, 28, 11, 0, 0, 0, 3, 0 22 ], # ca - cz 23 [ 24 40, 16, 9, 5, 65, 18, 3, 9, 56, 0, 1, 4, 15, 6, 25 16, 4, 0, 21, 18, 53, 19, 5, 15, 0, 3, 0 26 ], # da - dz 27 [ 28 84, 20, 55, 125, 51, 40, 19, 16, 50, 1, 29 4, 55, 54, 146, 35, 37, 6, 191, 149, 65, 30 9, 26, 21, 12, 5, 0 31 ], # ea - ez 32 [ 33 19, 3, 5, 1, 19, 21, 1, 3, 30, 2, 0, 11, 1, 0, 34 51, 0, 0, 26, 8, 47, 6, 3, 3, 0, 2, 0 35 ], # fa - fz 36 [ 37 20, 4, 3, 2, 35, 1, 3, 15, 18, 0, 0, 5, 1, 4, 38 21, 1, 1, 20, 9, 21, 9, 0, 5, 0, 1, 0 39 ], # ga - gz 40 [ 41 101, 1, 3, 0, 270, 5, 1, 6, 57, 0, 0, 0, 3, 2, 42 44, 1, 0, 3, 10, 18, 6, 0, 5, 0, 3, 0 43 ], # ha - hz 44 [ 45 40, 7, 51, 23, 25, 9, 11, 3, 0, 0, 2, 38, 25, 202, 46 56, 12, 1, 46, 79, 117, 1, 22, 0, 4, 0, 3 47 ], # ia - iz 48 [ 49 3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0, 0, 50 4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0 51 ], # ja - jz 52 [ 53 1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0, 2, 54 0, 0, 0, 0, 6, 2, 1, 0, 2, 0, 1, 0 55 ], # ka - kz 56 [ 57 44, 2, 5, 12, 62, 7, 5, 2, 42, 1, 1, 53, 2, 2, 58 25, 1, 1, 2, 16, 23, 9, 0, 1, 0, 33, 0 59 ], # la - lz 60 [ 61 52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7, 1, 62 17, 18, 1, 2, 12, 3, 8, 0, 1, 0, 2, 0 63 ], # ma - mz 64 [ 65 42, 10, 47, 122, 63, 19, 106, 12, 30, 1, 66 6, 6, 9, 7, 54, 7, 1, 7, 44, 124, 67 6, 1, 15, 0, 12, 0 68 ], # na - nz 69 [ 70 7, 12, 14, 17, 5, 95, 3, 5, 14, 0, 0, 19, 41, 134, 71 13, 23, 0, 91, 23, 42, 55, 16, 28, 0, 4, 1 72 ], # oa - oz 73 [ 74 19, 1, 0, 0, 37, 0, 0, 4, 8, 0, 0, 15, 1, 0, 75 27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0 76 ], # pa - pz 77 [ 78 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 79 0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0 80 ], # qa - qz 81 [ 82 83, 8, 16, 23, 169, 4, 8, 8, 77, 1, 10, 5, 26, 16, 83 60, 4, 0, 24, 37, 55, 6, 11, 4, 0, 28, 0 84 ], # ra - rz 85 [ 86 65, 9, 17, 9, 73, 13, 1, 47, 75, 3, 0, 7, 11, 12, 87 56, 17, 6, 9, 48, 116, 35, 1, 28, 0, 4, 0 88 ], # sa - sz 89 [ 90 57, 22, 3, 1, 76, 5, 2, 330, 126, 1, 91 0, 14, 10, 6, 79, 7, 0, 49, 50, 56, 92 21, 2, 27, 0, 24, 0 93 ], # ta - tz 94 [ 95 11, 5, 9, 6, 9, 1, 6, 0, 9, 0, 1, 19, 5, 31, 96 1, 15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0 97 ], # ua - uz 98 [ 99 7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0, 0, 100 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0 101 ], # va - vz 102 [ 103 36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1, 8, 104 15, 0, 0, 0, 4, 2, 0, 0, 1, 0, 0, 0 105 ], # wa - wz 106 [ 107 1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0, 0, 108 1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0 109 ], # xa - xz 110 [ 111 14, 5, 4, 2, 7, 12, 12, 6, 10, 0, 0, 3, 7, 5, 112 17, 3, 0, 4, 16, 30, 0, 0, 5, 0, 0, 0 113 ], # ya - yz 114 [ 115 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 116 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 117 ] 118 ]; # za - zz 119 120# We need to know the totals for each row 121my $row_sums = [ 122 map { 123 my $sum = 0; 124 map { $sum += $_ } @$_; 125 $sum; 126 } @$frequency 127 ]; 128 129 130# Frequency with which a given letter starts a word. 131my $start_freq = [ 132 1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24, 133 20, 355, 379, 319, 823, 618, 21, 317, 962, 1991, 134 271, 104, 516, 6, 16, 14 135 ]; 136 137my $total_sum = 0; 138$total_sum += $_ for @$start_freq; 139 140sub _check_lengths { 141 my ($min, $max) = @_; 142 143 Carp::carp "min length should be defined" unless defined $min; 144 Carp::carp "min length should be > 0" unless $min>0; 145 146 Carp::carp "max length should be defined" unless defined $max; 147 Carp::carp "max length should be > 0" unless $max>0; 148 149 Carp::carp "max length must be >= min length" unless $min<=$max; 150} 151 152sub new { 153 my $class = shift; 154 my ($min, $max) = @_; 155 $max ||= $min; 156 157 if (@_) { 158 _check_lengths($min, $max); 159 } 160 161 return bless { min => $min, max => $max }, $class; 162} 163 164sub generate { 165 my $self = shift; 166 my ($min, $max) = @_; 167 168 if (@_) { 169 $max ||= $min; 170 _check_lengths($min, $max); 171 } elsif (ref $self) { # if given no arguments, 172 # use the factory settings (if any) 173 $min = $self->{min}; 174 $max = $self->{max}; 175 } 176 if ( !$min && !$max ) { 177 # what? no parameters? 178 return q[]; # no random password 179 } 180 181 # When munging characters, we need to know where to start counting letters from 182 my $a = ord('a'); 183 184 my $length = $min + int( rand( $max - $min ) ); 185 186 my $char = $self->_generate_nextchar( $total_sum, $start_freq ); 187 my @word = ( $char + $a ); 188 for ( 2 .. $length ) { 189 $char = 190 $self->_generate_nextchar( $row_sums->[$char], 191 $frequency->[$char] ); 192 push ( @word, $char + $a ); 193 } 194 195 #Return the password 196 return pack( "C*", @word ); 197 198} 199 200#A private helper function for RandomPassword 201# Takes a row summary and a frequency chart for the next character to be searched 202sub _generate_nextchar { 203 my $self = shift; 204 my ( $all, $freq ) = @_; 205 my ( $pos, $i ); 206 207 for ( $pos = int( rand($all) ), $i = 0 ; 208 $pos >= $freq->[$i] ; 209 $pos -= $freq->[$i], $i++ ) 210 { 211 } 212 213 return ($i); 214} 215 216 2171; 218 219=head1 NAME 220 221Text::Password::Pronounceable - Generate pronounceable passwords 222 223=head1 SYNOPSIS 224 225 # Generate a pronounceable password that is between 6 and 10 characters. 226 Text::Password::Pronounceable->generate(6, 10); 227 228 # Ditto 229 my $pp = Text::Password::Pronounceable->new(6, 10); 230 $pp->generate; 231 232=head1 DESCRIPTION 233 234This module generates pronuceable passwords, based the the English 235digraphs by D Edwards. 236 237=head2 METHODS 238 239=over 240 241=item B<new> 242 243 $pp = Text::Password::Pronounceable->new($min, $max); 244 $pp = Text::Password::Pronounceable->new($len); 245 246Construct a password factory with length limits of $min and $max. 247Or create a password factory with fixed length if only one argument 248is provided. 249 250=item B<generate> 251 252 $pp->generate; 253 $pp->generate($len); 254 $pp->generate($min, $max); 255 256 Text::Password::Pronounceable->generate($len); 257 Text::Password::Pronounceable->generate($min, $max); 258 259Generate password. If used as an instance method, arguments override 260the factory settings. 261 262=back 263 264=head1 HISTORY 265 266This code derived from mpw.pl, a bit of code with a sordid history. 267 268=over 4 269 270=item * 271 272CPAN module by Chia-liang Kao 9/11/2006. 273 274=item * 275 276Perl cleaned up a bit by Jesse Vincent 1/14/2001. 277 278=item * 279 280Converted to perl from C by Marc Horowitz, 1/20/2000. 281 282=item * 283 284Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86. 285 286=item * 287 288Original PL/I version provided by Jerry Saltzer. 289 290=back 291 292=head1 LICENSE 293 294Copyright 2006 by Best Practical Solutions, LLC. 295 296This program is free software; you can redistribute it and/or modify it 297under the same terms as Perl itself. 298 299See <http://www.perl.com/perl/misc/Artistic.html> 300 301=cut 302