File Coverage

blib/lib/Apache/Voodoo/Validate.pm
Criterion Covered Total %
statement 122 151 80.7
branch 41 54 75.9
condition 10 15 66.6
subroutine 13 17 76.4
pod 0 8 0.0
total 186 245 75.9


line stmt bran cond sub pod time code
1             package Apache::Voodoo::Validate;
2              
3             $VERSION = "3.0200";
4              
5 3     3   42650 use strict;
  3         8  
  3         138  
6 3     3   62 use warnings;
  3         6  
  3         141  
7              
8 3     3   558 use Apache::Voodoo::Exception;
  3         5  
  3         2860  
9              
10             sub new {
11 10     10 0 13865 my $class = shift;
12 10   100     41 my $config = shift || {};
13              
14 10         18 my $self = {};
15 10         25 bless $self, $class;
16              
17             $self->{'ef'} = sub {
18 66     66   116 my ($f,$t,$e) = @_;
19 66         266 $e->{$t.'_'.$f} = 1;
20 10         72 };
21              
22 10         36 $self->_configure($config);
23              
24 7         31 return $self;
25             }
26              
27             sub set_valid_callback {
28 1     1 0 636 my $self = shift;
29             #my $context = shift;
30 1         2 my $sub_ref = shift;
31              
32             #unless (defined($context)) {
33             # Apache::Vodooo::Exception::RunTime->throw("add_callback requires a context name as the first parameter");
34             #}
35              
36 1 50       7 unless (ref($sub_ref) eq "CODE") {
37 0         0 Apache::Vodooo::Exception::RunTime::BadConfig->throw("add_callback requires a subroutine reference as the second paramter");
38             }
39              
40             #push(@{$self->{'callbacks'}->{$context}},$sub_ref);
41 1         4 $self->{'vc'} = $sub_ref;
42             }
43              
44             sub set_error_formatter {
45 0     0 0 0 my $self = shift;
46 0         0 my $sub_ref = shift;
47              
48 0 0       0 if (ref($sub_ref) eq "CODE") {
49 0         0 $self->{'ef'} = $sub_ref;
50             }
51             }
52              
53 0     0 0 0 sub required { return map { $_->name } grep { $_->required } @{$_[0]->{fields}} };
  0         0  
  0         0  
  0         0  
54 0     0 0 0 sub unique { return map { $_->name } grep { $_->unique } @{$_[0]->{fields}} };
  0         0  
  0         0  
  0         0  
55 0     0 0 0 sub multiple { return map { $_->name } grep { $_->multiple } @{$_[0]->{fields}} };
  0         0  
  0         0  
  0         0  
