File Coverage

blib/lib/HTML/FormFu/Constraint/CallbackOnce.pm
Criterion Covered Total %
statement 19 20 95.0
branch 3 4 75.0
condition 3 5 60.0
subroutine 5 6 83.3
pod 0 1 0.0
total 30 36 83.3


line stmt bran cond sub pod time code
1 4     4   784 use strict;
  4         8  
  4         263  
2              
3             package HTML::FormFu::Constraint::CallbackOnce;
4             $HTML::FormFu::Constraint::CallbackOnce::VERSION = '2.07';
5             # ABSTRACT: Code Callback Constraint
6              
7 4     4   26 use Moose;
  4         8  
  4         31  
8 4     4   27361 use MooseX::Attribute::Chained;
  4         10  
  4         554  
9             extends 'HTML::FormFu::Constraint';
10              
11             has callback => ( is => 'rw', traits => ['Chained'] );
12              
13             sub process {
14 8     8 0 19 my ( $self, $params ) = @_;
15              
16             # check when condition
17 8 50       42 return if !$self->_process_when($params);
18              
19 8         42 my $value = $self->get_nested_hash_value( $params, $self->nested_name );
20              
21 8   50 0   259 my $callback = $self->callback || sub {1};
  0            
22              
23             ## no critic (ProhibitNoStrict);
24 4     4   34 no strict 'refs';
  4         7  
  4         522  
25              
26 8         15 my $ok = eval { $callback->( $value, $params ) };
  8         27  
27              
28 8 100 66     2978 return $self->mk_errors(
29             { pass => ( $@ or !$ok ) ? 0 : 1,
30             message => $@,
31             } );
32             }
33              
34             __PACKAGE__->meta->make_immutable;
35              
36             1;
37              
38             __END__
39              
40             =pod
41              
42             =encoding UTF-8
43              
44             =head1 NAME
45              
46             HTML::FormFu::Constraint::CallbackOnce - Code Callback Constraint
47              
48             =head1 VERSION
49              
50             version 2.07
51              
52             =head1 SYNOPSIS
53              
54             $form->constraint({
55             type => 'CallbackOnce',
56             name => 'foo',
57             callback => \&sfoo,
58             );
59              
60             sub foo {
61             my ( $value, $params ) = @_;
62              
63             # return true or false
64             }
65              
66             =head1 DESCRIPTION
67              
68             Unlinke the L<HTML::FormFu::Constraint::Callback>, this callback is only
69             called once, regardless of how many values are submitted.
70              
71             The first argument passed to the callback is the submitted value for the
72             associated field; this may be a single value or an arrayref of value.
73             The second argument passed to the callback is a hashref of name/value pairs
74             for all input fields.
75              
76             This constraint doesn't honour the C<not()> value.
77              
78             =head1 METHODS
79              
80             =head2 callback
81              
82             Arguments: \&sub_ref
83              
84             =head1 SEE ALSO
85              
86             Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>
87              
88             L<HTML::FormFu>
89              
90             =head1 AUTHOR
91              
92             Carl Franks C<cfranks@cpan.org>
93              
94             =head1 LICENSE
95              
96             This library is free software, you can redistribute it and/or modify it under
97             the same terms as Perl itself.
98              
99             =head1 AUTHOR
100              
101             Carl Franks <cpan@fireartist.com>
102              
103             =head1 COPYRIGHT AND LICENSE
104              
105             This software is copyright (c) 2018 by Carl Franks.
106              
107             This is free software; you can redistribute it and/or modify it under
108             the same terms as the Perl 5 programming language system itself.
109              
110             =cut