| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package HTML::FormFu::Role::ContainsElementsSharedWithField; |
|
2
|
|
|
|
|
|
|
|
|
3
|
400
|
|
|
400
|
|
160961
|
use strict; |
|
|
400
|
|
|
|
|
557
|
|
|
|
400
|
|
|
|
|
14855
|
|
|
4
|
|
|
|
|
|
|
our $VERSION = '2.05'; # VERSION |
|
5
|
|
|
|
|
|
|
|
|
6
|
400
|
|
|
400
|
|
1470
|
use Moose::Role; |
|
|
400
|
|
|
|
|
541
|
|
|
|
400
|
|
|
|
|
2117
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
400
|
|
|
|
|
17800
|
use HTML::FormFu::Util qw( |
|
9
|
|
|
|
|
|
|
require_class |
|
10
|
|
|
|
|
|
|
_merge_hashes |
|
11
|
400
|
|
|
400
|
|
1316732
|
); |
|
|
400
|
|
|
|
|
590
|
|
|
12
|
400
|
|
|
400
|
|
1509
|
use Carp qw( croak ); |
|
|
400
|
|
|
|
|
542
|
|
|
|
400
|
|
|
|
|
120307
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub get_error { |
|
15
|
7
|
|
|
7
|
0
|
10
|
my $self = shift; |
|
16
|
|
|
|
|
|
|
|
|
17
|
7
|
50
|
|
|
|
21
|
return if !$self->form->submitted; |
|
18
|
|
|
|
|
|
|
|
|
19
|
7
|
|
|
|
|
25
|
my $c = $self->get_errors(@_); |
|
20
|
|
|
|
|
|
|
|
|
21
|
7
|
100
|
|
|
|
55
|
return @$c ? $c->[0] : (); |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _require_constraint { |
|
25
|
274
|
|
|
274
|
|
517
|
my ( $self, $type, $arg ) = @_; |
|
26
|
|
|
|
|
|
|
|
|
27
|
274
|
50
|
|
|
|
822
|
croak 'required arguments: $self, $type, \%options' if @_ != 3; |
|
28
|
|
|
|
|
|
|
|
|
29
|
274
|
|
|
|
|
430
|
eval { my %x = %$arg }; |
|
|
274
|
|
|
|
|
801
|
|
|
30
|
274
|
50
|
|
|
|
688
|
croak "options argument must be hash-ref" if $@; |
|
31
|
|
|
|
|
|
|
|
|
32
|
274
|
|
|
|
|
636
|
my $abs = $type =~ s/^\+//; |
|
33
|
274
|
|
|
|
|
343
|
my $not = 0; |
|
34
|
|
|
|
|
|
|
|
|
35
|
274
|
100
|
|
|
|
1039
|
if ( $type =~ /^Not_(\w+)$/i ) { |
|
36
|
4
|
|
|
|
|
10
|
$type = $1; |
|
37
|
4
|
|
|
|
|
9
|
$not = 1; |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
274
|
|
|
|
|
412
|
my $class = $type; |
|
41
|
|
|
|
|
|
|
|
|
42
|
274
|
50
|
|
|
|
660
|
if ( !$abs ) { |
|
43
|
274
|
|
|
|
|
636
|
$class = "HTML::FormFu::Constraint::$class"; |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
|
|
46
|
274
|
|
|
|
|
497
|
$type =~ s/^\+//; |
|
47
|
|
|
|
|
|
|
|
|
48
|
274
|
|
|
|
|
1220
|
require_class($class); |
|
49
|
|
|
|
|
|
|
|
|
50
|
274
|
|
|
|
|
8659
|
my $constraint = $class->new( { |
|
51
|
|
|
|
|
|
|
type => $type, |
|
52
|
|
|
|
|
|
|
not => $not, |
|
53
|
|
|
|
|
|
|
parent => $self, |
|
54
|
|
|
|
|
|
|
} ); |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# handle default_args |
|
57
|
274
|
|
|
|
|
1110
|
my $parent = $self->parent; |
|
58
|
|
|
|
|
|
|
|
|
59
|
274
|
100
|
|
|
|
1212
|
if ( exists $parent->default_args->{constraints}{$type} ) { |
|
60
|
1
|
|
|
|
|
4
|
$arg = _merge_hashes( $parent->default_args->{constraints}{$type}, $arg, |
|
61
|
|
|
|
|
|
|
); |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
274
|
|
|
|
|
889
|
$constraint->populate($arg); |
|
65
|
|
|
|
|
|
|
|
|
66
|
274
|
|
|
|
|
823
|
return $constraint; |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |