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 109     109   731 use strict;
  109         210  
  109         2590  
6 109     109   511 use warnings;
  109         196  
  109         2240  
7              
8 109     109   574 use Validation::Class::Util;
  109         222  
  109         680  
9              
10 109     109   667 use Carp 'confess';
  109         211  
  109         64557  
11              
12             our $VERSION = '7.900058'; # 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 5017     5017 0 7090 my $class = shift;
44              
45 5017         10056 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 5017 50 66     9050 ;
54              
55 5017         7999 my $self = bless {}, $class;
56              
57 5017         5884 while (my($key, $value) = each %{$arguments}) {
  5023         10630  
58 6         17 $self->$key($value);
59             }
60              
61 5017         12329 return $self;
62              
63             }
64              
65             sub error {
66              
67 174     174 0 40600 my ($self, $proto, $field, $param, @tokens) = @_;
68              
69 174   66     819 my $name = $field->label || $field->name;
70              
71 174         486 unshift @tokens, $name;
72              
73             # use custom field-level error message
74 174 100 33     634 if ($field->error) {
    50          
    50          
75 23         55 $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 151         507 $field->errors->add(sprintf($self->message, @tokens));
93             }
94              
95 174         655 return $self;
96              
97             }
98              
99             sub validate {
100              
101 4451     4451 0 5903 my $self = shift;
102              
103 4451         6599 my ($proto, $field, $param) = @_;
104              
105 4451         7990 my $context = $proto->stash->{'validation.context'};
106              
107             # nasty hack, we need a better way !!!
108 4451         8498 $self->validator->($context, $field, $proto->params);
109              
110 4451         8750 return $self;
111              
112             }
113              
114             1;
115              
116             __END__