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__ |