line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
2
|
|
|
2
|
|
1470
|
use utf8; |
|
2
|
|
|
|
|
11
|
|
|
2
|
|
|
|
|
13
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Interchange6::Schema::Component::Validation; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Interchange6::Schema::Component::Validation |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
package My::Result; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
__PACKAGE__->load_components(qw( |
14
|
|
|
|
|
|
|
+Interchange6::Schema::Component::Validation |
15
|
|
|
|
|
|
|
)); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub validate { |
18
|
|
|
|
|
|
|
my $self = shift; |
19
|
|
|
|
|
|
|
my $schema = $self->result_source->schema; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
unless ( $self->some_column =~ /magic/ ) { |
22
|
|
|
|
|
|
|
$schema->throw_exception("some_column does not contain magic"); |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This component allows validation of row attributes to be deferred until other components in the stack have been called. For example you might want to have the TimeStamp component called before validation so that datetime columns with set_on_create are defined before validation occurs. In this case your local_components call might look like; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
__PACKAGE__->load_components( |
31
|
|
|
|
|
|
|
qw(TimeStamp +Interchange6::Schema::Component::Validation) |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
In order to fail validation the L</validation> method must throw an exception. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=cut |
37
|
|
|
|
|
|
|
|
38
|
2
|
|
|
2
|
|
95
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
41
|
|
39
|
2
|
|
|
2
|
|
15
|
use warnings; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
62
|
|
40
|
|
|
|
|
|
|
|
41
|
2
|
|
|
2
|
|
13
|
use base 'DBIx::Class'; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
768
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 METHODS |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head2 validate |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Called before insert or update action. Method should be overloaded by class which load this component. Validation failures should result in L<DBIx::Class::Schema::throw_exception|DBIx::Class::Schema/throw_exception> being called. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub validate { |
52
|
|
|
|
|
|
|
# This method should be overloaded by calling class so this should never get |
53
|
|
|
|
|
|
|
# hit by Devel::Cover |
54
|
|
|
|
|
|
|
# uncoverable subroutine |
55
|
|
|
|
|
|
|
# uncoverable statement |
56
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head2 insert |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Overload insert to call L</validate> before insert is performed. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub insert { |
66
|
132
|
|
|
132
|
1
|
238173
|
my ( $self, @args ) = @_; |
67
|
132
|
|
|
|
|
324
|
eval{ $self->validate }; |
|
132
|
|
|
|
|
505
|
|
68
|
132
|
100
|
|
|
|
680192
|
if ($@) { |
69
|
9
|
|
|
|
|
97
|
$self->result_source->schema->throw_exception($@); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
123
|
|
|
|
|
590
|
$self->next::method(@args); |
73
|
|
|
|
|
|
|
} |
74
|
123
|
|
|
|
|
387810
|
return $self; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head2 update |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Overload update to call L</validate> before update is performed. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub update { |
84
|
3
|
|
|
3
|
1
|
11751
|
my ( $self, @args ) = @_; |
85
|
3
|
|
|
|
|
6
|
eval{ $self->validate }; |
|
3
|
|
|
|
|
14
|
|
86
|
3
|
100
|
|
|
|
12274
|
if ($@) { |
87
|
1
|
|
|
|
|
12
|
$self->result_source->schema->throw_exception($@); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
else { |
90
|
2
|
|
|
|
|
9
|
$self->next::method(@args); |
91
|
|
|
|
|
|
|
} |
92
|
2
|
|
|
|
|
3219
|
return $self; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
1; |