comparison Lib/IMPL/DOM/Schema/NodeList.pm @ 125:a4b0a819bbda

Small fixes in IMPL::DOM::Schema
author wizard
date Thu, 10 Jun 2010 17:43:51 +0400
parents cf3b6ef2be22
children 1e7f03414b65
comparison
equal deleted inserted replaced
124:e30bdd040fe3 125:a4b0a819bbda
21 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%'); 21 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%');
22 $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Parent.path%'); 22 $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Parent.path%');
23 } 23 }
24 24
25 sub Validate { 25 sub Validate {
26 my ($this,$node) = @_; 26 my ($this,$node,$ctx) = @_;
27 27
28 my @nodes = map { 28 my @nodes = map {
29 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 } 29 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 }
30 } @{$this->childNodes}; 30 } @{$this->childNodes};
31 31
32 my $info = shift @nodes; 32 my $info = shift @nodes;
33 my $sourceSchema = $ctx->{Source} || $this->parentNode;
33 34
34 foreach my $child ( @{$node->childNodes} ) { 35 foreach my $child ( @{$node->childNodes} ) {
35 #skip schema elements 36 #skip schema elements
36 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { 37 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
37 # if possible of course :) 38 # if possible of course :)
38 return new IMPL::DOM::Schema::ValidationError ( 39 return new IMPL::DOM::Schema::ValidationError (
39 Message => $this->messageUnexpected, 40 Message => $this->messageUnexpected,
40 Node => $child, 41 Node => $child,
41 Parent => $node, 42 Parent => $node,
42 Schema => $info->{Schema}, 43 Schema => $info->{Schema},
43 Source => $this 44 Source => $sourceSchema
44 ) if $info->{Min} > $info->{Seen}; 45 ) if $info->{Min} > $info->{Seen};
45 46
46 $info = shift @nodes; 47 $info = shift @nodes;
47 } 48 }
48 49
49 # return error if no more children allowed 50 # return error if no more children allowed
50 return new IMPL::DOM::Schema::ValidationError ( 51 return new IMPL::DOM::Schema::ValidationError (
51 Message => $this->messageUnexpected, 52 Message => $this->messageUnexpected,
52 Node => $child, 53 Node => $child,
53 Parent => $node, 54 Parent => $node,
54 Source => $this 55 Source => $sourceSchema
55 ) unless $info; 56 ) unless $info;
56 57
57 # it's ok, we found schema element for child 58 # it's ok, we found schema element for child
58 # but it may be any node or switching node wich would not satisfy current child 59 # but it may be any node or switching node wich would not satisfy current child
59 60
72 return new IMPL::DOM::Schema::ValidationError ( 73 return new IMPL::DOM::Schema::ValidationError (
73 Error => 1, 74 Error => 1,
74 Message => $this->messageUnexpected, 75 Message => $this->messageUnexpected,
75 Node => $child, 76 Node => $child,
76 Parent => $node, 77 Parent => $node,
77 Source => $this, 78 Source => $sourceSchema,
78 ) if $info->{Max} and $info->{Seen} > $info->{Max}; 79 ) if $info->{Max} and $info->{Seen} > $info->{Max};
79 } 80 }
80 81
81 # no more children left (but may be should :) 82 # no more children left (but may be should :)
82 while ($info) { 83 while ($info) {
83 return new IMPL::DOM::Schema::ValidationError ( 84 return new IMPL::DOM::Schema::ValidationError (
84 Error => 1, 85 Error => 1,
85 Message => $this->messageNodesRequired, 86 Message => $this->messageNodesRequired,
86 Source => $this, 87 Source => $sourceSchema,
87 Parent => $node, 88 Parent => $node,
88 Schema => $info->{Schema} 89 Schema => $info->{Schema}
89 ) if $info->{Seen} < $info->{Min}; 90 ) if $info->{Seen} < $info->{Min};
90 91
91 $info = shift @nodes; 92 $info = shift @nodes;