Mercurial > pub > Impl

comparison Lib/IMPL/DOM/Schema/Validator/RegExp.pm @ 389:5aff94ba842f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DOM Schema refactoring complete
author cin
date Wed, 12 Feb 2014 13:36:24 +0400
parents b8c724f6de36
children
comparison
equal deleted inserted replaced
388:648dfaf642e0 389:5aff94ba842f
1 package IMPL::DOM::Schema::Validator::RegExp; 1 package IMPL::DOM::Schema::Validator::RegExp;
2 use strict; 2 use strict;
3 use parent qw(IMPL::DOM::Schema::Validator);
4 3
5 our %CTOR = ( 4 use IMPL::Const qw(:prop);
6 'IMPL::DOM::Schema::Validator' => sub { 5 use IMPL::declare {
7 my %args = @_; 6 require => {
8 $args{nodeName} ||= 'RegExp'; 7 Label => 'IMPL::DOM::Schema::Label',
9 %args; 8 ValidationError => 'IMPL::DOM::Schema::ValidationError'
10 } 9 },
11 ); 10 base => [
12 11 'IMPL::DOM::Schema::Validator' => sub {
13 use IMPL::Class::Property; 12 my %args = @_;
14 13 $args{nodeName} ||= 'RegExp';
15 BEGIN { 14 %args;
16 public property message => prop_all; 15 }
17 public property launder => prop_all; 16 ],
18 private property _rx => prop_all; 17 props => [
19 } 18 message => { get => 1, set =>1, dom =>1 },
19 launder => { get => 1, set =>1, dom =>1 },
20 _rx => { get=> 1, set=> 1}
21 ]
22 };
20 23
21 sub CTOR { 24 sub CTOR {
22 my ($this,%args) = @_; 25 my ($this,%args) = @_;
23 26
24 $this->message($args{message} || "A %node.nodeName% doesn't match to the format %schema.display%"); 27 $this->message($args{message} || "A %node.nodeName% doesn't match to the format %schemaNode.label%");
25 } 28 }
26 29
27 sub Validate { 30 sub Validate {
28 my ($this,$node,$ctx) = @_; 31 my ($this,$node,$ctx) = @_;
29 32
30 my $rx = $this->_rx() || $this->_rx( map qr{$_}, $this->nodeValue ); 33 my $rx = $this->_rx() || $this->_rx( map qr{$_}, $this->nodeValue );
31 34
32 return new IMPL::DOM::Schema::ValidationError( 35 return ValidationError->new (
33 node => $node, 36 node => $node,
34 source => $ctx && $ctx->{Source} || $this->parentNode, 37 schemaNode => $ctx->{schemaNode},
35 schema => $this->parentNode, 38 schemaType => $ctx->{schemaType},
36 message => $this->message 39 message => $this->_MakeLabel($this->message)
37 ) unless (not $node->isComplex) and $node->nodeValue =~ /($rx)/; 40 ) unless (not $node->isComplex) and $node->nodeValue =~ /($rx)/;
38 41
39 $node->nodeValue($1) if $this->launder; 42 $node->nodeValue($1) if $this->launder;
40 43
41 return (); 44 return ();
42 } 45 }
43 46
47 sub _MakeLabel {
48 my ($this,$label) = @_;
49
50 if ($label =~ /^ID:(\w+)$/) {
51 return Label->new($this->document->stringMap, $1);
52 } else {
53 return $label;
54 }
55 }
56
44 1; 57 1;