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
118
119
120
121
122
123
124
125
126
127
128
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
## Roles
{
package Constraint;
use Moose::Role;
has 'value' => (isa => 'Num', is => 'ro');
around 'validate' => sub {
my $c = shift;
my ($self, $field) = @_;
return undef if $c->($self, $self->validation_value($field));
return $self->error_message;
};
sub validation_value {
my ($self, $field) = @_;
return $field;
}
sub error_message { confess "Abstract method!" }
package Constraint::OnLength;
use Moose::Role;
has 'units' => (isa => 'Str', is => 'ro');
override 'validation_value' => sub {
return length(super());
};
override 'error_message' => sub {
my $self = shift;
return super() . ' ' . $self->units;
};
}
## Classes
{
package Constraint::AtLeast;
use Moose;
with 'Constraint';
sub validate {
my ($self, $field) = @_;
($field >= $self->value);
}
sub error_message { 'must be at least ' . (shift)->value; }
package Constraint::NoMoreThan;
use Moose;
with 'Constraint';
sub validate {
my ($self, $field) = @_;
($field <= $self->value);
}
sub error_message { 'must be no more than ' . (shift)->value; }
package Constraint::LengthNoMoreThan;
use Moose;
extends 'Constraint::NoMoreThan';
with 'Constraint::OnLength';
package Constraint::LengthAtLeast;
use Moose;
extends 'Constraint::AtLeast';
with 'Constraint::OnLength';
}
my $no_more_than_10 = Constraint::NoMoreThan->new(value => 10);
isa_ok($no_more_than_10, 'Constraint::NoMoreThan');
ok($no_more_than_10->does('Constraint'), '... Constraint::NoMoreThan does Constraint');
ok(!defined($no_more_than_10->validate(1)), '... validated correctly');
is($no_more_than_10->validate(11), 'must be no more than 10', '... validation failed correctly');
my $at_least_10 = Constraint::AtLeast->new(value => 10);
isa_ok($at_least_10, 'Constraint::AtLeast');
ok($at_least_10->does('Constraint'), '... Constraint::AtLeast does Constraint');
ok(!defined($at_least_10->validate(11)), '... validated correctly');
is($at_least_10->validate(1), 'must be at least 10', '... validation failed correctly');
# onlength
my $no_more_than_10_chars = Constraint::LengthNoMoreThan->new(value => 10, units => 'chars');
isa_ok($no_more_than_10_chars, 'Constraint::LengthNoMoreThan');
isa_ok($no_more_than_10_chars, 'Constraint::NoMoreThan');
ok($no_more_than_10_chars->does('Constraint'), '... Constraint::LengthNoMoreThan does Constraint');
ok($no_more_than_10_chars->does('Constraint::OnLength'), '... Constraint::LengthNoMoreThan does Constraint::OnLength');
ok(!defined($no_more_than_10_chars->validate('foo')), '... validated correctly');
is($no_more_than_10_chars->validate('foooooooooo'),
'must be no more than 10 chars',
'... validation failed correctly');
my $at_least_10_chars = Constraint::LengthAtLeast->new(value => 10, units => 'chars');
isa_ok($at_least_10_chars, 'Constraint::LengthAtLeast');
isa_ok($at_least_10_chars, 'Constraint::AtLeast');
ok($at_least_10_chars->does('Constraint'), '... Constraint::LengthAtLeast does Constraint');
ok($at_least_10_chars->does('Constraint::OnLength'), '... Constraint::LengthAtLeast does Constraint::OnLength');
ok(!defined($at_least_10_chars->validate('barrrrrrrrr')), '... validated correctly');
is($at_least_10_chars->validate('bar'), 'must be at least 10 chars', '... validation failed correctly');
done_testing;
|
