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