Mercurial > pub > Impl
comparison Lib/IMPL/DOM/Schema/NodeList.pm @ 388:648dfaf642e0
DOM refactoring,
removed inflators from DOM Schema,
DOM validation - in progress
author | cin |
---|---|
date | Tue, 11 Feb 2014 20:22:01 +0400 |
parents | b8c724f6de36 |
children | 5aff94ba842f |
comparison
equal
deleted
inserted
replaced
387:4cc6cc370fb2 | 388:648dfaf642e0 |
---|---|
1 package IMPL::DOM::Schema::NodeList; | 1 package IMPL::DOM::Schema::NodeList; |
2 use strict; | 2 use strict; |
3 use warnings; | 3 use warnings; |
4 use parent qw(IMPL::DOM::Node); | |
5 | 4 |
6 use IMPL::Class::Property; | |
7 use IMPL::DOM::Property qw(_dom); | |
8 require IMPL::DOM::Schema::ValidationError; | |
9 | 5 |
10 our %CTOR = ( | 6 use IMPL::declare { |
11 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' } | 7 require => { |
12 ); | 8 ValidationError => 'IMPL::DOM::Schema::ValidationError', |
13 | 9 AnyNode => '-IMPL::DOM::Schema::AnyNode' |
14 BEGIN { | 10 }, |
15 public _dom property messageUnexpected => prop_all; | 11 base => [ |
16 public _dom property messageNodesRequired => prop_all; | 12 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' } |
17 } | 13 ], |
14 props => [ | |
15 messageUnexpected => { get => 1, set => 1, dom => 1 }, | |
16 messageNodesRequired => { get => 1, set => 1, dom => 1} | |
17 ] | |
18 }; | |
18 | 19 |
19 sub CTOR { | 20 sub CTOR { |
20 my ($this,%args) = @_; | 21 my ($this,%args) = @_; |
21 | 22 |
22 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%'); | 23 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%'); |
25 | 26 |
26 sub Validate { | 27 sub Validate { |
27 my ($this,$node,$ctx) = @_; | 28 my ($this,$node,$ctx) = @_; |
28 | 29 |
29 my @nodes = map { | 30 my @nodes = map { |
30 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 } | 31 {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 } |
31 } @{$this->childNodes}; | 32 } @{$this->childNodes}; |
32 | 33 |
33 my $info = shift @nodes; | 34 my $info = shift @nodes; |
34 my $sourceSchema = $ctx->{Source} || $this->parentNode; | |
35 | 35 |
36 foreach my $child ( @{$node->childNodes} ) { | 36 foreach my $child ( @{$node->childNodes} ) { |
37 #skip schema elements | 37 #skip schema elements |
38 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { | 38 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { |
39 # if possible of course :) | 39 # if possible of course :) |
40 return new IMPL::DOM::Schema::ValidationError ( | 40 return ValidationError->new ( |
41 message => $this->messageUnexpected, | 41 message => $this->messageUnexpected, |
42 node => $child, | 42 node => $child, |
43 parent => $node, | 43 parent => $node, |
44 schema => $info->{Schema}, | 44 schemaNode => $info->{schemaNode} |
45 source => $sourceSchema | |
46 ) if $info->{Min} > $info->{Seen}; | 45 ) if $info->{Min} > $info->{Seen}; |
47 | 46 |
48 $info = shift @nodes; | 47 $info = shift @nodes; |
49 } | 48 } |
50 | 49 |
51 # return error if no more children allowed | 50 # return error if no more children allowed |
52 return new IMPL::DOM::Schema::ValidationError ( | 51 return ValidationError->new ( |
53 message => $this->messageUnexpected, | 52 message => $this->messageUnexpected, |
54 node => $child, | 53 node => $child, |
55 parent => $node, | 54 parent => $node |
56 source => $sourceSchema | |
57 ) unless $info; | 55 ) unless $info; |
58 | 56 |
59 # it's ok, we found schema element for child | 57 # it's ok, we found schema element for child |
60 # but it may be any node or switching node wich would not satisfy current child | 58 # but it may be any node or switching node wich would not satisfy current child |
61 | 59 |
62 # validate | 60 # validate |
63 while (my @errors = $info->{Schema}->Validate($child)) { | 61 while (my @errors = $info->{schemaNode}->Validate($child)) { |
64 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) { | 62 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) { |
65 # in case of any or switch node, skip it if possible | 63 # in case of any or switch node, skip it if possible |
66 next if $info = shift @nodes; | 64 next if $info = shift @nodes; |
67 } | 65 } |
68 return @errors; | 66 return @errors; |