56              
57             sub fields {
58 32     32 0 35 my $self = shift;
59 32         35 my $type = shift;
60              
61 32 50       78 if ($type) {
62 0         0 return grep { $_->type eq $type } @{$self->{fields}};
  0         0  
  0         0  
63             }
64             else {
65 32         31 return @{$self->{fields}};
  32         162  
66             }
67             }
68              
69             sub validate {
70 32     32 0 50278 my $self = shift;
71 32         38 my $p = shift;
72              
73 32         56 my $values = {};
74 32         48 my $errors = {};
75              
76 32         88 foreach my $field ($self->fields) {
77 133         151 my $good;
78 133         144 my $missing = 1;
79 133         324 my $bad = 0;
80 133         321 foreach ($self->_param($p,$field)) {
81 137 100       358 next unless defined ($_);
82              
83             # call the validation routine for each value
84 96         329 my ($v,@b) = $field->valid($_);
85              
86 96 100       402 if (defined($b[0])) {
    100          
    50          
87             # bad one, we're outta here.
88 34         53 $bad = 1;
89 34         52 foreach (@b) {
90 34         107 $self->{'ef'}->($field->{'name'},$_,$errors);
91             }
92 34         76 last;
93             }
94             elsif (defined($field->valid_sub)) {
95             # there's a validation subroutine, call it
96 9         32 my $r = $field->valid_sub()->($v);
97              
98 9 100 66     133 if (defined($r) && $r == 1) {
99 5         7 push(@{$good},$v);
  5         13  
100 5         14 $missing = 0;
101             }
102             else {
103 4         7 $bad = 1;
104 4 50 33     21 if (!defined($r) || $r == 0) {
105 4         8 $r = 'BAD';
106             }
107 4         16 $self->{'ef'}->($field->name,$r,$errors);
108             }
109             }
110             elsif (defined($v)) {
111 53         103 push(@{$good},$v);
  53         117  
112 53         157 $missing = 0;
113             }
114             }
115              
116             # check requiredness
117 133 100 100     581 if ($missing && $field->required) {
118 26         37 $bad = 1;
119 26         95 $self->{'ef'}->($field->name,'MISSING',$errors);
120             }
121              
122 133 100       422 $self->_pack($good,$field,$values) unless ($bad);
123             }
124              
125 32 100       105 if ($self->{vc}) {
126 6         24 foreach ($self->{vc}->($values,$errors)) {
127 7 100       66 next unless ref($_) eq "ARRAY";
128              
129 2         8 $self->{'ef'}->($_->[0],$_->[1],$errors);
130 2         7 delete $values->{$_->[0]};
131             }
132             }
133              
134 32 100       38 if (scalar keys %{$errors}) {
  32         112  
135 12         43 return ($values,$errors);
136             }
137             else {
138 20         70 return $values;
139             }
140             }
141              
142             sub _configure {
143 10     10   15 my $self = shift;
144 10         16 my $c = shift;
145              
146 10         15 my @errors;
147              
148             my @fields;
149 10 50       31 if (ref($c) eq "ARRAY") {
150 0         0 @fields = @{$c};
  0         0  
151             }
152             else {
153 3     3   23 no warnings "uninitialized";
  3         6  
  3         2029  
154 28         51 @fields = map {
155 55   50     182 $c->{$_}->{'id'} = $_;
156 28         57 $c->{$_};
157             }
158             sort {
159 10         55 $c->{$a}->{'seq'} ||= 0;
160 55   50     159 $c->{$b}->{'seq'} ||= 0;
161              
162 55 0       143 $c->{$a}->{'seq'} cmp $c->{$b}->{'seq'} ||
163             $a cmp $b;
164             }
165 10         22 keys %{$c};
166             }
167              
168 10 100       35 unless (scalar(@fields)) {
169 3         46 Apache::Voodoo::Exception::RunTime::BadConfig->throw("Empty Configuration.");
170             }
171              
172 7         19 $self->{'fields'} = [];
173 7         14 foreach my $conf (@fields) {
174 28         52 my $name = $conf->{id};
175              
176 28 50       65 unless (defined($conf->{'type'})) {
177 0         0 push(@errors,"missing 'type' for column $name");
178 0         0 next;
179             }
180              
181 28         32 my ($field,@e);
182 28         82 eval {
183 28         56 my $m = 'Apache::Voodoo::Validate::'.$conf->{'type'};
184 28         45 my $f = 'Apache/Voodoo/Validate/'.$conf->{'type'}.'.pm';
185 28         6124 require $f;
186 28         163 ($field,@e) = $m->new($conf);
187             };
188 28 50       56 if ($@) {
189 0         0 push(@errors,"Don't know how to handle data type $conf->{'type'}");
190 0         0 next;
191             }
192              
193 28 50       99 if (defined($e[0])) {
194 0         0 push(@errors,@e);
195 0         0 next;
196             }
197              
198 28         30 push(@{$self->{'fields'}},$field);
  28         88  
199             }
200              
201 7 50       26 if (@errors) {
202 0         0 Apache::Voodoo::Exception::RunTime::BadConfig->throw("Configuration Errors:\n\t".join("\n\t",@errors));
203             }
204             }
205              
206             sub _param {
207 133     133   140 my $self = shift;
208 133         154 my $params = shift;
209 133         145 my $def = shift;
210              
211 133         462 my $p = $params->{$def->{'name'}};
212 133 100       264 if (ref($p) eq "ARRAY") {
213 4 100       11 if ($def->{'multiple'}) {
214 7         13 return map {
215 3         6 $self->_trim($_)
216 3         6 } @{$p};
217             }
218             else {
219 1         4 return $self->_trim($p->[0]);
220             }
221             }
222             else {
223 129         277 return $self->_trim($p);
224             }
225             }
226              
227             sub _pack {
228 82     82   102 my $self = shift;
229 82         95 my $v = shift;
230 82         83 my $def = shift;
231 82         85 my $vals = shift;
232              
233 82 100       196 return unless defined($v);
234              
235 54 100       651 $vals->{$def->{'name'}} = ($def->{'multiple'})?$v:$v->[0];
236             }
237              
238             sub _trim {
239 137     137   162 my $self = shift;
240 137         165 my $v = shift;
241              
242 137 100       349 return undef unless defined($v);
243              
244 97         374 $v =~ s/^\s*//;
245 97         752 $v =~ s/\s*$//;
246              
247 97 100       622 return (length($v))?$v:undef;
248             }
249              
250             1;
251              
252             ################################################################################
253             # Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org).
254             # All rights reserved.
255             #
256             # You may use and distribute Apache::Voodoo under the terms described in the
257             # LICENSE file include in this package. The summary is it's a legalese version
258             # of the Artistic License :)
259             #
260             ################################################################################