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
|
# Testing new support for 'qr'. -mls
use Test::More qw/no_plan/;
use Data::FormValidator;
my %FORM = (
stick => 'big',
speak => 'softly',
bad_email => 'doops',
good_email => 'great@domain.com',
'short_name' => 'tim',
'not_oops' => 'hoops',
'untainted_with_qr' => 'Slimy',
);
my $results = Data::FormValidator->check(\%FORM, {
required_regexp => qr/stick/,
optional_regexp => '/_email$/',
constraint_regexp_map => {
qr/email/ => 'email',
},
field_filter_regexp_map => {
qr/_name$/ => 'ucfirst',
},
required => 'speak',
optional => [qw/short_name not_oops untainted_with_qr/],
constraints => {
not_oops => {
name => 'start_with_oop',
constraint => qr/^oop/,
},
untainted_with_qr => qr/(Slim)/,
speak => qr/quietly|softly/,
stick => qr/big|large/,
},
msgs => {
constraints => {
'start_with_oop' => 'testing named qr constraints',
}
},
untaint_constraint_fields => [qw/untainted_with_qr/],
});
ok ($results->valid('stick') eq 'big','using qr for regexp quoting');
ok ($results->valid('speak'),'using alternation with qr works');
ok ($results->valid('good_email'), 'expected to pass constraint');
ok ($results->invalid('bad_email'), 'expected to fail constraint');
is($results->valid('short_name'),'Tim', 'field_filter_regexp_map');
my $msgs = $results->msgs;
like($msgs->{not_oops},qr/testing named/, 'named qr constraints');
is($results->valid('untainted_with_qr'),'Slim', 'untainting with qr');
|
