File Coverage

blib/lib/FormValidator/Lite.pm
Criterion Covered Total %
statement 142 149 95.3
branch 48 64 75.0
condition 4 12 33.3
subroutine 28 29 96.5
pod 16 16 100.0
total 238 270 88.1


line stmt bran cond sub pod time code
1             package FormValidator::Lite;
2 30     30   505584 use strict;
  30         54  
  30         1041  
3 30     30   123 use warnings;
  30         41  
  30         749  
4 30     30   570 use 5.008_001;
  30         110  
  30         922  
5 30     30   131 use Carp ();
  30         45  
  30         539  
6 30     30   118 use Scalar::Util qw/blessed/;
  30         42  
  30         3021  
7 30     30   11918 use FormValidator::Lite::Constraint::Default;
  30         51  
  30         891  
8 30     30   10549 use FormValidator::Lite::Upload;
  30         56  
  30         1093  
9             use Class::Accessor::Lite 0.05 (
10 30         522 rw => [qw/query/]
11 30     30   10537 );
  30         20635  
12 30     30   16478 use Class::Load ();
  30         741765  
  30         862  
13 30     30   11197 use FormValidator::Lite::Hash;
  30         58  
  30         23570  
14              
15             our $VERSION = '0.38';
16              
17             our $Rules;
18             our $FileRules;
19              
20             sub import {
21 30     30   255 my ($class, @constraints) = @_;
22 30         86 $class->load_constraints(@constraints);
23             }
24              
25             sub new {
26 82     82 1 143638 my ($class, $q) = @_;
27 82 50       248 Carp::croak("Usage: ${class}->new(\$q)") unless $q;
28              
29 82 100       531 if (ref $q eq 'HASH') {
    100          
30 3         23 $q = FormValidator::Lite::Hash->new($q);
31             } elsif (UNIVERSAL::isa($q, 'Hash::MultiValue')) {
32 3         11 $q = FormValidator::Lite::Hash->new($q->flatten);
33             }
34 82         367 bless { query => $q, _error => {} }, $class;
35             }
36              
37             sub check {
38 77     77 1 4056 my ($self, @rule_ary) = @_;
39 77 50       224 Carp::croak("this is an instance method") unless ref $self;
40              
41 77         245 while (my ($rule_key, $rules) = splice(@rule_ary, 0, 2)) {
42 133         248 my ($key, @values) = $self->_extract_values($rule_key);
43 133         186 for my $value (@values) {
44 144         136 local $_ = $value;
45 144         175 for my $rule (@$rules) {
46 167 100       281 my $rule_name = ref($rule) ? $rule->[0] : $rule;
47 167 100       346 my $args = ref($rule) ? [ @$rule[ 1 .. scalar(@$rule)-1 ] ] : +[];
48              
49 167 100       329 if ($FileRules->{$rule_name}) {
50 9         31 $_ = FormValidator::Lite::Upload->new($self->{query}, $key);
51             }
52 167         136 my $is_ok = do {
53 167 100 100     817 if ((not (defined $_ && length $_)) && $rule_name !~ /^(NOT_NULL|NOT_BLANK|REQUIRED)$/) {
54 8         12 1;
55             } else {
56 159 100       260 if (my $file_rule = $FileRules->{$rule_name}) {
57 9 100       21 $file_rule->(@$args) ? 1 : 0;
58             } else {
59 150 50       291 my $code = $Rules->{$rule_name} or Carp::croak("unknown rule $rule_name");
60 150 100       355 $code->(@$args) ? 1 : 0;
61             }
62             }
63             };
64 167 100       2981 if ($is_ok==0) {
65 67         144 $self->set_error($key => $rule_name);
66             }
67             }
68             }
69             }
70              
71 77         122 return $self;
72             }
73              
74             sub _extract_values {
75 133     133   138 my ($self, $key) = @_;
76              
77 133         139 local $CGI::LIST_CONTEXT_WARN = 0;
78 133         190 my $q = $self->{query};
79 133         113 my @values;
80 133 100       212 if (ref $key) {
81 15         38 $key = [%$key];
82 15         17 @values = [ map { $q->param($_) } @{ $key->[1] } ];
  40         363  
  15         30  
83 15         213 $key = $key->[0];
84             } else {
85 118 100       243 @values = defined $q->param($key) ? $q->param($key) : undef;
86             }
87 133         2801 return ($key, @values);
88             }
89              
90             sub is_error {
91 118     118 1 21988 my ($self, $key) = @_;
92 118 100       485 $self->{_error}->{$key} ? 1 : 0;
93             }
94              
95             sub is_valid {
96 0     0 1 0 my $self = shift;
97 0 0       0 !$self->has_error ? 1 : 0;
98             }
99              
100             sub has_error {
101 43     43 1 187 my ($self, ) = @_;
102 43 100       43 %{ $self->{_error} } ? 1 : 0;
  43         265  
103             }
104              
105             sub set_error {
106 76     76 1 152 my ($self, $param, $rule_name) = @_;
107 76         213 $self->{_error}->{$param}->{$rule_name}++;
108 76         74 push @{$self->{_error_ary}}, [$param, $rule_name];
  76         454  
109             }
110              
111             sub errors {
112 6     6 1 52 my ($self) = @_;
113 6         78 $self->{_error};
114             }
115              
116             sub load_constraints {
117 36     36 1 107 my $class = shift;
118 36         1819 for (@_) {
119 10         18 my $constraint = $_;
120 10 100       52 $constraint = ($constraint =~ s/^\+//) ? $constraint : "FormValidator::Lite::Constraint::${constraint}";
121 10         43 Class::Load::load_class($constraint);
122             }
123             }
124              
125             sub load_function_message {
126 1     1 1 2 my ($self, $lang) = @_;
127 1         2 my $pkg = "FormValidator::Lite::Messages::$lang";
128 1         6 Class::Load::load_class($pkg);
129              
130 30     30   168 no strict 'refs';
  30         100  
  30         17756  
131 1         25 $self->{_msg}->{function} = ${"${pkg}::MESSAGES"};
  1         8  
132             }
133              
134             sub set_param_message {
135 1     1 1 3 my ($self, %args) = @_;
136 1         4 $self->{_msg}->{param} = \%args;
137             }
138              
139             sub set_message_data {
140 3     3 1 57164 my ($self, $msg) = @_;
141 3         14 for my $key (qw/param function/) {
142 6 50       39 Carp::croak("missing key $key") unless $msg->{$key};
143             }
144 3         23 $self->{_msg} = $msg;
145             }
146              
147             sub set_message {
148 1     1 1 3 my ($self, @args) = @_;
149 1 50       6 my %msg = ref $args[0] ? %{$args[0]} : @args;
  0         0  
150 1 50       9 $self->{_msg}->{message} = +{
151 1         1 %{ $self->{_msg}->{message} || +{} },
152             %msg
153             };
154             }
155              
156             sub get_error_messages {
157 5     5 1 3197 my $self = shift;
158 5 50       43 Carp::croak("No messages loaded yet") unless $self->{_msg};
159              
160 5         8 my %dup_check;
161             my @messages;
162 5         6 for my $err (@{$self->{_error_ary}}) {
  5         14  
163 11         19 my $param = $err->[0];
164 11         16 my $func = $err->[1];
165              
166 11 50       35 next if exists $dup_check{"$param.$func"};
167 11         26 push @messages, $self->get_error_message( $param, $func );
168 11         46 $dup_check{"$param.$func"}++;
169             }
170              
171 5 100       42 return wantarray ? @messages : \@messages;
172             }
173              
174             # $validator->get_error_message('email', 'NOT_NULL');
175             sub get_error_message {
176 16     16 1 54 my ($self, $param, $function) = @_;
177 16         34 $function = lc($function);
178              
179 16         27 my $msg = $self->{_msg};
180 16 50       34 Carp::croak("please load message file first") unless $msg;
181              
182 16         43 my $err_message = $msg->{message}->{"${param}.${function}"};
183 16         28 my $err_param = $msg->{param}->{$param};
184 16         33 my $err_function = $msg->{function}->{$function};
185            
186 16 100 33     76 if ($err_message) {
    50          
187 5         20 return $self->build_message($err_message, $err_param);
188             } elsif ($err_function && $err_param) {
189 11         35 return $self->build_message($err_function, $err_param);
190             } else {
191 0         0 Carp::carp "${param}.${function} is not defined in message file.";
192 0 0       0 if ($msg->{default_tmpl}) {
193 0   0     0 return $self->build_message($err_function || $msg->{default_tmpl}, $err_function || $param);
      0        
194             } else {
195 0         0 return '';
196             }
197             }
198             }
199              
200             sub build_message {
201 17     17 1 43 my ($self, $tmpl, @args) = @_;
202 17         24 local $_ = $tmpl;
203 17         101 s!\[_(\d+)\]!$args[$1-1]!ge;
  13         69  
204 17         73 $_;
205             }
206              
207             sub get_error_messages_from_param {
208 1     1 1 13 my ($self, $target_param) = @_;
209              
210 1         2 my %dup_check;
211             my @messages;
212 1         2 for my $err (@{$self->{_error_ary}}) {
  1         3  
213 3         6 my $param = $err->[0];
214 3         4 my $func = $err->[1];
215              
216 3 100       7 next if $target_param ne $param;
217 2 50       10 next if exists $dup_check{"$param.$func"};
218 2         6 push @messages, $self->get_error_message( $param, $func );
219 2         6 $dup_check{"$param.$func"}++;
220             }
221              
222 1 50       11 return wantarray ? @messages : \@messages;
223             }
224              
225             1;
226              
227             __END__