File Coverage

blib/lib/FormValidator/Lite.pm
Criterion Covered Total %
statement 141 148 95.2
branch 48 64 75.0
condition 4 12 33.3
subroutine 28 29 96.5
pod 16 16 100.0
total 237 269 88.1


line stmt bran cond sub pod time code
1             package FormValidator::Lite;
2 30     30   419166 use strict;
  30         37  
  30         684  
3 30     30   92 use warnings;
  30         33  
  30         542  
4 30     30   510 use 5.008_001;
  30         74  
5 30     30   105 use Carp ();
  30         42  
  30         493  
6 30     30   91 use Scalar::Util qw/blessed/;
  30         29  
  30         2442  
7 30     30   10496 use FormValidator::Lite::Constraint::Default;
  30         37  
  30         751  
8 30     30   9482 use FormValidator::Lite::Upload;
  30         833  
  30         1510  
9             use Class::Accessor::Lite 0.05 (
10 30         404 rw => [qw/query/]
11 30     30   8072 );
  30         16301  
12 30     30   13619 use Class::Load ();
  30         438716  
  30         571  
13 30     30   9566 use FormValidator::Lite::Hash;
  30         47  
  30         19995  
14              
15             our $VERSION = '0.39';
16              
17             our $Rules;
18             our $FileRules;
19              
20             sub import {
21 30     30   205 my ($class, @constraints) = @_;
22 30         60 $class->load_constraints(@constraints);
23             }
24              
25             sub new {
26 82     82 1 81852 my ($class, $q) = @_;
27 82 50       201 Carp::croak("Usage: ${class}->new(\$q)") unless $q;
28              
29 82 100       420 if (ref $q eq 'HASH') {
    100          
30 3         18 $q = FormValidator::Lite::Hash->new($q);
31             } elsif (UNIVERSAL::isa($q, 'Hash::MultiValue')) {
32 3         12 $q = FormValidator::Lite::Hash->new($q->flatten);
33             }
34 82         273 bless { query => $q, _error => {} }, $class;
35             }
36              
37             sub check {
38 77     77 1 3570 my ($self, @rule_ary) = @_;
39 77 50       200 Carp::croak("this is an instance method") unless ref $self;
40              
41 77         220 while (my ($rule_key, $rules) = splice(@rule_ary, 0, 2)) {
42 133         211 my ($key, @values) = $self->_extract_values($rule_key);
43 133         203 for my $value (@values) {
44 144         135 local $_ = $value;
45 144         163 for my $rule (@$rules) {
46 167 100       242 my $rule_name = ref($rule) ? $rule->[0] : $rule;
47 167 100       321 my $args = ref($rule) ? [ @$rule[ 1 .. scalar(@$rule)-1 ] ] : +[];
48              
49 167 100       296 if ($FileRules->{$rule_name}) {
50 9         28 $_ = FormValidator::Lite::Upload->new($self->{query}, $key);
51             }
52 167         117 my $is_ok = do {
53 167 100 100     762 if ((not (defined $_ && length $_)) && $rule_name !~ /^(NOT_NULL|NOT_BLANK|REQUIRED)$/) {
54 8         9 1;
55             } else {
56 159 100       221 if (my $file_rule = $FileRules->{$rule_name}) {
57 9 100       18 $file_rule->(@$args) ? 1 : 0;
58             } else {
59 150 50       257 my $code = $Rules->{$rule_name} or Carp::croak("unknown rule $rule_name");
60 150 100       330 $code->(@$args) ? 1 : 0;
61             }
62             }
63             };
64 167 100       2520 if ($is_ok==0) {
65 67         141 $self->set_error($key => $rule_name);
66             }
67             }
68             }
69             }
70              
71 77         131 return $self;
72             }
73              
74             sub _extract_values {
75 133     133   129 my ($self, $key) = @_;
76              
77 133         121 local $CGI::LIST_CONTEXT_WARN = 0;
78 133         153 my $q = $self->{query};
79 133         112 my @values;
80 133 100       172 if (ref $key) {
81 15         32 $key = [%$key];
82 15         15 @values = [ map { $q->param($_) } @{ $key->[1] } ];
  40         315  
  15         23  
83 15         166 $key = $key->[0];
84             } else {
85 118 100       216 @values = defined $q->param($key) ? $q->param($key) : undef;
86             }
87 133         2592 return ($key, @values);
88             }
89              
90             sub is_error {
91 118     118 1 17850 my ($self, $key) = @_;
92 118 100       417 $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 172 my ($self, ) = @_;
102 43 100       31 %{ $self->{_error} } ? 1 : 0;
  43         238  
103             }
104              
105             sub set_error {
106 76     76 1 103 my ($self, $param, $rule_name) = @_;
107 76         155 $self->{_error}->{$param}->{$rule_name}++;
108 76         62 push @{$self->{_error_ary}}, [$param, $rule_name];
  76         379  
109             }
110              
111             sub errors {
112 6     6 1 38 my ($self) = @_;
113 6         78 $self->{_error};
114             }
115              
116             sub load_constraints {
117 36     36 1 84 my $class = shift;
118 36         1433 for (@_) {
119 10         15 my $constraint = $_;
120 10 100       48 $constraint = ($constraint =~ s/^\+//) ? $constraint : "FormValidator::Lite::Constraint::${constraint}";
121 10         34 Class::Load::load_class($constraint);
122             }
123             }
124              
125             sub load_function_message {
126 1     1 1 2 my ($self, $lang) = @_;
127 1         3 my $pkg = "FormValidator::Lite::Messages::$lang";
128 1         4 Class::Load::load_class($pkg);
129              
130 30     30   136 no strict 'refs';
  30         30  
  30         15129  
131 1         23 $self->{_msg}->{function} = ${"${pkg}::MESSAGES"};
  1         7  
132             }
133              
134             sub set_param_message {
135 1     1 1 5 my ($self, %args) = @_;
136 1         3 $self->{_msg}->{param} = \%args;
137             }
138              
139             sub set_message_data {
140 3     3 1 35182 my ($self, $msg) = @_;
141 3         9 for my $key (qw/param function/) {
142 6 50       25 Carp::croak("missing key $key") unless $msg->{$key};
143             }
144 3         12 $self->{_msg} = $msg;
145             }
146              
147             sub set_message {
148 1     1 1 2 my ($self, @args) = @_;
149 1 50       5 my %msg = ref $args[0] ? %{$args[0]} : @args;
  0         0  
150             $self->{_msg}->{message} = +{
151 1 50       1 %{ $self->{_msg}->{message} || +{} },
  1         8  
152             %msg
153             };
154             }
155              
156             sub get_error_messages {
157 5     5 1 1370 my $self = shift;
158 5 50       34 Carp::croak("No messages loaded yet") unless $self->{_msg};
159              
160 5         4 my %dup_check;
161             my @messages;
162 5         4 for my $err (@{$self->{_error_ary}}) {
  5         12  
163 11         8 my $param = $err->[0];
164 11         12 my $func = $err->[1];
165              
166 11 50       22 next if exists $dup_check{"$param.$func"};
167 11         17 push @messages, $self->get_error_message( $param, $func );
168 11         24 $dup_check{"$param.$func"}++;
169             }
170              
171 5 100       23 return wantarray ? @messages : \@messages;
172             }
173              
174             # $validator->get_error_message('email', 'NOT_NULL');
175             sub get_error_message {
176 16     16 1 28 my ($self, $param, $function) = @_;
177 16         20 $function = lc($function);
178              
179 16         18 my $msg = $self->{_msg};
180 16 50       26 Carp::croak("please load message file first") unless $msg;
181              
182 16         28 my $err_message = $msg->{message}->{"${param}.${function}"};
183 16         17 my $err_param = $msg->{param}->{$param};
184 16         18 my $err_function = $msg->{function}->{$function};
185            
186 16 100 33     54 if ($err_message) {
    50          
187 5         11 return $self->build_message($err_message, $err_param);
188             } elsif ($err_function && $err_param) {
189 11         23 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 25 my ($self, $tmpl, @args) = @_;
202 17         20 local $_ = $tmpl;
203 17         62 s!\[_(\d+)\]!$args[$1-1]!ge;
  13         45  
204 17         44 $_;
205             }
206              
207             sub get_error_messages_from_param {
208 1     1 1 12 my ($self, $target_param) = @_;
209              
210 1         2 my %dup_check;
211             my @messages;
212 1         1 for my $err (@{$self->{_error_ary}}) {
  1         3  
213 3         5 my $param = $err->[0];
214 3         2 my $func = $err->[1];
215              
216 3 100       8 next if $target_param ne $param;
217 2 50       5 next if exists $dup_check{"$param.$func"};
218 2         5 push @messages, $self->get_error_message( $param, $func );
219 2         5 $dup_check{"$param.$func"}++;
220             }
221              
222 1 50       7 return wantarray ? @messages : \@messages;
223             }
224              
225             1;
226              
227             __END__