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