File Coverage

blib/lib/HTML/Widget/Constraint/Callback.pm
Criterion Covered Total %
statement 12 13 92.3
branch n/a
condition 1 2 50.0
subroutine 4 5 80.0
pod 1 1 100.0
total 18 21 85.7


line stmt bran cond sub pod time code
1             package HTML::Widget::Constraint::Callback;
2              
3 88     88   77226 use warnings;
  88         213  
  88         2969  
4 88     88   505 use strict;
  88         178  
  88         8409  
5 88     88   670 use base 'HTML::Widget::Constraint';
  88         187  
  88         17960  
6              
7             __PACKAGE__->mk_accessors(qw/callback/);
8              
9             *cb = \&callback;
10              
11             =head1 NAME
12              
13             HTML::Widget::Constraint::Callback - Callback Constraint
14              
15             =head1 SYNOPSIS
16              
17             my $c = $widget->constraint( 'Callback', 'foo' )->callback(sub {
18             my $value=shift;
19             return 1;
20             });
21              
22             =head1 DESCRIPTION
23              
24             A callback constraint which will only be run once for each submitted value
25             of each named field.
26              
27             =head1 METHODS
28              
29             =head2 callback
30              
31             =head2 cb
32              
33             Arguments: \&callback
34              
35             Define the callback to be used for validation.
36              
37             L is an alias for L.
38              
39             =head2 validate
40              
41             perform the actual validation.
42              
43             =cut
44              
45             sub validate {
46 6     6 1 10 my ( $self, $value ) = @_;
47 6   50 0   19 my $callback = $self->callback || sub {1};
  0            
48 6         54 return $callback->($value);
49             }
50              
51             =head1 AUTHOR
52              
53             Sebastian Riedel, C
54              
55             Marcus Ramberg, C
56              
57             =head1 LICENSE
58              
59             This library is free software, you can redistribute it and/or modify it under
60             the same terms as Perl itself.
61              
62             =cut
63              
64             1;