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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
use strict;
use warnings;
use Test::More;
use lib 't/lib';
{
package My::Constraints;
sub check_something {
my $value = shift;
return 1 if $value eq 'something';
return 0;
}
}
{
package My::Form;
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler';
use Moose::Util::TypeConstraints;
subtype 'Natural'
=> as 'Int'
=> where { $_ > 0 };
subtype 'NaturalLessThanTen'
=> as 'Natural'
=> where { $_ < 10 }
=> message { "This number ($_) is not less than ten!" };
coerce 'Num'
=> from 'Str'
=> via { 0+$_ };
enum 'RGBColors' => [ qw(red green blue) ];
no Moose::Util::TypeConstraints;
has_field 'message_arrayref' => (
apply => [ { check => qr/aaa/, message => ['Must contain [_1]', 'aaa'] } ],
);
has_field 'regex_error' => (
apply => [ { check => qr/xyz/ } ],
);
has_field 'regex_correct' => (
apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ],
);
has_field 'message_sub' => (
apply => [
{
check => [ 'abc' ],
message => \&err_message
}
]
);
sub err_message {
my ($value, $field ) = @_;
return $field->name . ': Must be "abc"';
}
has_field 'set_error' => (
apply => [
{
check => [ 'abc', 'bbb' ],
message => 'Must be "aaa" or "bbb"'
}
]
);
has_field 'set_correct' => (
apply => [
{
check => [ 'aaa', 'bbb' ],
message => 'Must be "aaa" or "bbb"'
}
]
);
has_field 'callback_error' => (
apply => [
{
check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } },
message => 'Must contain number greater than 10',
}
]
);
has_field 'callback_pass' => (
apply => [
{
check => \&check_callback_pass,
message => 'Must contain number greater than 10',
}
]
);
sub check_callback_pass {
my ( $value, $field ) = @_;
if( $value =~ /(\d+)/ ) {
return $1 > 10;
}
}
has_field 'less_than_ten_error' => (
apply => [ 'NaturalLessThanTen' ]
);
has_field 'less_than_ten_pass' => (
apply => [ 'NaturalLessThanTen' ]
);
has_field 'my_something' => (
apply => [{ check => \&My::Constraints::check_something,
message => 'Something is not right' }],
);
}
my $form = My::Form->new();
ok( $form, 'get form' );
my $params = {
message_arrayref => 'xxx',
regex_error => 'bbb',
regex_correct => 'bbb aaa',
set_error => 'ccc',
set_correct => 'aaa',
callback_error => 'asdf 2',
callback_pass => 'asdf 20 asd',
less_than_ten_error => 10,
less_than_ten_pass => 9,
message_sub => 'xyz',
my_something => 'nothing',
};
$form->process($params);
ok( $form->field('message_arrayref')->has_errors, 'message arrayref works' );
ok( $form->field('regex_error')->has_errors, 'regexp constraint - error' );
ok( !$form->field('regex_correct')->has_errors, 'regexp constraint - pass' );
ok( $form->field('regex_correct')->has_value, 'constraints passed - has_value is true' );
is( $form->field('message_sub')->errors->[0], 'message_sub: Must be "abc"', 'error from message sub' );
ok( !$form->field('set_correct')->has_errors, 'set correct' );
ok( $form->field('set_error')->has_errors, 'set error' );
ok( $form->field('callback_error')->has_errors, 'callback constraint - error' );
ok( !$form->field('callback_pass')->has_errors, 'callback constraint - pass' );
ok( $form->field('less_than_ten_error')->has_errors, 'type constraint - error' );
my $message = $form->field('less_than_ten_error')->errors->[0];
is( $message, "This number (10) is not less than ten!", 'type constraint - error message' );
ok( !$form->field('less_than_ten_pass')->has_errors, 'type constraint - pass' );
is( $form->field('my_something')->errors->[0], 'Something is not right', 'check sub from package' );
#warn Dumper( $form ); use Data::Dumper;
is_deeply( $form->fif, $params, 'fif is correct');
done_testing;
|
