1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
use FindBin;
use Test::More;
use Data::Dumper;
use utf8;
use strict;
use warnings;
{
package TestClass::A;
use Validation::Class;
field word => {
all_caps => 1
};
directive all_caps => sub {
my ($self, $field, $param) = @_;
if (defined $field->{all_caps} && defined $param) {
my $length = $field->{all_caps};
if ($field->{required} || $param) {
unless ($param =~ /^[A-Z]+$/) {
$field->errors->add("This is all wrong");
}
}
}
return $self;
};
package main;
my $class = "TestClass::A";
my $self = $class->new(word => 'blah blah');
ok $class eq ref $self, "$class instantiated";
ok $self->proto->directives->has('all_caps'), "$class has foreign all_caps directives";
ok !$self->validate('word'), 'word is not in all caps';
ok $self->error_count, 'an error was registered';
}
# NO SUPPORT FOR FOREIGN DIRECTIVES ATM, COMING SOON
#{
#
# package AllCaps;
#
# use base 'Validation::Class::Directive';
#
# use Validation::Class::Directives;
# use Validation::Class::Util;
#
# has 'mixin' => 1;
# has 'field' => 1;
# has 'multi' => 0;
# has 'message' => '%s should be exactly %s characters';
#
# sub validate {
#
# my $self = shift;
#
# my ($proto, $field, $param) = @_;
#
# if (defined $field->{all_caps} && defined $param) {
#
# my $length = $field->{all_caps};
#
# if ($field->{required} || $param) {
#
# unless ($param =~ /^[A-Z]+$/) {
#
# $self->error(@_, $length);
#
# }
#
# }
#
# }
#
# return $self;
#
# }
#
# package TestClass::B;
#
# use Validation::Class;
#
# field word => {
# all_caps => 1
# };
#
# package main;
#
# my $class = "TestClass::B";
# my $self = $class->new(word => 'blah blah');
#
# ok $class eq ref $self, "$class instantiated";
# ok $self->proto->directives->has('all_caps'), "$class has foreign all_caps directives";
# ok !$self->validate('word'), 'word is not in all caps';
#
# warn $self->errors_to_string;
#
#}
done_testing;
|
