line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Version 0 module |
2
|
|
|
|
|
|
|
package Validator::Custom::Result; |
3
|
5
|
|
|
5
|
|
28
|
use Object::Simple -base; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
45
|
|
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
476
|
use Carp 'croak'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
6240
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# Attrbutes |
8
|
|
|
|
|
|
|
has data => sub { {} }; |
9
|
|
|
|
|
|
|
has raw_data => sub { {} }; |
10
|
|
|
|
|
|
|
has missing_params => sub { [] }; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub is_valid { |
13
|
117
|
|
|
117
|
1
|
984
|
my ($self, $name) = @_; |
14
|
|
|
|
|
|
|
|
15
|
117
|
100
|
|
|
|
246
|
if (defined $name) { |
16
|
116
|
100
|
|
|
|
674
|
return exists $self->{_error_infos}->{$name} ? 0 : 1; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
else { |
19
|
1
|
50
|
|
|
|
2
|
return !(keys %{$self->{_error_infos}}) ? 1 : 0; |
|
1
|
|
|
|
|
9
|
|
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub message { |
24
|
63
|
|
|
63
|
1
|
108
|
my ($self, $name) = @_; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Parameter name not specified |
27
|
63
|
100
|
|
|
|
278
|
croak 'Parameter name must be specified' |
28
|
|
|
|
|
|
|
unless $name; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
return $self->{_error_infos}->{$name}{message} |
31
|
62
|
|
50
|
|
|
281
|
|| $self->{_default_messages}{$name} |
32
|
|
|
|
|
|
|
|| 'Error message not specified'; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub messages { |
36
|
19
|
|
|
19
|
1
|
740
|
my $self = shift; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Error messages |
39
|
19
|
|
|
|
|
31
|
my @messages; |
40
|
19
|
|
|
|
|
42
|
my $error_infos = $self->{_error_infos}; |
41
|
19
|
|
|
|
|
93
|
my @keys = sort { $error_infos->{$a}{position} <=> |
42
|
14
|
|
|
|
|
60
|
$error_infos->{$b}{position} } keys %$error_infos; |
43
|
19
|
|
|
|
|
48
|
foreach my $name (@keys) { |
44
|
29
|
|
|
|
|
77
|
my $message = $self->message($name); |
45
|
29
|
|
|
|
|
79
|
push @messages, $message; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
19
|
|
|
|
|
121
|
return \@messages; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub messages_to_hash { |
52
|
13
|
|
|
13
|
1
|
1518
|
my $self = shift; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Error messages |
55
|
13
|
|
|
|
|
26
|
my $messages = {}; |
56
|
13
|
|
|
|
|
18
|
foreach my $name (keys %{$self->{_error_infos}}) { |
|
13
|
|
|
|
|
42
|
|
57
|
27
|
|
|
|
|
64
|
$messages->{$name} = $self->message($name); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
13
|
|
|
|
|
62
|
return $messages; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub is_ok { |
64
|
46
|
|
|
46
|
1
|
1063
|
my $self = shift; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Is ok? |
67
|
46
|
100
|
100
|
|
|
135
|
return !$self->has_invalid && !$self->has_missing ? 1 : 0; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub to_hash { |
71
|
2
|
|
|
2
|
1
|
10
|
my $self = shift; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Result |
74
|
2
|
|
|
|
|
4
|
my $result = {}; |
75
|
2
|
|
|
|
|
5
|
$result->{ok} = $self->is_ok; |
76
|
2
|
|
|
|
|
6
|
$result->{invalid} = $self->has_invalid; |
77
|
2
|
|
|
|
|
5
|
$result->{missing} = $self->has_missing; |
78
|
2
|
|
|
|
|
84
|
$result->{missing_params} = $self->missing_params; |
79
|
2
|
|
|
|
|
15
|
$result->{messages} = $self->messages_to_hash; |
80
|
|
|
|
|
|
|
|
81
|
2
|
|
|
|
|
28
|
return $result; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub invalid_rule_keys { |
85
|
42
|
|
|
42
|
1
|
85
|
my $self = shift; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Invalid rule keys |
88
|
42
|
|
|
|
|
71
|
my $error_infos = $self->{_error_infos}; |
89
|
42
|
|
|
|
|
164
|
my @invalid_rule_keys = sort { $error_infos->{$a}{position} <=> |
90
|
35
|
|
|
|
|
95
|
$error_infos->{$b}{position} } keys %$error_infos; |
91
|
|
|
|
|
|
|
|
92
|
42
|
|
|
|
|
235
|
return \@invalid_rule_keys; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
30
|
100
|
|
30
|
1
|
52
|
sub has_missing { @{shift->missing_params} ? 1 : 0 } |
|
30
|
|
|
|
|
653
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub has_invalid { |
98
|
58
|
|
|
58
|
1
|
160
|
my $self = shift; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Has invalid parameter? |
101
|
58
|
100
|
|
|
|
71
|
return keys %{$self->{_error_infos}} ? 1 : 0; |
|
58
|
|
|
|
|
411
|
|
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub loose_data { |
105
|
3
|
|
|
3
|
1
|
646
|
my $self = shift; |
106
|
3
|
|
|
|
|
6
|
return {%{$self->raw_data}, %{$self->data}}; |
|
3
|
|
|
|
|
67
|
|
|
3
|
|
|
|
|
82
|
|
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub invalid_params { |
110
|
6
|
|
|
6
|
1
|
39
|
my $self = shift; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Invalid parameter names |
113
|
6
|
|
|
|
|
11
|
my @invalid_params; |
114
|
6
|
|
|
|
|
12
|
foreach my $name (@{$self->invalid_rule_keys}) { |
|
6
|
|
|
|
|
27
|
|
115
|
7
|
|
|
|
|
17
|
my $param = $self->{_error_infos}->{$name}{original_key}; |
116
|
7
|
100
|
|
|
|
30
|
$param = [$param] unless ref $param eq 'ARRAY'; |
117
|
7
|
|
|
|
|
22
|
push @invalid_params, @$param; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
6
|
|
|
|
|
37
|
return \@invalid_params; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# DEPRECATED! |
125
|
|
|
|
|
|
|
sub error_reason { |
126
|
|
|
|
|
|
|
|
127
|
4
|
|
|
4
|
0
|
52
|
warn "Validator::Custom::Result error_reason is DEPRECATED!."; |
128
|
|
|
|
|
|
|
|
129
|
4
|
|
|
|
|
32
|
my ($self, $name) = @_; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Parameter name not specified |
132
|
4
|
100
|
|
|
|
175
|
croak 'Parameter name must be specified' |
133
|
|
|
|
|
|
|
unless $name; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Error reason |
136
|
3
|
|
|
|
|
15
|
return $self->{_error_infos}->{$name}{reason}; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# DEPRECATED! |
140
|
|
|
|
|
|
|
has error_infos => sub { {} }; |
141
|
|
|
|
|
|
|
# DEPRECATED! |
142
|
|
|
|
|
|
|
sub add_error_info { |
143
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
144
|
0
|
|
|
|
|
0
|
warn "add_error_info method is DEPRECATED!"; |
145
|
|
|
|
|
|
|
# Merge |
146
|
0
|
0
|
|
|
|
0
|
my $error_infos = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
147
|
0
|
|
|
|
|
0
|
$self->error_infos({%{$self->error_infos}, %$error_infos}); |
|
0
|
|
|
|
|
0
|
|
148
|
0
|
|
|
|
|
0
|
return $self; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
# DEPRECATED! |
151
|
|
|
|
|
|
|
sub error { |
152
|
3
|
|
|
3
|
0
|
799
|
warn "error_info method is DEPRECATED!"; |
153
|
3
|
|
|
|
|
30
|
shift->message(@_) |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
# DEPRECATED! |
156
|
|
|
|
|
|
|
sub errors { |
157
|
14
|
|
|
14
|
0
|
248
|
warn "errors method is DEPRECATED!"; |
158
|
|
|
|
|
|
|
return wantarray |
159
|
14
|
100
|
|
|
|
158
|
? @{shift->messages(@_)} |
|
8
|
|
|
|
|
26
|
|
160
|
|
|
|
|
|
|
: shift->messages(@_); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
# DEPRECATED! |
163
|
|
|
|
|
|
|
sub errors_to_hash { |
164
|
2
|
|
|
2
|
0
|
670
|
warn "errors_to_hash method is DEPRECATED!"; |
165
|
2
|
|
|
|
|
20
|
shift->messages_to_hash(@_) |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
# DEPRECATED! |
168
|
|
|
|
|
|
|
sub invalid_keys { |
169
|
31
|
|
|
31
|
0
|
477
|
warn "invalid_keys method is DEPRECATED!"; |
170
|
|
|
|
|
|
|
return wantarray |
171
|
31
|
100
|
|
|
|
253
|
? @{shift->invalid_rule_keys(@_)} |
|
29
|
|
|
|
|
82
|
|
172
|
|
|
|
|
|
|
: shift->invalid_rule_keys(@_); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
# DEPRECATED! |
175
|
|
|
|
|
|
|
sub remove_error_info { |
176
|
0
|
|
|
0
|
0
|
|
my ($self, $key) = @_; |
177
|
0
|
|
|
|
|
|
warn "remove_error_info method is DEPRECATED!"; |
178
|
|
|
|
|
|
|
# Remove |
179
|
0
|
|
|
|
|
|
delete $self->error_infos->{$key}; |
180
|
0
|
|
|
|
|
|
return $self; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
1; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head1 NAME |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Validator::Custom::Result - Result of validation |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=head1 SYNOPSYS |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# Result |
192
|
|
|
|
|
|
|
my $result = $vc->validate($data, $rule); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Safety data |
195
|
|
|
|
|
|
|
my $safe_data = $result->data; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# Chacke if the result is valid. |
198
|
|
|
|
|
|
|
# (this means result have neither missing nor invalid parameter) |
199
|
|
|
|
|
|
|
my $is_ok = $result->is_ok; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# Check the existence of missing parameter |
202
|
|
|
|
|
|
|
my $has_missing_param = $result->has_missing; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Check if one parameter is valid |
205
|
|
|
|
|
|
|
my $title_is_valid = $result->is_valid('title'); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# Missing parameters(this is original keys) |
208
|
|
|
|
|
|
|
my $missing_params = $result->missing_params; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Invalid parameter names(this is original keys) |
211
|
|
|
|
|
|
|
my $invalid_params = $result->invalid_params; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# Invalid rule keys |
214
|
|
|
|
|
|
|
my $invalid_rule_keys = $result->invalid_rule_keys; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# A error message |
217
|
|
|
|
|
|
|
my $message = $result->message('title'); |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# Error messages |
220
|
|
|
|
|
|
|
my $messages = $result->messages; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# Error messages to hash ref |
223
|
|
|
|
|
|
|
my $messages_hash = $result->message_to_hash; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Result to hash |
226
|
|
|
|
|
|
|
my $rhash = $result->to_hash; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Raw data |
229
|
|
|
|
|
|
|
my $raw_data = $result->raw_data; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 data |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
my $data = $result->data; |
237
|
|
|
|
|
|
|
$result = $result->data($data); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Get the data in the end state. L has filtering ability |
240
|
|
|
|
|
|
|
if you need. |
241
|
|
|
|
|
|
|
The data passed to C is converted to other data by filter. |
242
|
|
|
|
|
|
|
You can get filtered data using C. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head2 missing_params |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $missing_params = $result->missing_params; |
247
|
|
|
|
|
|
|
$result = $result->missing_params($missing_params); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
You can get missing parameter names using C. |
250
|
|
|
|
|
|
|
In this example, return value is the following one. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=head2 raw_data |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my $data = $result->raw_data; |
255
|
|
|
|
|
|
|
$result = $result->raw_data($data); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Raw data soon after data_filter is executed. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head1 METHODS |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
L inherits all methods from L |
262
|
|
|
|
|
|
|
and implements the following new ones. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head2 has_invalid |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $has_invalid = $result->has_invalid; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
If at least one of parameter value is invalid, |
269
|
|
|
|
|
|
|
C return true value. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head2 has_missing |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
my $has_missing_param = $result->has_missing; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
If at least one of parameter names specified in the rule |
276
|
|
|
|
|
|
|
is not found in the data, |
277
|
|
|
|
|
|
|
C return true value. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head2 invalid_params |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
my $invalid_params = $result->invalid_params; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Invalid raw data parameter names. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head2 invalid_rule_keys |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
my $invalid_rule_keys = $result->invalid_rule_keys; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
Invalid rule keys |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=head2 is_ok |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
my $is_ok = $result->is_ok; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
If you check the data is completely valid, use C. |
296
|
|
|
|
|
|
|
C return true value |
297
|
|
|
|
|
|
|
if invalid parameter values is not found and all parameter |
298
|
|
|
|
|
|
|
names specified in the rule is found in the data. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 is_valid |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
my $title_is_valid = $result->is_valid('title'); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Check if one parameter is valid. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head2 loose_data |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $loose_data = $result->loose_data; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
Loose data, which is data merged C and C |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# Loose data |
313
|
|
|
|
|
|
|
{%{$self->raw_data}, %{$self->data}} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=head2 message |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
my $message = $result->message('title'); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Get a message corresponding to the parameter name which value is invalid. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head2 messages |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
my $messages = $result->messages; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Get messages corresponding to the parameter names which value is invalid. |
326
|
|
|
|
|
|
|
Messages keep the order of parameter names of the rule. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=head2 messages_to_hash |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
my $messages = $result->messages_to_hash; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
You can get the pairs of invalid parameter name and message |
333
|
|
|
|
|
|
|
using C. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=head2 to_hash |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my $rhash = $result->to_hash; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Convert result information to hash reference. |
340
|
|
|
|
|
|
|
The following keys is set. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
{ |
343
|
|
|
|
|
|
|
ok => $result->is_ok, |
344
|
|
|
|
|
|
|
missing => $result->has_missing, |
345
|
|
|
|
|
|
|
invalid => $result->has_invalid, |
346
|
|
|
|
|
|
|
missing_params => $result->missing_params, |
347
|
|
|
|
|
|
|
messages => $result->messages_to_hash |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |