File Coverage

blib/lib/Data/Validator/Recursive.pm
Criterion Covered Total %
statement 89 90 98.8
branch 40 46 86.9
condition 3 5 60.0
subroutine 13 13 100.0
pod 7 7 100.0
total 152 161 94.4


line stmt bran cond sub pod time code
1             package Data::Validator::Recursive;
2              
3 4     4   51442 use strict;
  4         5  
  4         86  
4 4     4   13 use warnings;
  4         3  
  4         72  
5 4     4   66 use 5.008_001;
  4         12  
6             our $VERSION = '0.07';
7              
8 4     4   12 use Carp 'croak';
  4         3  
  4         202  
9 4     4   1593 use Data::Validator;
  4         83642  
  4         2759  
10              
11             sub new {
12 26     26 1 15819 my ($class, @args) = @_;
13 26 100       175 croak "Usage: Data::Validator::Recursive->new(\$arg_name => \$rule [, ... ])" unless @args;
14              
15 25   66     109 my $self = bless {
16             validator => undef,
17             nested_validators => [],
18             error => undef,
19             }, ref $class || $class;
20              
21 25         50 $self->_build_rules(@args);
22 24         23391 return $self;
23             }
24              
25             sub _build_rules {
26 25     25   34 my ($self, @args) = @_;
27              
28 25         59 for (my ($i, $l) = (0, scalar @args); $i < $l; $i += 2) {
29 57         63 my ($name, $rule) = @args[$i, $i+1];
30 57 100       101 $rule = { isa => $rule } unless ref $rule eq 'HASH';
31              
32 57 100       145 if (my $nested_rule = delete $rule->{rule}) {
33 13 100       41 if (ref $nested_rule eq 'HASH') {
    100          
34 1         3 $nested_rule = [ %$nested_rule ];
35             }
36             elsif (ref $nested_rule ne 'ARRAY') {
37 1         173 croak "$name.rule must be ARRAY or HASH";
38             }
39              
40 12   50     18 $rule->{isa} ||= 'HashRef';
41 12         17 my $with = delete $rule->{with};
42 12         30 my $validator = $self->new(@$nested_rule);
43 12 100       24 if ($with) {
44 2 50       7 $with = [ $with ] unless ref $with eq 'ARRAY';
45 2         5 $validator->with(@$with);
46             }
47              
48 12         13 push @{ $self->{nested_validators} }, {
  12         55  
49             name => $name,
50             validator => $validator,
51             };
52             }
53             }
54              
55 24         165 $self->{validator} = Data::Validator->new(@args)->with('NoThrow');
56             }
57              
58             sub with {
59 4     4 1 8 my ($self, @extentions) = @_;
60 4         15 $self->{validator}->with(@extentions);
61 4         3959 return $self;
62             }
63              
64             sub validate {
65 31     31 1 6060 my ($self, $params, $_parent_name) = @_;
66 31         29 $self->{errors} = undef;
67              
68 31         94 my ($result) = $self->{validator}->validate($params);
69 31 100       1677 if (my $errors = $self->{validator}->clear_errors) {
70             $self->{errors} = [
71             map {
72 6 100       11 my $name = $_parent_name ? "$_parent_name.$_->{name}" : $_->{name};
  9         17  
73 9         9 my $type = $_->{type};
74 9         5 my ($message, $other_name);
75 9 100       25 if ($type eq 'ExclusiveParameter') {
    100          
    50          
76             $other_name = $_parent_name
77 2 50       9 ? "$_parent_name.$_->{conflict}" : $_->{conflict};
78 2         7 $message = sprintf q{'%s' and '%s' is %s}, $name, $other_name, $type;
79             }
80             elsif ($type eq 'InvalidValue') {
81 4         12 my $org_message = (split ': ', $_->{message}, 2)[1];
82 4         13 $message = sprintf q{Invalid value for '%s': %s}, $name, $org_message;
83             }
84             elsif ($type eq 'MissingParameter') {
85 3         7 my $org_message = (split ': ', $_->{message}, 2)[1];
86 3 50       36 $org_message =~ s/'([^']+)'/'$_parent_name.$1'/g if $_parent_name;
87 3         8 $message = sprintf q{Missing parameter: %s}, $org_message;
88             }
89             else {
90 0         0 $message = sprintf q{'%s' is %s}, $name, $type;
91             }
92              
93             +{
94 9 100       33 type => $type,
95             name => $name,
96             message => $message,
97             defined $other_name ? (conflict => $other_name) : (),
98             };
99             } @$errors
100             ];
101 6         19 return;
102             }
103              
104 25         18 for my $rule (@{ $self->{nested_validators} }) {
  25         317  
105 15         17 my $name = $rule->{name};
106 15 50       23 next unless exists $result->{$name};
107              
108 15         15 my $validator = $rule->{validator};
109              
110 15         10 my $result_in_nested;
111 15 100       28 if (ref $result->{$name} eq 'ARRAY') {
112 9         11 $result_in_nested = [];
113 9         7 my $i = 0;
114 9         8 for my $child_params (@{ $result->{$name} }) {
  9         13  
115 10         29 my $indexed_name = sprintf('%s[%d]', $name, $i++);
116 10 100       32 my ($child_result) = $validator->validate($child_params, $_parent_name ? "$_parent_name.$indexed_name" : $indexed_name);
117 10 100       17 if (my $errors = $validator->errors) {
118 3         2 $self->{errors} = $errors;
119 3         14 return;
120             }
121 7         11 push @$result_in_nested, $child_result;
122             }
123             }
124             else {
125 6 50       18 ($result_in_nested) = $validator->validate($result->{$name}, $_parent_name ? "$_parent_name.$name" : $name);
126             }
127              
128 12 100       45 if (my $errors = $validator->errors) {
129 2         2 $self->{errors} = $errors;
130 2         7 return;
131             } else {
132 10         16 $result->{$name} = $result_in_nested;
133             }
134             }
135              
136 20         33 return $result;
137             }
138              
139             sub error {
140 23     23 1 23 my $self = shift;
141 23 100       33 my $errors = $self->errors or return;
142 14         64 $errors->[0];
143             }
144              
145             sub errors {
146 87     87 1 71 my $self = shift;
147 87         254 $self->{errors};
148             }
149              
150             sub has_errors {
151 19     19 1 5458 my $self = shift;
152 19 100       68 $self->{errors} ? 1 : 0;
153             }
154             *has_error = *has_errors; # backward compatible
155              
156             sub clear_errors {
157 15     15 1 13 my $self = shift;
158 15         44 delete $self->{errors};
159             }
160              
161             1;
162             __END__