File Coverage

blib/lib/HTML/CheckArgs/string.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


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;