File Coverage

blib/lib/Validation/Class/Directive.pm
Criterion Covered Total %
statement 32 36 88.8
branch 5 8 62.5
condition 5 9 55.5
subroutine 7 7 100.0
pod 0 3 0.0
total 49 63 77.7


line stmt bran cond sub pod time code
1             # ABSTRACT: Base Class for Validation Class Directives
2              
3             package Validation::Class::Directive;
4              
5 108     108   646 use strict;
  108         200  
  108         2718  
6 108     108   525 use warnings;
  108         268  
  108         2613  
7              
8 108     108   557 use Validation::Class::Util;
  108         192  
  108         894  
9              
10 108     108   616 use Carp 'confess';
  108         202  
  108         76472  
11              
12             our $VERSION = '7.900057'; # VERSION
13              
14              
15             # defaults
16              
17             has 'mixin' => 0;
18             has 'field' => 0;
19             has 'multi' => 0;
20             has 'message' => '%s could not be validated';
21             has 'validator' => sub { sub{1} };
22             has 'dependencies' => sub {{ normalization => [], validation => [] }};
23             has 'name' => sub {
24              
25             my ($self) = @_;
26              
27             my $name = ref $self || $self;
28              
29             my $regexp = qr/Validation::Class::Directive::(.*)$/;
30              
31             $name = $1 if $name =~ $regexp;
32              
33             $name =~ s/([a-z])([A-Z])/$1_$2/g;
34             $name =~ s/\W/_/g;
35             $name = lc $name;
36              
37             return $name;
38              
39             };
40              
41             sub new {
42              
43 4971     4971 0 7095 my $class = shift;
44              
45 4971         16800 my $arguments = $class->build_args(@_);
46              
47             confess
48             "Error creating directive without a name, specifying a name is " .
49             "required to instatiate a new non-subclass directive"
50              
51             if 'Validation::Class::Directive' eq $class && ! $arguments->{name}
52              
53 4971 50 66     25769 ;
54              
55 4971         9276 my $self = bless {}, $class;
56              
57 4971         6391 while (my($key, $value) = each %{$arguments}) {
  4977         15343  
58 6         26 $self->$key($value);
59             }
60              
61 4971         19144 return $self;
62              
63             }
64              
65             sub error {
66              
67 173     173 0 73186 my ($self, $proto, $field, $param, @tokens) = @_;
68              
69 173   66     731 my $name = $field->label || $field->name;
70              
71 173         512 unshift @tokens, $name;
72              
73             # use custom field-level error message
74 173 100 33     679 if ($field->error) {
    50          
    50          
75 23         66 $field->errors->add($field->error);
76             }
77              
78             # use field-level error message override
79             elsif (defined $field->{messages} && $field->{messages}->{$self->name}) {
80 0         0 my $message = $field->{messages}->{$self->name};
81 0         0 $field->errors->add(sprintf($message, @tokens));
82             }
83              
84             # use class-level error message override
85             elsif ($proto->messages->has($self->name)) {
86 0         0 my $message = $proto->messages->get($self->name);
87 0         0 $field->errors->add(sprintf($message, @tokens));
88             }
89              
90             # use directive error message
91             else {
92 150         606 $field->errors->add(sprintf($self->message, @tokens));
93             }
94              
95 173         896 return $self;
96              
97             }
98              
99             sub validate {
100              
101 4426     4426 0 6101 my $self = shift;
102              
103 4426         6699 my ($proto, $field, $param) = @_;
104              
105 4426         11774 my $context = $proto->stash->{'validation.context'};
106              
107             # nasty hack, we need a better way !!!
108 4426         12447 $self->validator->($context, $field, $proto->params);
109              
110 4426         13271 return $self;
111              
112             }
113              
114             1;
115              
116             __END__