line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::Result::Validation; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
23533
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
39
|
|
4
|
1
|
|
|
1
|
|
8
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
39
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
9
|
use Carp; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
94
|
|
7
|
1
|
|
|
1
|
|
622
|
use Try::Tiny; |
|
1
|
|
|
|
|
2413
|
|
|
1
|
|
|
|
|
73
|
|
8
|
1
|
|
|
1
|
|
10
|
use Scalar::Util 'blessed'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
88
|
|
9
|
1
|
|
|
1
|
|
517
|
use DBIx::Class::Result::Validation::VException; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
33
|
|
10
|
1
|
|
|
1
|
|
309
|
use DateTime; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use DateTime::Set; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
DBIx::Class::Result::Validation - DBIx::Class component to manage validation on result object |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Version 0.14 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.15'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 SYNOPSIS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
DBIx::Class::Result::Validation component call validate function before insert |
28
|
|
|
|
|
|
|
or update object and unauthorized these actions if validation set |
29
|
|
|
|
|
|
|
result_errors accessor. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
In your result class load_component : |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Package::Schema::Result::MyClass; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use strict; |
36
|
|
|
|
|
|
|
use warning; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
__PACKAGE__->load_component(qw/ ... Result::Validation /); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
defined your _validate function which will be called by validate function |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _validate |
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
my $self = shift; |
45
|
|
|
|
|
|
|
#validate if this object exist whith the same label |
46
|
|
|
|
|
|
|
my @other = $self->result_source->resultset->search({ label => $self->label |
47
|
|
|
|
|
|
|
id => {"!=", $self->id}}); |
48
|
|
|
|
|
|
|
if (scalar @other) |
49
|
|
|
|
|
|
|
{ |
50
|
|
|
|
|
|
|
$self->add_result_error('label', 'label must be unique'); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
When you try to create or update an object Package::Schema::Result::MyClass, |
56
|
|
|
|
|
|
|
if an other one with the same label exist, this one will be not created, |
57
|
|
|
|
|
|
|
validate return 0 and $self->result_errors will be set. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
$self->result_errors return : |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
{ label => ['label must be unique'] } |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Otherwise, object is create, validate return 1 and $self->result_errors is undef. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
It is possible to set more than one key error and more than one error by key |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$self->add_result_error('label', 'label must be unique'); |
68
|
|
|
|
|
|
|
$self->add_result_error('label', "label must not be `$self->label'"); |
69
|
|
|
|
|
|
|
$self->add_result_error('id', 'id is ok but not label'); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$self->result_errors return : |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
{ |
74
|
|
|
|
|
|
|
label => [ |
75
|
|
|
|
|
|
|
'label must be unique', |
76
|
|
|
|
|
|
|
"label must not be `my label'" |
77
|
|
|
|
|
|
|
], |
78
|
|
|
|
|
|
|
id => [ |
79
|
|
|
|
|
|
|
'id is ok but not label' |
80
|
|
|
|
|
|
|
] |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 Reserved Accessor |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
DBIx::Class::Result::Validation component create a new accessor to Result object. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
$self->result_errors |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
This field is used to store all errors |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
use base qw/ DBIx::Class Class::Accessor::Grouped /; |
94
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors(simple => qw(result_errors)); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 validate |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
This validate function is called before insert or update action. |
101
|
|
|
|
|
|
|
If result_errors is not defined it return true |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
You can redefined it in your Result object and call back it with : |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
return $self->next::method(@_); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub validate { |
110
|
|
|
|
|
|
|
my $self = shift; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
require Data::Dumper; |
113
|
|
|
|
|
|
|
$self->_erase_result_error(); |
114
|
|
|
|
|
|
|
my @columns = $self->result_source->columns; |
115
|
|
|
|
|
|
|
foreach my $field (@columns) |
116
|
|
|
|
|
|
|
{ |
117
|
|
|
|
|
|
|
if ($self->result_source->column_info($field)->{'validation'}) |
118
|
|
|
|
|
|
|
{ |
119
|
|
|
|
|
|
|
my $validations; |
120
|
|
|
|
|
|
|
#convert every sources of validation in array |
121
|
|
|
|
|
|
|
if ( ref($self->result_source->column_info($field)->{'validation'}) ne 'ARRAY'){ |
122
|
|
|
|
|
|
|
push @{$validations},$self->result_source->column_info($field)->{'validation'}; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
else{ |
125
|
|
|
|
|
|
|
$validations = $self->result_source->column_info($field)->{'validation'}; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
if ( scalar(@{$validations}) >0 ){ |
128
|
|
|
|
|
|
|
foreach my $validation (@{$validations}){ |
129
|
|
|
|
|
|
|
my $validation_function = "validate_" . $validation; |
130
|
|
|
|
|
|
|
#Unvalid validation method cause a croak exception |
131
|
|
|
|
|
|
|
croak( DBIx::Class::Result::Validation::VException->new( |
132
|
|
|
|
|
|
|
object => $self, |
133
|
|
|
|
|
|
|
message => "Validation : $validation is not valid" |
134
|
|
|
|
|
|
|
) |
135
|
|
|
|
|
|
|
) unless ($self->can($validation_function)); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
try{ |
138
|
|
|
|
|
|
|
$self->$validation_function($field); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
catch{ |
141
|
|
|
|
|
|
|
croak( |
142
|
|
|
|
|
|
|
DBIx::Class::Result::Validation::VException->new( |
143
|
|
|
|
|
|
|
object => $self, |
144
|
|
|
|
|
|
|
message => "Error is ".Data::Dumper::Dumper($_) |
145
|
|
|
|
|
|
|
) |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$self->_validate(); |
154
|
|
|
|
|
|
|
return 0 if (defined $self->result_errors); |
155
|
|
|
|
|
|
|
return 1; |
156
|
|
|
|
|
|
|
}; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=head2 error_reporting |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
function to configure on object to find what is wrong after a Database throw |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub error_reporting { |
165
|
|
|
|
|
|
|
return 1; |
166
|
|
|
|
|
|
|
}; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 _validate |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
_validate function is the function to redefine with validation behaviour object |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub _validate |
175
|
|
|
|
|
|
|
{ |
176
|
|
|
|
|
|
|
return 1; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 add_result_error |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$self->add_result_error($key, $error_string) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Add a string error attributed to a key (field of object) |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub add_result_error |
188
|
|
|
|
|
|
|
{ |
189
|
|
|
|
|
|
|
my ($self, $key, $value) = @_; |
190
|
|
|
|
|
|
|
if (defined $self->result_errors) |
191
|
|
|
|
|
|
|
{ |
192
|
|
|
|
|
|
|
if (defined $self->result_errors->{$key}) |
193
|
|
|
|
|
|
|
{ push(@{$self->result_errors->{$key}}, $value); } |
194
|
|
|
|
|
|
|
else |
195
|
|
|
|
|
|
|
{ $self->result_errors->{$key} = [$value]; } |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
else |
198
|
|
|
|
|
|
|
{ $self->result_errors({$key => [$value]}); } |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head2 insert |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
call before DBIx::Calss::Base insert |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Insert is done only if validate method return true |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=cut |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub insert { |
210
|
|
|
|
|
|
|
my $self = shift; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
my $insert = $self->next::can; |
213
|
|
|
|
|
|
|
return $self->_try_next_method($self->next::can, @_); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 update |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Call before DBIx::Class::Base update |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Update is done only if validate method return true |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=cut |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub update { |
225
|
|
|
|
|
|
|
my $self = shift; |
226
|
|
|
|
|
|
|
if ( my $columns = shift ) { |
227
|
|
|
|
|
|
|
$self->set_inflated_columns($columns); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
return $self->_try_next_method( $self->next::can, @_ ); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub _try_next_method { |
233
|
|
|
|
|
|
|
my $self = shift; |
234
|
|
|
|
|
|
|
my $next_method = shift; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
my $class = ref $self; |
237
|
|
|
|
|
|
|
my $result; |
238
|
|
|
|
|
|
|
try { |
239
|
|
|
|
|
|
|
if ( $self->validate ) { |
240
|
|
|
|
|
|
|
$result = $self->$next_method(@_); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
else { |
243
|
|
|
|
|
|
|
my $errors = $self->_get_errors; |
244
|
|
|
|
|
|
|
croak("$class: Validation failed.\n$errors"); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
catch { |
248
|
|
|
|
|
|
|
my $error = $_; |
249
|
|
|
|
|
|
|
$self->error_reporting(); |
250
|
|
|
|
|
|
|
$self->add_result_error(uncaught => $error) if !defined $self->result_errors; |
251
|
|
|
|
|
|
|
croak $error |
252
|
|
|
|
|
|
|
if ref $error eq 'DBIx::Class::Result::Validation::VException'; |
253
|
|
|
|
|
|
|
croak( |
254
|
|
|
|
|
|
|
DBIx::Class::Result::Validation::VException->new( |
255
|
|
|
|
|
|
|
object => $self, |
256
|
|
|
|
|
|
|
message => "$error" |
257
|
|
|
|
|
|
|
) |
258
|
|
|
|
|
|
|
); |
259
|
|
|
|
|
|
|
}; |
260
|
|
|
|
|
|
|
return $result; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub _get_errors { |
264
|
|
|
|
|
|
|
my $self = shift; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
require Data::Dumper; |
267
|
|
|
|
|
|
|
no warnings 'once'; |
268
|
|
|
|
|
|
|
local $Data::Dumper::Indent = 1; |
269
|
|
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1; |
270
|
|
|
|
|
|
|
local $Data::Dumper::Terse = 1; |
271
|
|
|
|
|
|
|
return Data::Dumper::Dumper( $self->{result_errors} ); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=head2 _erase_result_error |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
this function is called to re-init result_errors before call validate function |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=cut |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub _erase_result_error |
281
|
|
|
|
|
|
|
{ |
282
|
|
|
|
|
|
|
my $self = shift; |
283
|
|
|
|
|
|
|
$self->result_errors(undef); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head1 VALIDATION METHOD |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
set of function to validate fields |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=cut |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head2 validate_enum function |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
validation of the enum field, should return a validation error if the field is set and is not in the list of enum |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=cut |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub validate_enum { |
300
|
|
|
|
|
|
|
my ($self, $field) = @_; |
301
|
|
|
|
|
|
|
$self->add_result_error( $field, $field ." must be set with one of the following value: " .join(", ", @{$self->result_source->columns_info->{$field}->{extra}->{list}}) ) |
302
|
|
|
|
|
|
|
if( |
303
|
|
|
|
|
|
|
(!defined ($self->$field) && !defined($self->result_source->columns_info->{$field}->{default_value}) |
304
|
|
|
|
|
|
|
or |
305
|
|
|
|
|
|
|
(defined ($self->$field) && !($self->$field ~~ @{ $self->result_source->columns_info->{$field}->{extra}->{list} })) |
306
|
|
|
|
|
|
|
) |
307
|
|
|
|
|
|
|
); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=head2 validate_ascii |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
validation of field which must be ascii characters, return error if the field is not ascii |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub validate_ascii { |
317
|
|
|
|
|
|
|
my ($self, $field) = @_; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
$self->add_result_error( $field, "only ascii characters are authorized" ) |
320
|
|
|
|
|
|
|
if($self->$field && $self->$field =~ /[^[:ascii:]]/); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=head2 validate_defined |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
validation of field which must be defined, return error if the field is not defined |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=cut |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub validate_defined { |
331
|
|
|
|
|
|
|
my ($self, $field) = @_; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
$self->add_result_error( $field, "must be set" ) |
334
|
|
|
|
|
|
|
unless defined $self->$field; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head2 validate_not_empty |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
validation of a field which can be null but can't be empty |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub validate_not_empty { |
344
|
|
|
|
|
|
|
my ($self, $field) = @_; |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$self->add_result_error( $field, "can not be empty" ) |
347
|
|
|
|
|
|
|
if defined $self->$field && $self->$field eq ''; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head2 validate_not_null_or_not_zero |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
validation of a field which can be null and not equal to 0 |
353
|
|
|
|
|
|
|
this can be used for data_type integer |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
=cut |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub validate_not_null_or_not_zero { |
358
|
|
|
|
|
|
|
my ($self, $field) = @_; |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
$self->add_result_error( $field, "can not be null or equal to 0" ) |
361
|
|
|
|
|
|
|
if !$self->$field; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
1; |
365
|
|
|
|
|
|
|
__END__ |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=head1 SEE ALSO |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
L<"DBIx::Class"> |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head1 AUTHOR |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Nicolas Oudard <nicolas@oudard.org> |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
=head1 LICENSE |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
You may distribute this code under the same terms as Perl itself. |