line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
404
|
|
|
404
|
|
214784
|
use strict; |
|
404
|
|
|
|
|
1126
|
|
|
404
|
|
|
|
|
22406
|
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package HTML::FormFu::Role::ContainsElementsSharedWithField; |
4
|
|
|
|
|
|
|
# ABSTRACT: Role for constraints on elements and fields |
5
|
|
|
|
|
|
|
$HTML::FormFu::Role::ContainsElementsSharedWithField::VERSION = '2.07'; |
6
|
404
|
|
|
404
|
|
2548
|
use Moose::Role; |
|
404
|
|
|
|
|
936
|
|
|
404
|
|
|
|
|
2794
|
|
7
|
|
|
|
|
|
|
|
8
|
404
|
|
|
|
|
23846
|
use HTML::FormFu::Util qw( |
9
|
|
|
|
|
|
|
require_class |
10
|
|
|
|
|
|
|
_merge_hashes |
11
|
404
|
|
|
404
|
|
2120038
|
); |
|
404
|
|
|
|
|
1068
|
|
12
|
404
|
|
|
404
|
|
2739
|
use Carp qw( croak ); |
|
404
|
|
|
|
|
1013
|
|
|
404
|
|
|
|
|
160964
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub get_error { |
15
|
7
|
|
|
7
|
0
|
20
|
my $self = shift; |
16
|
|
|
|
|
|
|
|
17
|
7
|
50
|
|
|
|
31
|
return if !$self->form->submitted; |
18
|
|
|
|
|
|
|
|
19
|
7
|
|
|
|
|
37
|
my $c = $self->get_errors(@_); |
20
|
|
|
|
|
|
|
|
21
|
7
|
100
|
|
|
|
110
|
return @$c ? $c->[0] : (); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _require_constraint { |
25
|
272
|
|
|
272
|
|
1032
|
my ( $self, $type, $arg ) = @_; |
26
|
|
|
|
|
|
|
|
27
|
272
|
50
|
|
|
|
1127
|
croak 'required arguments: $self, $type, \%options' if @_ != 3; |
28
|
|
|
|
|
|
|
|
29
|
272
|
|
|
|
|
712
|
eval { my %x = %$arg }; |
|
272
|
|
|
|
|
1194
|
|
30
|
272
|
50
|
|
|
|
1155
|
croak "options argument must be hash-ref" if $@; |
31
|
|
|
|
|
|
|
|
32
|
272
|
|
|
|
|
1028
|
my $abs = $type =~ s/^\+//; |
33
|
272
|
|
|
|
|
620
|
my $not = 0; |
34
|
|
|
|
|
|
|
|
35
|
272
|
100
|
|
|
|
1415
|
if ( $type =~ /^Not_(\w+)$/i ) { |
36
|
4
|
|
|
|
|
15
|
$type = $1; |
37
|
4
|
|
|
|
|
10
|
$not = 1; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
272
|
|
|
|
|
724
|
my $class = $type; |
41
|
|
|
|
|
|
|
|
42
|
272
|
50
|
|
|
|
1012
|
if ( !$abs ) { |
43
|
272
|
|
|
|
|
1047
|
$class = "HTML::FormFu::Constraint::$class"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
272
|
|
|
|
|
891
|
$type =~ s/^\+//; |
47
|
|
|
|
|
|
|
|
48
|
272
|
|
|
|
|
1322
|
require_class($class); |
49
|
|
|
|
|
|
|
|
50
|
272
|
|
|
|
|
10727
|
my $constraint = $class->new( |
51
|
|
|
|
|
|
|
{ type => $type, |
52
|
|
|
|
|
|
|
not => $not, |
53
|
|
|
|
|
|
|
parent => $self, |
54
|
|
|
|
|
|
|
} ); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# handle default_args |
57
|
272
|
|
|
|
|
2156
|
my $parent = $self->parent; |
58
|
|
|
|
|
|
|
|
59
|
272
|
100
|
|
|
|
1826
|
if ( exists $parent->default_args->{constraints}{$type} ) { |
60
|
1
|
|
|
|
|
5
|
$arg = _merge_hashes( $parent->default_args->{constraints}{$type}, $arg, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
272
|
|
|
|
|
1436
|
$constraint->populate($arg); |
65
|
|
|
|
|
|
|
|
66
|
272
|
|
|
|
|
1128
|
return $constraint; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
__END__ |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=pod |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=encoding UTF-8 |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=head1 NAME |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
HTML::FormFu::Role::ContainsElementsSharedWithField - Role for constraints on elements and fields |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head1 VERSION |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
version 2.07 |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 AUTHOR |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Carl Franks <cpan@fireartist.com> |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This software is copyright (c) 2018 by Carl Franks. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
94
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |