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   35220 use strict;
  3         4  
  3         74  
3 3     3   16 use warnings;
  3         5  
  3         84  
4 3     3   774 use Mojo::Base 'Exporter';
  3         11027  
  3         26  
5 3     3   1248 use Mojo::JSON;
  3         9043573  
  3         124  
6 3     3   18 use Mojo::Util qw{decode};
  3         4  
  3         155  
7 3     3   1597 use Mojo::Parameters;
  3         4433  
  3         21  
8 3     3   89 use Scalar::Util qw(blessed);
  3         5  
  3         5641  
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 27 my ($form, $charset) = @_;
26 17         26 my $props = {};
27 17         51 my @required;
28            
29 17 50       42 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   6699 my $tag = shift;
35 40   100     99 my $type = $tag->attr('type') || '';
36 40         753 my $name = $tag->attr('name');
37 40   100     758 $props->{$name} ||= {};
38            
39 40 100       65 if (grep {$_ eq $type} qw{hidden checkbox radio submit image}) {
  200         394  
40 24         25 push(@{$props->{$name}->{$TERM_OPTIONS}}, $tag->attr('value'));
  24         105  
41             }
42            
43 40 100       464 if ($tag->tag eq 'select') {
44             $tag->find('option')->each(sub {
45 6         657 push(@{$props->{$name}->{$TERM_OPTIONS}}, shift->attr('value'));
  6         26  
46 2         33 });
47             }
48            
49 40 100       642 if ($type eq 'number') {
50 1         3 $props->{$name}->{$TERM_TYPE} = $TERM_NUMBER;
51 1 50       4 if (my $val = $tag->attr->{min}) {
52 1         19 $props->{$name}->{$TERM_MIN} = $val;
53             }
54 1 50       4 if (my $val = $tag->attr->{max}) {
55 1         17 $props->{$name}->{$TERM_MAX} = $val;
56             }
57             }
58            
59 40 100       105 if (! exists $tag->attr->{disabled}) {
60 33 100 66     707 if ($type ne 'submit' && $type ne 'image' && $type ne 'checkbox' &&
      100        
      66        
      66        
61             ($type ne 'radio' || exists $tag->attr->{checked})) {
62 19         77 $props->{$name}->{$TERM_REQUIRED} = Mojo::JSON->true;
63             }
64             }
65            
66 40 100       402 if (exists $tag->attr->{maxlength}) {
67 2   100     35 $props->{$name}->{$TERM_MAXLENGTH} = $tag->attr->{maxlength} || 0;
68             }
69            
70 40 100       636 if (exists $tag->attr->{required}) {
71 2         33 $props->{$name}->{$TERM_MIN_LENGTH} = 1;
72             }
73            
74 40 100       594 if (exists $tag->attr->{pattern}) {
75 1         16 $props->{$name}->{$TERM_PATTERN} = $tag->attr->{pattern};
76             }
77 17         44 });
78            
79             return {
80 17         668 $TERM_PROPERTIES => $props,
81             $TERM_ADD_PROPS => Mojo::JSON->false,
82             };
83             }
84              
85             sub validate {
86 44     44 1 349 my ($schema, $params, $charset) = @_;
87            
88 44 50 33     400 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         111 my $props = $schema->{$TERM_PROPERTIES};
100            
101 44 50       178 if (! $schema->{$TERM_ADD_PROPS}) {
102 44         319 for my $name (@{$params->names}) {
  44         133  
103 69 100       1381 return "Field $name is injected" if (! $props->{$name});
104             }
105             }
106            
107 42         342 for my $name (keys %$props) {
108 76         212 my @params = grep {defined $_} $params->param($name);
  76         1619  
109            
110 76 100 100     455 if (($props->{$name}->{$TERM_REQUIRED} || '') eq Mojo::JSON->true) {
111 47 100       845 return "Field $name is required" if (! scalar @params);
112             }
113            
114 73 100       480 if (my $allowed = $props->{$name}->{$TERM_OPTIONS}) {
115 39         76 for my $given (@params) {
116             return "Field $name has been tampered"
117 22 100       40 if (! grep {$_ eq $given} @$allowed);
  53         177  
118             }
119             }
120 66 100       216 if (exists $props->{$name}->{$TERM_MAXLENGTH}) {
121 4         9 for my $given (@params) {
122             return "Field $name is too long"
123 4 100       31 if (length($given) > $props->{$name}->{$TERM_MAXLENGTH});
124             }
125             }
126 64 100       188 if (defined $props->{$name}->{$TERM_MIN_LENGTH}) {
127 2         5 for my $given (@params) {
128             return "Field $name cannot be empty"
129 2 100       22 if (length($given) < $props->{$name}->{$TERM_MIN_LENGTH});
130             }
131             }
132 63 100       182 if (my $pattern = $props->{$name}->{$TERM_PATTERN}) {
133 5         13 for my $given (@params) {
134 5 100       66 return "Field $name not match pattern"
135             if ($given !~ /\A$pattern\Z/);
136             }
137             }
138 59 100 100     351 if (($props->{$name}->{$TERM_TYPE} || '') eq $TERM_NUMBER) {
139 6         12 for my $given (@params) {
140 6 100       39 return "Field $name not match pattern"
141             if ($given !~ /\A[\d\+\-\.]+\Z/);
142 5 50       21 if (my $min = $props->{$name}->{$TERM_MIN}) {
143 5 100       22 return "Field $name too low" if ($given < $min);
144             }
145 4 50       14 if (my $max = $props->{$name}->{$TERM_MAX}) {
146 4 100       27 return "Field $name too great" if ($given > $max);
147             }
148             }
149             }
150             }
151 21         192 return;
152             }
153              
154             1;
155              
156             __END__