|
49
|
1 package IMPL::DOM::Schema::NodeList;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
165
|
4 use parent qw(IMPL::DOM::Node);
|
|
49
|
5
|
|
|
6 use IMPL::Class::Property;
|
|
152
|
7 use IMPL::DOM::Property qw(_dom);
|
|
49
|
8 require IMPL::DOM::Schema::ValidationError;
|
|
|
9
|
|
|
10 our %CTOR = (
|
|
|
11 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
|
|
|
12 );
|
|
|
13
|
|
|
14 BEGIN {
|
|
152
|
15 public _dom property messageUnexpected => prop_all;
|
|
|
16 public _dom property messageNodesRequired => prop_all;
|
|
49
|
17 }
|
|
|
18
|
|
|
19 sub CTOR {
|
|
|
20 my ($this,%args) = @_;
|
|
|
21
|
|
|
22 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%');
|
|
102
|
23 $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Parent.path%');
|
|
49
|
24 }
|
|
|
25
|
|
|
26 sub Validate {
|
|
125
|
27 my ($this,$node,$ctx) = @_;
|
|
49
|
28
|
|
|
29 my @nodes = map {
|
|
|
30 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 }
|
|
|
31 } @{$this->childNodes};
|
|
|
32
|
|
|
33 my $info = shift @nodes;
|
|
125
|
34 my $sourceSchema = $ctx->{Source} || $this->parentNode;
|
|
49
|
35
|
|
|
36 foreach my $child ( @{$node->childNodes} ) {
|
|
|
37 #skip schema elements
|
|
|
38 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
|
|
|
39 # if possible of course :)
|
|
|
40 return new IMPL::DOM::Schema::ValidationError (
|
|
|
41 Message => $this->messageUnexpected,
|
|
|
42 Node => $child,
|
|
102
|
43 Parent => $node,
|
|
49
|
44 Schema => $info->{Schema},
|
|
125
|
45 Source => $sourceSchema
|
|
49
|
46 ) if $info->{Min} > $info->{Seen};
|
|
|
47
|
|
|
48 $info = shift @nodes;
|
|
|
49 }
|
|
|
50
|
|
|
51 # return error if no more children allowed
|
|
|
52 return new IMPL::DOM::Schema::ValidationError (
|
|
|
53 Message => $this->messageUnexpected,
|
|
|
54 Node => $child,
|
|
102
|
55 Parent => $node,
|
|
125
|
56 Source => $sourceSchema
|
|
49
|
57 ) unless $info;
|
|
|
58
|
|
|
59 # 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
|
|
|
61
|
|
|
62 # validate
|
|
|
63 while (my @errors = $info->{Schema}->Validate($child)) {
|
|
|
64 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
|
|
|
65 # in case of any or switch node, skip it if possible
|
|
|
66 next if $info = shift @nodes;
|
|
|
67 }
|
|
|
68 return @errors;
|
|
|
69 }
|
|
|
70
|
|
|
71 $info->{Seen}++;
|
|
|
72
|
|
|
73 # check count limits
|
|
|
74 return new IMPL::DOM::Schema::ValidationError (
|
|
|
75 Error => 1,
|
|
|
76 Message => $this->messageUnexpected,
|
|
|
77 Node => $child,
|
|
102
|
78 Parent => $node,
|
|
125
|
79 Source => $sourceSchema,
|
|
49
|
80 ) if $info->{Max} and $info->{Seen} > $info->{Max};
|
|
|
81 }
|
|
|
82
|
|
|
83 # no more children left (but may be should :)
|
|
|
84 while ($info) {
|
|
|
85 return new IMPL::DOM::Schema::ValidationError (
|
|
|
86 Error => 1,
|
|
|
87 Message => $this->messageNodesRequired,
|
|
125
|
88 Source => $sourceSchema,
|
|
102
|
89 Parent => $node,
|
|
49
|
90 Schema => $info->{Schema}
|
|
|
91 ) if $info->{Seen} < $info->{Min};
|
|
|
92
|
|
|
93 $info = shift @nodes;
|
|
|
94 }
|
|
|
95 return;
|
|
|
96 }
|
|
|
97
|
|
|
98 1;
|
|
|
99
|
|
|
100 __END__
|
|
|
101
|
|
|
102 =pod
|
|
|
103
|
|
|
104 =head1 DESCRIPTION
|
|
|
105
|
|
|
106 . .
|
|
|
107 C<IMPL::DOM::Schema::ComplexNode> C<IMPL::DOM::Schema::SimpleNode>.
|
|
|
108
|
|
|
109 =cut
|
