File Coverage

lib/HTML/ValidationRules/Legacy.pm
Criterion Covered Total %
statement 86 93 92.4
branch 53 64 82.8
condition 21 28 75.0
subroutine 10 10 100.0
pod 2 2 100.0
total 172 197 87.3


line stmt bran cond sub pod time code
1             package HTML::ValidationRules::Legacy;
2 3     3   16 use strict;
  3         6  
  3         170  
3 3     3   17 use warnings;
  3         5  
  3         113  
4 3     3   20 use Mojo::Base 'Exporter';
  3         5  
  3         33  
5 3     3   648 use Mojo::JSON;
  3         5  
  3         184  
6 3     3   17 use Mojo::Util qw{decode};
  3         5  
  3         152  
7 3     3   1403 use Mojo::Parameters;
  3         5645  
  3         28  
8 3     3   109 use Scalar::Util qw(blessed);
  3         5  
  3         5760  
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 32 my ($form, $charset) = @_;
26 17         24 my $props = {};
27 17         21 my @required;
28            
29 17 50       56 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   13198 my $tag = shift;
35 40   100     129 my $type = $tag->attr('type') || '';
36 40         2046 my $name = $tag->attr('name');
37 40   100     2082 $props->{$name} ||= {};
38            
39 40 100       80 if (grep {$_ eq $type} qw{hidden checkbox radio submit image}) {
  200         395  
40 24         30 push(@{$props->{$name}->{$TERM_OPTIONS}}, $tag->attr('value'));
  24         125  
41             }
42            
43 40 100       1275 if ($tag->type eq 'select') {
44             $tag->find('option')->each(sub {
45 6         1487 push(@{$props->{$name}->{$TERM_OPTIONS}}, shift->attr('value'));
  6         37  
46 2         104 });
47             }
48            
49 40 100       1933 if ($type eq 'number') {
50 1         4 $props->{$name}->{$TERM_TYPE} = $TERM_NUMBER;
51 1 50       6 if (my $val = $tag->attr->{min}) {
52 1         52 $props->{$name}->{$TERM_MIN} = $val;
53             }
54 1 50       4 if (my $val = $tag->attr->{max}) {
55 1         52 $props->{$name}->{$TERM_MAX} = $val;
56             }
57             }
58            
59 40 100       127 if (! exists $tag->attr->{disabled}) {
60 33 100 66     1840 if ($type ne 'submit' && $type ne 'image' && $type ne 'checkbox' &&
      100        
      100        
      66        
61             ($type ne 'radio' || exists $tag->attr->{checked})) {
62 19         125 $props->{$name}->{$TERM_REQUIRED} = Mojo::JSON->true;
63             }
64             }
65            
66 40 100       908 if (exists $tag->attr->{maxlength}) {
67 2   100     100 $props->{$name}->{$TERM_MAXLENGTH} = $tag->attr->{maxlength} || 0;
68             }
69            
70 40 100       1921 if (exists $tag->attr->{required}) {
71 2         86 $props->{$name}->{$TERM_MIN_LENGTH} = 1;
72             }
73            
74 40 100       1744 if (exists $tag->attr->{pattern}) {
75 1         48 $props->{$name}->{$TERM_PATTERN} = $tag->attr->{pattern};
76             }
77 17         56 });
78            
79             return {
80 17         1478 $TERM_PROPERTIES => $props,
81             $TERM_ADD_PROPS => Mojo::JSON->false,
82             };
83             }
84              
85             sub validate {
86 44     44 1 509 my ($schema, $params, $charset) = @_;
87            
88 44 50 33     617 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         141 my $props = $schema->{$TERM_PROPERTIES};
100            
101 44 50       273 if (! $schema->{$TERM_ADD_PROPS}) {
102 44         466 for my $name ($params->param) {
103 69 100       1962 return "Field $name is injected" if (! $props->{$name});
104             }
105             }
106            
107 42         441 for my $name (keys %$props) {
108 77         258 my @params = grep {defined $_} $params->param($name);
  77         2084  
109            
110 77 100 100     662 if (($props->{$name}->{$TERM_REQUIRED} || '') eq Mojo::JSON->true) {
111 46 100       858 return "Field $name is required" if (! scalar @params);
112             }
113            
114 74 100       565 if (my $allowed = $props->{$name}->{$TERM_OPTIONS}) {
115 43         99 for my $given (@params) {
116 55         221 return "Field $name has been tampered"
117 24 100       62 if (! grep {$_ eq $given} @$allowed);
118             }
119             }
120 67 100       211 if (exists $props->{$name}->{$TERM_MAXLENGTH}) {
121 4         11 for my $given (@params) {
122 4 100       39 return "Field $name is too long"
123             if (length($given) > $props->{$name}->{$TERM_MAXLENGTH});
124             }
125             }
126 65 100       217 if (defined $props->{$name}->{$TERM_MIN_LENGTH}) {
127 2         4 for my $given (@params) {
128 2 100       26 return "Field $name cannot be empty"
129             if (length($given) < $props->{$name}->{$TERM_MIN_LENGTH});
130             }
131             }
132 64 100       206 if (my $pattern = $props->{$name}->{$TERM_PATTERN}) {
133 5         13 for my $given (@params) {
134 5 100       92 return "Field $name not match pattern"
135             if ($given !~ /\A$pattern\Z/);
136             }
137             }
138 60 100 100     397 if (($props->{$name}->{$TERM_TYPE} || '') eq $TERM_NUMBER) {
139 6         15 for my $given (@params) {
140 6 100       68 return "Field $name not match pattern"
141             if ($given !~ /\A[\d\+\-\.]+\Z/);
142 5 50       34 if (my $min = $props->{$name}->{$TERM_MIN}) {
143 5 100       31 return "Field $name too low" if ($given < $min);
144             }
145 4 50       19 if (my $max = $props->{$name}->{$TERM_MAX}) {
146 4 100       39 return "Field $name too great" if ($given > $max);
147             }
148             }
149             }
150             }
151 21         268 return;
152             }
153              
154             1;
155              
156             __END__