File Coverage

blib/lib/Validation/Class/Directive/Matches.pm
Criterion Covered Total %
statement 31 31 100.0
branch 8 12 66.6
condition 9 16 56.2
subroutine 5 5 100.0
pod 0 1 0.0
total 53 65 81.5


line stmt bran cond sub pod time code
1             # ABSTRACT: Matches Directive for Validation Class Field Definitions
2              
3             package Validation::Class::Directive::Matches;
4              
5 108     108   69487 use strict;
  108         219  
  108         2954  
6 108     108   548 use warnings;
  108         234  
  108         2966  
7              
8 108     108   554 use base 'Validation::Class::Directive';
  108         195  
  108         7768  
9              
10 108     108   578 use Validation::Class::Util;
  108         217  
  108         806  
11              
12             our $VERSION = '7.900057'; # VERSION
13              
14              
15             has 'mixin' => 1;
16             has 'field' => 1;
17             has 'multi' => 1;
18             has 'message' => '%s does not match %s';
19              
20             sub validate {
21              
22 5     5 0 10 my $self = shift;
23              
24 5         13 my ($proto, $field, $param) = @_;
25              
26 5 50 33     40 if (defined $field->{matches} && defined $param) {
27              
28 5         16 my $specification = $field->{matches};
29              
30 5 50 66     31 if ($field->{required} || $param) {
31              
32 5 50       18 my $dependents = isa_arrayref($specification) ?
33             $specification : [$specification]
34             ;
35              
36 5 50       11 if (@{$dependents}) {
  5         18  
37              
38 5         10 my @required_fields = ();
39              
40 5         9 foreach my $dependent (@{$dependents}) {
  5         13  
41              
42 5   50     15 $param ||= '';
43              
44 5         20 my $field = $proto->fields->get($dependent);
45 5   100     21 my $param2 = $proto->params->get($dependent) || '';
46              
47 5 100 66     29 push @required_fields, $field->label || $field->name
48             unless $param eq $param2
49             ;
50              
51             }
52              
53 5 100       22 if (my @r = @required_fields) {
54              
55 4   33     44 my$list=(join(' and ',join(', ',@r[0..$#r-1])||(),$r[-1]));
56              
57 4         32 $self->error(@_, $list);
58              
59             }
60              
61             }
62              
63             }
64              
65             }
66              
67 5         23 return $self;
68              
69             }
70              
71             1;
72              
73             __END__