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
|
use strict; use warnings;
package Open311::Endpoint::Schema::Regex;
use parent 'Data::Rx::CommonType::EasyNew';
use Carp ();
sub type_uri {
'tag:wiki.open311.org,GeoReport_v2:rx/regex',
}
sub guts_from_arg {
my ($class, $arg, $rx) = @_;
$arg ||= {};
my $pattern = delete $arg->{pattern};
my $message = delete $arg->{message};
if (my @unexpected = keys %$arg) {
Carp::croak sprintf "Unknown arguments %s in constructing %s",
(join ',' => @unexpected), $class->type_uri;
}
return {
str_schema => $rx->make_schema('//str'),
pattern => qr/$pattern/,
message => $message,
};
}
sub assert_valid {
my ($self, $value) = @_;
$self->{str_schema}->assert_valid( $value );
return 1 if $value =~ $self->{pattern};
$self->fail({
error => [ qw(type) ],
message => $self->{message} || "found value doesn't match regex",
value => $value,
})
}
1;
|
