File Coverage

blib/lib/HTML/Widget/Constraint/DependOn.pm
Criterion Covered Total %
statement 18 18 100.0
branch 5 6 83.3
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 28 29 96.5


line stmt bran cond sub pod time code
1             package HTML::Widget::Constraint::DependOn;
2              
3 88     88   290312 use warnings;
  88         210  
  88         3918  
4 88     88   492 use strict;
  88         185  
  88         2855  
5 88     88   1887 use base 'HTML::Widget::Constraint';
  88         202  
  88         22271  
6              
7             =head1 NAME
8              
9             HTML::Widget::Constraint::DependOn - DependOn Constraint
10              
11             =head1 SYNOPSIS
12              
13             my $c = $widget->constraint( 'DependOn', 'foo', 'bar' );
14              
15             =head1 DESCRIPTION
16              
17             If the first field listed is filled in, all of the others are required.
18              
19             =head1 METHODS
20              
21             =head2 process
22              
23             =cut
24              
25             sub process {
26 4     4 1 7 my ( $self, $w, $params ) = @_;
27 4         7 my $results = [];
28 4         17 my @names = @{ $self->names };
  4         20  
29 4         25 my $first = shift @names;
30              
31 4 100       18 return [] if !exists $params->{$first};
32              
33 2         4 for my $name (@names) {
34 2 50       9 push @$results,
    100          
35             HTML::Widget::Error->new(
36             { name => $name, message => $self->mk_message } )
37             if $self->not ? $params->{$name} : !$params->{$name};
38             }
39              
40 2         27 return $results;
41             }
42              
43             =head1 AUTHOR
44              
45             Carl Franks, C
46              
47             =head1 LICENSE
48              
49             This library is free software, you can redistribute it and/or modify it under
50             the same terms as Perl itself.
51              
52             =cut
53              
54             1;