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