|
100
|
1 package IMPL::DOM::Schema::Validator::RegExp;
|
|
236
|
2 use strict;
|
|
165
|
3 use parent qw(IMPL::DOM::Schema::Validator);
|
|
100
|
4
|
|
|
5 our %CTOR = (
|
|
194
|
6 'IMPL::DOM::Schema::Validator' => sub {
|
|
|
7 my %args = @_;
|
|
|
8 $args{nodeName} ||= 'RegExp';
|
|
|
9 %args;
|
|
|
10 }
|
|
100
|
11 );
|
|
|
12
|
|
|
13 use IMPL::Class::Property;
|
|
|
14
|
|
|
15 BEGIN {
|
|
194
|
16 public property message => prop_all;
|
|
|
17 public property launder => prop_all;
|
|
|
18 private property _rx => prop_all;
|
|
100
|
19 }
|
|
|
20
|
|
|
21 sub CTOR {
|
|
194
|
22 my ($this,%args) = @_;
|
|
|
23
|
|
|
24 $this->message($args{message} || "A %Node.nodeName% doesn't match to the format %Schema.display%");
|
|
100
|
25 }
|
|
|
26
|
|
|
27 sub Validate {
|
|
194
|
28 my ($this,$node,$ctx) = @_;
|
|
|
29
|
|
|
30 my $rx = $this->_rx() || $this->_rx( map qr{$_}, $this->nodeValue );
|
|
|
31
|
|
|
32 return new IMPL::DOM::Schema::ValidationError(
|
|
|
33 Node => $node,
|
|
|
34 Source => $ctx && $ctx->{Source} || $this->parentNode,
|
|
|
35 Schema => $this->parentNode,
|
|
|
36 Message => $this->message
|
|
|
37 ) unless (not $node->isComplex) and $node->nodeValue =~ /($rx)/;
|
|
|
38
|
|
|
39 $node->nodeValue($1) if $this->launder;
|
|
|
40
|
|
|
41 return ();
|
|
100
|
42 }
|
|
|
43
|
|
180
|
44 1;
|
