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 109     109   54040 use strict;
  109         287  
  109         3216  
6 109     109   583 use warnings;
  109         276  
  109         2937  
7              
8 109     109   637 use base 'Validation::Class::Directive';
  109         244  
  109         10718  
9              
10 109     109   773 use Validation::Class::Util;
  109         317  
  109         712  
11              
12             our $VERSION = '7.900059'; # 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 27 my $self = shift;
23              
24 5         16 my ($proto, $field, $param) = @_;
25              
26 5 50 33     36 if (defined $field->{matches} && defined $param) {
27              
28 5         18 my $specification = $field->{matches};
29              
30 5 50 66     25 if ($field->{required} || $param) {
31              
32 5 50       17 my $dependents = isa_arrayref($specification) ?
33             $specification : [$specification]
34             ;
35              
36 5 50       10 if (@{$dependents}) {
  5         19  
37              
38 5         11 my @required_fields = ();
39              
40 5         9 foreach my $dependent (@{$dependents}) {
  5         14  
41              
42 5   50     14 $param ||= '';
43              
44 5         17 my $field = $proto->fields->get($dependent);
45 5   100     18 my $param2 = $proto->params->get($dependent) || '';
46              
47 5 100 66     45 push @required_fields, $field->label || $field->name
48             unless $param eq $param2
49             ;
50              
51             }
52              
53 5 100       33 if (my @r = @required_fields) {
54              
55 4   33     36 my$list=(join(' and ',join(', ',@r[0..$#r-1])||(),$r[-1]));
56              
57 4         30 $self->error(@_, $list);
58              
59             }
60              
61             }
62              
63             }
64              
65             }
66              
67 5         31 return $self;
68              
69             }
70              
71             1;
72              
73             __END__