File Coverage

blib/lib/HTML/FormFu/Constraint/AllOrNone.pm
Criterion Covered Total %
statement 33 33 100.0
branch 17 20 85.0
condition 9 12 75.0
subroutine 4 4 100.0
pod 0 2 0.0
total 63 71 88.7


line stmt bran cond sub pod time code
1             package HTML::FormFu::Constraint::AllOrNone;
2              
3 8     8   827 use strict;
  8         11  
  8         383  
4             our $VERSION = '2.05'; # VERSION
5              
6 8     8   26 use Moose;
  8         11  
  8         101  
7             extends 'HTML::FormFu::Constraint';
8              
9             with 'HTML::FormFu::Role::Constraint::Others';
10              
11             sub process {
12 18     18 0 25 my ( $self, $params ) = @_;
13              
14             # check when condition
15 18 50       118 return if !$self->_process_when($params);
16              
17 18         455 my $others = $self->others;
18 18 50       50 return if !defined $others;
19              
20 18         79 my @names = ( $self->nested_name );
21 18 100       48 push @names, ref $others ? @{$others} : $others;
  11         27  
22              
23 18         24 my @failed;
24              
25 18         38 for my $name (@names) {
26 54         133 my $value = $self->get_nested_hash_value( $params, $name );
27              
28 54         50 my $seen = 0;
29 54 100       84 if ( ref $value eq 'ARRAY' ) {
30 6         13 my @errors = eval { $self->constrain_values( $value, $params ) };
  6         30  
31              
32 6 50 33     38 if ( !@errors && !$@ ) {
33 6         10 $seen = 1;
34             }
35             }
36             else {
37 48         47 my $ok = eval { $self->constrain_value($value) };
  48         85  
38              
39 48 100 66     419 if ( $ok && !$@ ) {
40 25         25 $seen = 1;
41             }
42             }
43              
44 54 100       98 if ( !$seen ) {
45 23         43 push @failed, $name;
46             }
47             }
48              
49 18 100 100     85 my $pass = @failed && scalar @failed != scalar @names ? 0 : 1;
50              
51 18 100       162 return $self->mk_errors( {
52             pass => $pass,
53             failed => $pass ? [] : \@failed,
54             names => \@names,
55             } );
56             }
57              
58             sub constrain_value {
59 60     60 0 62 my ( $self, $value ) = @_;
60              
61 60 100 100     223 return 0 if !defined $value || $value eq '';
62              
63 37         57 return 1;
64             }
65              
66             __PACKAGE__->meta->make_immutable;
67              
68             1;
69              
70             __END__
71              
72             =head1 NAME
73              
74             HTML::FormFu::Constraint::AllOrNone - Multi-field All or None Constraint
75              
76             =head1 VERSION
77              
78             version 2.05
79              
80             =head1 SYNOPSIS
81              
82             type: AllOrNone
83             name: foo
84             others: [bar, baz]
85              
86             =head1 DESCRIPTION
87              
88             Ensure that either all or none of the named fields are present.
89              
90             By default, if some but not all fields are submitted, errors are attached to
91             those fields which weren't submitted. This behaviour can be changed by setting
92             any of L<HTML::FormFu::Role::Constraint::Others/attach_errors_to_base>,
93             L<HTML::FormFu::Role::Constraint::Others/attach_errors_to_others> or
94             L<HTML::FormFu::Role::Constraint::Others/attach_errors_to>.
95              
96             This constraint doesn't honour the C<not()> value.
97              
98             =head1 SEE ALSO
99              
100             Is a sub-class of, and inherits methods from
101             L<HTML::FormFu::Role::Constraint::Others>, L<HTML::FormFu::Constraint>
102              
103             L<HTML::FormFu>
104              
105             =head1 AUTHOR
106              
107             Carl Franks C<cfranks@cpan.org>
108              
109             =head1 LICENSE
110              
111             This library is free software, you can redistribute it and/or modify it under
112             the same terms as Perl itself.
113              
114             =cut