File Coverage

lib/HTML/ValidationRules/Legacy.pm
Criterion Covered Total %
statement 87 94 92.5
branch 53 64 82.8
condition 20 28 71.4
subroutine 10 10 100.0
pod 2 2 100.0
total 172 198 86.8


line stmt bran cond sub pod time code
1             package HTML::ValidationRules::Legacy;
2 3     3   29268 use strict;
  3         7  
  3         101  
3 3     3   14 use warnings;
  3         5  
  3         111  
4 3     3   533 use Mojo::Base 'Exporter';
  3         9875  
  3         33  
5 3     3   1426 use Mojo::JSON;
  3         84452  
  3         138  
6 3     3   16 use Mojo::Util qw{decode};
  3         5  
  3         168  
7 3     3   1376 use Mojo::Parameters;
  3         4165  
  3         23  
8 3     3   109 use Scalar::Util qw(blessed);
  3         10  
  3         5631  
9              
10             our @EXPORT_OK = qw(extract validate),
11              
12             our $TERM_PROPERTIES = 'properties';
13             our $TERM_REQUIRED = 'required';
14             our $TERM_MAXLENGTH = 'maxLength';
15             our $TERM_MIN_LENGTH = 'minLength';
16             our $TERM_OPTIONS = 'options';
17             our $TERM_PATTERN = 'pattern';
18             our $TERM_MIN = 'maximam';
19             our $TERM_MAX = 'minimum';
20             our $TERM_TYPE = 'type';
21             our $TERM_ADD_PROPS = 'additionalProperties';
22             our $TERM_NUMBER = 'number';
23              
24             sub extract {
25 17     17 1 21 my ($form, $charset) = @_;
26 17         18 my $props = {};
27 17         16 my @required;
28            
29 17 50       36 if (! ref $form) {
30 0 0       0 $form = Mojo::DOM->new($charset ? decode($charset, $form) : $form);
31             }
32            
33             $form->find("*[name]")->each(sub {
34 40     40   5355 my $tag = shift;
35 40   100     65 my $type = $tag->attr('type') || '';
36 40         507 my $name = $tag->attr('name');
37 40   100     513 $props->{$name} ||= {};
38            
39 40 100       51 if (grep {$_ eq $type} qw{hidden checkbox radio submit image}) {
  200         244  
40 24         21 push(@{$props->{$name}->{$TERM_OPTIONS}}, $tag->attr('value'));
  24         75  
41             }
42            
43 40 100       315 if ($tag->tag eq 'select') {
44             $tag->find('option')->each(sub {
45 6         498 push(@{$props->{$name}->{$TERM_OPTIONS}}, shift->attr('value'));
  6         18  
46 2         24 });
47             }
48            
49 40 100       448 if ($type eq 'number') {
50 1         3 $props->{$name}->{$TERM_TYPE} = $TERM_NUMBER;
51 1 50       3 if (my $val = $tag->attr->{min}) {
52 1         17 $props->{$name}->{$TERM_MIN} = $val;
53             }
54 1 50       4 if (my $val = $tag->attr->{max}) {
55 1         14 $props->{$name}->{$TERM_MAX} = $val;
56             }
57             }
58            
59 40 100       70 if (! exists $tag->attr->{disabled}) {
60 33 100 66     498 if ($type ne 'submit' && $type ne 'image' && $type ne 'checkbox' &&
      100        
      66        
      66        
61             ($type ne 'radio' || exists $tag->attr->{checked})) {
62 19         61 $props->{$name}->{$TERM_REQUIRED} = Mojo::JSON->true;
63             }
64             }
65            
66 40 100       270 if (exists $tag->attr->{maxlength}) {
67 2   100     23 $props->{$name}->{$TERM_MAXLENGTH} = $tag->attr->{maxlength} || 0;
68             }
69            
70 40 100       405 if (exists $tag->attr->{required}) {
71 2         22 $props->{$name}->{$TERM_MIN_LENGTH} = 1;
72             }
73            
74 40 100       372 if (exists $tag->attr->{pattern}) {
75 1         11 $props->{$name}->{$TERM_PATTERN} = $tag->attr->{pattern};
76             }
77 17         35 });
78            
79             return {
80 17         513 $TERM_PROPERTIES => $props,
81             $TERM_ADD_PROPS => Mojo::JSON->false,
82             };
83             }
84              
85             sub validate {
86 44     44 1 336 my ($schema, $params, $charset) = @_;
87            
88 44 50 33     469 if (! (blessed($params) && $params->isa('Mojo::Parameters'))) {
89 0         0 my $wrapper = Mojo::Parameters->new;
90 0         0 $wrapper->charset($charset);
91 0 0 0     0 if (blessed($params) && $params->isa('Hash::MultiValue')) {
92 0         0 $wrapper->append($params->flatten);
93             } else {
94 0         0 $wrapper->append($params);
95             }
96 0         0 $params = $wrapper;
97             }
98            
99 44         114 my $props = $schema->{$TERM_PROPERTIES};
100            
101 44 50       186 if (! $schema->{$TERM_ADD_PROPS}) {
102 44         301 for my $name (@{$params->names}) {
  44         116  
103 69 100       1374 return "Field $name is injected" if (! $props->{$name});
104             }
105             }
106            
107 42         306 for my $name (keys %$props) {
108 83         207 my @params = grep {defined $_} $params->param($name);
  83         1400  
109            
110 83 100 100     330 if (($props->{$name}->{$TERM_REQUIRED} || '') eq Mojo::JSON->true) {
111 52 100       759 return "Field $name is required" if (! scalar @params);
112             }
113            
114 80 100       421 if (my $allowed = $props->{$name}->{$TERM_OPTIONS}) {
115 44         70 for my $given (@params) {
116             return "Field $name has been tampered"
117 25 100       35 if (! grep {$_ eq $given} @$allowed);
  56         159  
118             }
119             }
120 73 100       175 if (exists $props->{$name}->{$TERM_MAXLENGTH}) {
121 5         11 for my $given (@params) {
122             return "Field $name is too long"
123 5 100       53 if (length($given) > $props->{$name}->{$TERM_MAXLENGTH});
124             }
125             }
126 71 100       154 if (defined $props->{$name}->{$TERM_MIN_LENGTH}) {
127 2         5 for my $given (@params) {
128             return "Field $name cannot be empty"
129 2 100       20 if (length($given) < $props->{$name}->{$TERM_MIN_LENGTH});
130             }
131             }
132 70 100       177 if (my $pattern = $props->{$name}->{$TERM_PATTERN}) {
133 5         9 for my $given (@params) {
134 5 100       62 return "Field $name not match pattern"
135             if ($given !~ /\A$pattern\Z/);
136             }
137             }
138 66 100 100     368 if (($props->{$name}->{$TERM_TYPE} || '') eq $TERM_NUMBER) {
139 6         13 for my $given (@params) {
140 6 100       42 return "Field $name not match pattern"
141             if ($given !~ /\A[\d\+\-\.]+\Z/);
142 5 50       18 if (my $min = $props->{$name}->{$TERM_MIN}) {
143 5 100       26 return "Field $name too low" if ($given < $min);
144             }
145 4 50       28 if (my $max = $props->{$name}->{$TERM_MAX}) {
146 4 100       28 return "Field $name too great" if ($given > $max);
147             }
148             }
149             }
150             }
151 21         189 return;
152             }
153              
154             1;
155              
156             __END__