|  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__  |