File Coverage

blib/lib/HTML/Widget/Constraint/AllOrNone.pm
Criterion Covered Total %
statement 18 18 100.0
branch 5 6 83.3
condition 3 6 50.0
subroutine 4 4 100.0
pod 1 1 100.0
total 31 35 88.5


line stmt bran cond sub pod time code
1             package HTML::Widget::Constraint::AllOrNone;
2              
3 88     88   74502 use warnings;
  88         183  
  88         2714  
4 88     88   481 use strict;
  88         171  
  88         2696  
5 88     88   461 use base 'HTML::Widget::Constraint';
  88         178  
  88         22310  
6              
7             =head1 NAME
8              
9             HTML::Widget::Constraint::AllOrNone - AllOrNone Constraint
10              
11             =head1 SYNOPSIS
12              
13             my $c = $widget->constraint( 'AllOrNone', 'foo', 'bar' );
14              
15             =head1 DESCRIPTION
16              
17             AllOrNone means that if one is filled out, all of them have to be.
18              
19             =head1 METHODS
20              
21             =head2 process
22              
23             =cut
24              
25             sub process {
26 5     5 1 8 my ( $self, $w, $params ) = @_;
27 5         6 my $results = [];
28 5         10 my $one;
29 5         5 for my $name ( @{ $self->names } ) {
  5         84  
30 10 50 0     85 if ($self->not
    100 100        
31             ? ( defined $params->{$name} && length $params->{$name} )
32             : ( !defined $params->{$name} || !length $params->{$name} ) )
33             {
34 6         70 push @$results, HTML::Widget::Error->new(
35             { name => $name, message => $self->mk_message } );
36             }
37             else {
38 4         45 $one++;
39             }
40             }
41 5 100       262 return ( $one ? $results : [] );
42             }
43              
44             =head1 AUTHOR
45              
46             Marcus Ramberg, C
47              
48             =head1 LICENSE
49              
50             This library is free software, you can redistribute it and/or modify it under
51             the same terms as Perl itself.
52              
53             =cut
54              
55             1;