File Coverage

blib/lib/HTML/FormStructure/Validation.pm
Criterion Covered Total %
statement 40 49 81.6
branch 12 26 46.1
condition n/a
subroutine 6 7 85.7
pod 0 2 0.0
total 58 84 69.0


line stmt bran cond sub pod time code
1             package HTML::FormStructure::Validation;
2              
3 2     2   12 use strict;
  2         5  
  2         88  
4 2     2   13 use base qw(Exporter);
  2         4  
  2         173  
5 2     2   14 use vars qw(@EXPORT);
  2         5  
  2         139  
6             @EXPORT = qw(validate error_messages);
7 2     2   13 use constant SUCCESS => '1';
  2         3  
  2         189  
8 2     2   11 use constant FAIL => '0';
  2         4  
  2         1262  
9              
10             sub validate {
11 1     1 0 14 my $self = shift;
12 1         5 $self->query_combine;
13 1         72 for my $query ($self->have('more')) {
14 7         241 my $reason;
15 7 50       17 if ($query->more eq '1') {
16 7         73 $reason = $query->name . '_fail_needed';
17             }
18             else {
19 0         0 $reason = $query->name . '_fail_min_size';
20             }
21 7 50       68 $query->store_error($reason)
22             if length $self->r->param($query->name) < $query->more;
23             }
24 1 50       46 return FAIL if $self->have('error');
25 1         4 for my $query ($self->have('less')) {
26 7         232 my $reason = $query->name . '_fail_max_size';
27 7 50       68 $self->store_error($reason)
28             if length $self->r->param($query->name) > $query->less;
29             }
30 1 50       39 return FAIL if $self->have('error');
31 1         5 for my $query ($self->have('be')) {
32 7         222 for my $meth ($query->array_of('be')) {
33 8 50       20 next unless defined $self->r->param($query->name);
34 8 100       247 if (ref $meth eq 'CODE') {
35 2         5 my $reason = $query->name . '__fail__' .
36             $meth->($self->r->param($query->name));
37 2 50       78 $query->store_error($reason) unless $meth->(
38             $self->r->param($query->name),$self->r
39             );
40 2         76 next;
41             }
42 6         17 my $reason = $query->name . '_fail_' . $meth;
43 6         53 my $pkg = caller(0);
44 6 50       40 if ($pkg->can($meth)) {
    0          
45 6 50       15 $query->store_error($reason) unless $pkg->$meth(
46             $self->r->param($query->name),$self->r
47             );
48             }
49             elsif ($self->validator->can($meth)) {
50 0 0       0 $query->store_error($reason)
51             unless $self->validator->$meth(
52             $self->r->param($query->name),$self->r
53             );
54             }
55             else {
56 0         0 warn qq/can not locate method, $meth/;
57             }
58             }
59             }
60 1 50       40 return FAIL if $self->have('error');
61 1         3 return SUCCESS;
62             }
63              
64             sub error_messages {
65 0     0 0   my $self = shift;
66 0           my @messages;
67 0           for my $query ($self->have('error')) {
68 0           push @messages, @{$query->error};
  0            
69             }
70 0           return @messages;
71             }
72              
73              
74             1;
75              
76             __END__