| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package HTML::CheckArgs::string; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
37
|
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
26
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use base 'HTML::CheckArgs::Object'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
1085
|
|
|
7
|
1
|
|
|
1
|
|
606
|
use HTML::FormatData; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub is_valid { |
|
10
|
|
|
|
|
|
|
my $self = shift; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $value = $self->value; |
|
13
|
|
|
|
|
|
|
my $config = $self->config; |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# a subset of the jobs available in HTML::FormatData |
|
16
|
|
|
|
|
|
|
# it makes no sense to call one of these routines and do 'noclean' |
|
17
|
|
|
|
|
|
|
my @jobs = qw( |
|
18
|
|
|
|
|
|
|
strip_html strip_whitespace |
|
19
|
|
|
|
|
|
|
clean_high_ascii clean_encoded_html clean_encoded_text |
|
20
|
|
|
|
|
|
|
clean_whitespace clean_whitespace_keep_full_breaks clean_whitespace_keep_all_breaks |
|
21
|
|
|
|
|
|
|
force_lc force_uc |
|
22
|
|
|
|
|
|
|
truncate truncate_with_ellipses |
|
23
|
|
|
|
|
|
|
); |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
$self->check_params( |
|
26
|
|
|
|
|
|
|
required => [], |
|
27
|
|
|
|
|
|
|
optional => [ @jobs, qw( regex min_chars max_chars min_words max_words ) ], |
|
28
|
|
|
|
|
|
|
cleanable => 1 ); |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# format text based on params |
|
31
|
|
|
|
|
|
|
my %format_jobs; |
|
32
|
|
|
|
|
|
|
my $do_format = 0; |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
foreach my $job ( @jobs ) { |
|
35
|
|
|
|
|
|
|
if ( $config->{params}{$job} ) { |
|
36
|
|
|
|
|
|
|
$do_format = 1; |
|
37
|
|
|
|
|
|
|
$format_jobs{$job} = $config->{params}{$job}; |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
} |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$value = HTML::FormatData->new->format_text( $value, %format_jobs ) if $do_format; |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# no value passed in |
|
44
|
|
|
|
|
|
|
if ( $config->{required} && !$value ) { |
|
45
|
|
|
|
|
|
|
$self->error_code( 'string_00' ); # required |
|
46
|
|
|
|
|
|
|
$self->error_message( 'Not given.' ); |
|
47
|
|
|
|
|
|
|
return; |
|
48
|
|
|
|
|
|
|
} elsif ( !$config->{required} && !$value ) { |
|
49
|
|
|
|
|
|
|
$self->value( $value ); |
|
50
|
|
|
|
|
|
|
return 1; |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
if ( $config->{params}{regex} ) { |
|
54
|
|
|
|
|
|
|
my $pat = $config->{params}{regex}; |
|
55
|
|
|
|
|
|
|
if ( $value !~ m/$pat/ ) { |
|
56
|
|
|
|
|
|
|
$self->error_code( 'string_01' ); # not match regex |
|
57
|
|
|
|
|
|
|
$self->error_message( 'Does not match expected pattern.'); |
|
58
|
|
|
|
|
|
|
return; |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my ( $min_chars, $max_chars, $min_words, $max_words ); |
|
63
|
|
|
|
|
|
|
$min_chars = $config->{params}{min_chars}; |
|
64
|
|
|
|
|
|
|
$max_chars = $config->{params}{max_chars}; |
|
65
|
|
|
|
|
|
|
$min_words = $config->{params}{min_words}; |
|
66
|
|
|
|
|
|
|
$max_words = $config->{params}{max_words}; |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
if ( $min_chars && ( length( $value ) < $min_chars ) ) { |
|
69
|
|
|
|
|
|
|
$self->error_code( 'string_02' ); # under min chars |
|
70
|
|
|
|
|
|
|
$self->error_message( "Less than the minimum required length ($min_chars characters)." ); |
|
71
|
|
|
|
|
|
|
return; |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
if ( $max_chars && ( length( $value ) > $max_chars ) ) { |
|
75
|
|
|
|
|
|
|
$self->error_code( 'string_03' ); # over max chars |
|
76
|
|
|
|
|
|
|
$self->error_message( "Exceeds the maximum allowable length ($max_chars characters)." ); |
|
77
|
|
|
|
|
|
|
return; |
|
78
|
|
|
|
|
|
|
} |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
if ( $min_words ) { |
|
81
|
|
|
|
|
|
|
my @words = split( /\s+/, $value ); |
|
82
|
|
|
|
|
|
|
if ( scalar( @words ) < $min_words ) { |
|
83
|
|
|
|
|
|
|
$self->error_code( 'string_04' ); # under min words |
|
84
|
|
|
|
|
|
|
$self->error_message( "Less than the minimum number of words ($min_words)." ); |
|
85
|
|
|
|
|
|
|
return; |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
if ( $max_words ) { |
|
90
|
|
|
|
|
|
|
my @words = split( /\s+/, $value ); |
|
91
|
|
|
|
|
|
|
if ( scalar( @words ) > $max_words ) { |
|
92
|
|
|
|
|
|
|
$self->error_code( 'string_05' ); # over max words |
|
93
|
|
|
|
|
|
|
$self->error_message( "More than the maximum number of words ($max_words)." ); |
|
94
|
|
|
|
|
|
|
return; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
} |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# return cleaned value (the 2-letter abbr)? |
|
99
|
|
|
|
|
|
|
unless ( $config->{noclean} ) { |
|
100
|
|
|
|
|
|
|
$self->value( $value ); |
|
101
|
|
|
|
|
|
|
} |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
return 1; |
|
104
|
|
|
|
|
|
|
} |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
1; |