| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package String::Validator::Password; | 
| 2 |  |  |  |  |  |  | $String::Validator::Password::VERSION = '2.00'; | 
| 3 |  |  |  |  |  |  | # ABSTRACT: String::Validator Password Checking Module. | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 11 |  |  | 11 |  | 690005 | use 5.008; | 
|  | 11 |  |  |  |  | 148 |  | 
| 6 | 11 |  |  | 11 |  | 56 | use strict; | 
|  | 11 |  |  |  |  | 20 |  | 
|  | 11 |  |  |  |  | 212 |  | 
| 7 | 11 |  |  | 11 |  | 49 | use warnings; | 
|  | 11 |  |  |  |  | 17 |  | 
|  | 11 |  |  |  |  | 403 |  | 
| 8 | 11 |  |  | 11 |  | 76 | no warnings qw(uninitialized) ; | 
|  | 11 |  |  |  |  | 27 |  | 
|  | 11 |  |  |  |  | 453 |  | 
| 9 | 11 |  |  | 11 |  | 4868 | use String::Validator::Common 2.00; | 
|  | 11 |  |  |  |  | 409970 |  | 
|  | 11 |  |  |  |  | 1930 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | my $password_messages = { | 
| 13 |  |  |  |  |  |  | password_mintypes => sub { | 
| 14 |  |  |  |  |  |  | my $self = shift @_; | 
| 15 |  |  |  |  |  |  | return "Input contained $self->{types_found} types of character, $self->{min_types} are required."; | 
| 16 |  |  |  |  |  |  | }, | 
| 17 |  |  |  |  |  |  | password_minoftype => sub { | 
| 18 |  |  |  |  |  |  | my ( $required, $type ) = @_; | 
| 19 |  |  |  |  |  |  | if ( $type eq 'num') { $type = 'numeric'} | 
| 20 |  |  |  |  |  |  | return "At least $required characters of type $type is required."; | 
| 21 |  |  |  |  |  |  | }, | 
| 22 |  |  |  |  |  |  | password_typeprohibit => sub { | 
| 23 |  |  |  |  |  |  | my $type = shift @_; | 
| 24 |  |  |  |  |  |  | if ( $type eq 'num') { $type = 'numeric'} | 
| 25 |  |  |  |  |  |  | return "character type $type is prohibited." | 
| 26 |  |  |  |  |  |  | }, | 
| 27 |  |  |  |  |  |  | }; | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | sub new { | 
| 30 | 26 |  |  | 26 | 1 | 9282 | my $class = shift ; | 
| 31 | 26 |  |  |  |  | 85 | my $self = { @_ } ; | 
| 32 | 11 |  |  | 11 |  | 114 | use base ( 'String::Validator::Common' ) ; | 
|  | 11 |  |  |  |  | 27 |  | 
|  | 11 |  |  |  |  | 6459 |  | 
| 33 | 26 | 100 |  |  |  | 96 | unless ( defined $self->{ require_lc } )     { $self->{ require_lc } = 0 }; | 
|  | 25 |  |  |  |  | 58 |  | 
| 34 | 26 | 100 |  |  |  | 74 | unless ( defined $self->{ require_uc } )     { $self->{ require_uc } = 0 }; | 
|  | 25 |  |  |  |  | 50 |  | 
| 35 | 26 | 100 |  |  |  | 69 | unless ( defined $self->{ require_num } )   { $self->{ require_num } = 0 }; | 
|  | 21 |  |  |  |  | 43 |  | 
| 36 | 26 | 100 |  |  |  | 68 | unless ( defined $self->{ require_punct } )  { $self->{ require_punct } = 0 }; | 
|  | 24 |  |  |  |  | 48 |  | 
| 37 | 26 | 100 |  |  |  | 64 | unless ( defined $self->{ deny_punct } ) 	 { $self->{ deny_punct } = 0 }; | 
|  | 24 |  |  |  |  | 50 |  | 
| 38 | 26 | 100 |  |  |  | 70 | unless ( defined $self->{ deny_lc } )        { $self->{ deny_lc } = 0 }; | 
|  | 24 |  |  |  |  | 59 |  | 
| 39 | 26 | 100 |  |  |  | 75 | unless ( defined $self->{ deny_uc } )        { $self->{ deny_uc } = 0 }; | 
|  | 25 |  |  |  |  | 59 |  | 
| 40 | 26 | 100 |  |  |  | 205 | unless ( defined $self->{ deny_num } )      { $self->{ deny_num } = 0 }; | 
|  | 24 |  |  |  |  | 120 |  | 
| 41 | 26 | 100 |  |  |  | 82 | unless ( defined $self->{ min_types } )	 	 { $self->{ min_types } = 2 }; | 
|  | 10 |  |  |  |  | 25 |  | 
| 42 | 26 | 100 |  |  |  | 66 | unless ( defined $self->{ min_len } )        { $self->{ min_len } = 6 }; | 
|  | 13 |  |  |  |  | 31 |  | 
| 43 | 26 | 100 |  |  |  | 63 | unless ( defined $self->{ max_len } )        { $self->{ max_len } = 64 }; | 
|  | 24 |  |  |  |  | 51 |  | 
| 44 |  |  |  |  |  |  | # Not implemented right now. | 
| 45 |  |  |  |  |  |  | #    unless ( defined $self->{ dictionary } )     { $self->{ dictionary } = [ 'default' ] } | 
| 46 |  |  |  |  |  |  | #    unless ( defined $self->{ custom_allow } )   { $self->{ custom_allow } = 0 } | 
| 47 |  |  |  |  |  |  | #    unless ( defined $self->{ custom_deny } )    { $self->{ custom_deny } = 0 } | 
| 48 | 26 |  |  |  |  | 53 | $self->{ string } = '' ; | 
| 49 | 26 |  |  |  |  | 61 | $self->{ error } = 0 ; | 
| 50 | 26 |  |  |  |  | 52 | $self->{errstring} = '' ; | 
| 51 | 26 |  |  |  |  | 52 | bless $self, $class ; | 
| 52 |  |  |  |  |  |  | $self->{messages} | 
| 53 |  |  |  |  |  |  | = String::Validator::Common::_Messages( | 
| 54 | 26 |  |  |  |  | 197 | $password_messages, $self->{language}, $self->{custom_messages} ); | 
| 55 | 26 |  |  |  |  | 1052 | return $self ; | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | # Does all the checks and returns the | 
| 59 |  |  |  |  |  |  | # number of errors found. Used by the | 
| 60 |  |  |  |  |  |  | # Is/IsNot_Valid. May be invoked directly. | 
| 61 |  |  |  |  |  |  | sub Check{ | 
| 62 | 106 |  |  | 106 | 1 | 11344 | my ( $self, $string1, $string2 ) = @_ ; | 
| 63 | 106 | 100 |  |  |  | 341 | if ( $self->Start( $string1, $string2 ) == 99 ) { | 
| 64 | 4 |  |  |  |  | 128 | return $self->{ error } } | 
| 65 | 102 |  |  |  |  | 1858 | $self->Length; | 
| 66 |  |  |  |  |  |  | # The match operator cannot be directly used to count matches. | 
| 67 |  |  |  |  |  |  | # substitution does count replacements, and by removing all other | 
| 68 |  |  |  |  |  |  | # other character classes what is left over is "punct". | 
| 69 | 102 |  |  |  |  | 1129 | $string2 = $string1 ; # make sure string is in string2. | 
| 70 | 102 |  | 100 |  |  | 649 | $self->{num_lc} = $string2 =~ s/[a-z]//g || 0; | 
| 71 | 102 |  | 100 |  |  | 433 | $self->{num_uc} = $string2 =~ s/[A-Z]//g || 0 ; | 
| 72 | 102 |  | 100 |  |  | 414 | $self->{num_num} = $string2 =~ s/\d//g || 0; | 
| 73 | 102 |  |  |  |  | 191 | $self->{num_punct} = length $string2; #What is left is punct. | 
| 74 | 102 |  |  |  |  | 156 | $self->{ types_found } = 0; | 
| 75 | 102 |  |  |  |  | 196 | for ( qw / num_lc num_uc num_num num_punct / ) { | 
| 76 | 408 | 100 |  |  |  | 815 | if ( $self->{ $_ } ) { $self->{ types_found }++ }  } | 
|  | 251 |  |  |  |  | 391 |  | 
| 77 | 102 | 100 |  |  |  | 214 | if ( $self->{types_found} < $self->{ min_types } ) { | 
| 78 |  |  |  |  |  |  | $self->IncreaseErr( | 
| 79 | 9 |  |  |  |  | 29 | $self->{messages}{password_mintypes}->( $self )); | 
| 80 |  |  |  |  |  |  | } | 
| 81 | 102 |  |  |  |  | 325 | foreach my $type ( qw /lc num uc punct/ ) { | 
| 82 | 408 |  |  |  |  | 757 | my $required = 'require_' . $type ; | 
| 83 | 408 |  |  |  |  | 566 | my $denied = 'deny_' . $type ; | 
| 84 | 408 |  |  |  |  | 560 | my $num = 'num_' . $type ; | 
| 85 | 408 | 100 |  |  |  | 801 | unless ( $self->{ $required } <= $self->{ $num } ) { | 
| 86 |  |  |  |  |  |  | $self->IncreaseErr( | 
| 87 |  |  |  |  |  |  | $self->{messages}{password_minoftype}->( | 
| 88 | 19 |  |  |  |  | 48 | $self->{ $required }, $type ) ) } | 
| 89 | 408 | 100 |  |  |  | 1015 | if ( $self->{ $denied }  ) { | 
| 90 | 20 | 100 |  |  |  | 43 | if ( $self->{ $num } ) | 
| 91 |  |  |  |  |  |  | { $self->IncreaseErr( | 
| 92 | 13 |  |  |  |  | 33 | $self->{messages}{password_typeprohibit}->($type) ) } } | 
| 93 |  |  |  |  |  |  | # elsif ( $self->{ $denied } > 1 ) { | 
| 94 |  |  |  |  |  |  | # 	if ( $self->{ $denied } <= $self->{ $num } ) { | 
| 95 |  |  |  |  |  |  | # 		$self->IncreaseErr( | 
| 96 |  |  |  |  |  |  | # 			$self->{messages}{password_typelimit}->( | 
| 97 |  |  |  |  |  |  | # 				$type, $self->{ $denied } ) ) | 
| 98 |  |  |  |  |  |  | # 	} | 
| 99 |  |  |  |  |  |  | # } | 
| 100 |  |  |  |  |  |  | } #foreach ( lc num uc punct ). | 
| 101 | 102 |  |  |  |  | 478 | return $self->{ error } ; | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | 1; # End of Validator | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | __END__ |