|
49
|
1 package IMPL::DOM::Schema::NodeList;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5
|
|
388
|
6 use IMPL::declare {
|
|
|
7 require => {
|
|
|
8 ValidationError => 'IMPL::DOM::Schema::ValidationError',
|
|
|
9 AnyNode => '-IMPL::DOM::Schema::AnyNode'
|
|
|
10 },
|
|
|
11 base => [
|
|
|
12 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
|
|
|
13 ],
|
|
|
14 props => [
|
|
|
15 messageUnexpected => { get => 1, set => 1, dom => 1 },
|
|
|
16 messageNodesRequired => { get => 1, set => 1, dom => 1}
|
|
|
17 ]
|
|
|
18 };
|
|
49
|
19
|
|
|
20 sub CTOR {
|
|
|
21 my ($this,%args) = @_;
|
|
|
22
|
|
238
|
23 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
|
|
|
24 $this->messageNodesRequired($args{messageNodesRequired} || 'A %schema.name% is required in the node %parent.path%');
|
|
49
|
25 }
|
|
|
26
|
|
|
27 sub Validate {
|
|
125
|
28 my ($this,$node,$ctx) = @_;
|
|
49
|
29
|
|
|
30 my @nodes = map {
|
|
388
|
31 {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 }
|
|
49
|
32 } @{$this->childNodes};
|
|
|
33
|
|
|
34 my $info = shift @nodes;
|
|
|
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 :)
|
|
388
|
40 return ValidationError->new (
|
|
236
|
41 message => $this->messageUnexpected,
|
|
|
42 node => $child,
|
|
|
43 parent => $node,
|
|
388
|
44 schemaNode => $info->{schemaNode}
|
|
49
|
45 ) if $info->{Min} > $info->{Seen};
|
|
|
46
|
|
|
47 $info = shift @nodes;
|
|
|
48 }
|
|
|
49
|
|
|
50 # return error if no more children allowed
|
|
388
|
51 return ValidationError->new (
|
|
236
|
52 message => $this->messageUnexpected,
|
|
|
53 node => $child,
|
|
388
|
54 parent => $node
|
|
49
|
55 ) unless $info;
|
|
|
56
|
|
|
57 # 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
|
|
|
60 # validate
|
|
388
|
61 while (my @errors = $info->{schemaNode}->Validate($child)) {
|
|
49
|
62 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
|
|
|
63 # in case of any or switch node, skip it if possible
|
|
|
64 next if $info = shift @nodes;
|
|
|
65 }
|
|
|
66 return @errors;
|
|
|
67 }
|
|
|
68
|
|
|
69 $info->{Seen}++;
|
|
|
70
|
|
|
71 # check count limits
|
|
|
72 return new IMPL::DOM::Schema::ValidationError (
|
|
236
|
73 message => $this->messageUnexpected,
|
|
|
74 node => $child,
|
|
|
75 parent => $node,
|
|
|
76 source => $sourceSchema,
|
|
49
|
77 ) if $info->{Max} and $info->{Seen} > $info->{Max};
|
|
|
78 }
|
|
|
79
|
|
|
80 # no more children left (but may be should :)
|
|
|
81 while ($info) {
|
|
|
82 return new IMPL::DOM::Schema::ValidationError (
|
|
236
|
83 error => 1,
|
|
|
84 message => $this->messageNodesRequired,
|
|
|
85 source => $sourceSchema,
|
|
|
86 parent => $node,
|
|
|
87 schema => $info->{Schema}
|
|
49
|
88 ) if $info->{Seen} < $info->{Min};
|
|
|
89
|
|
|
90 $info = shift @nodes;
|
|
|
91 }
|
|
|
92 return;
|
|
|
93 }
|
|
|
94
|
|
|
95 1;
|
|
|
96
|
|
|
97 __END__
|
|
|
98
|
|
|
99 =pod
|
|
|
100
|
|
|
101 =head1 DESCRIPTION
|
|
|
102
|
|
180
|
103 Содержимое для сложного узла. Порядок важен. Дочерними элементами могут быть
|
|
|
104 только C<IMPL::DOM::Schema::ComplexNode> и C<IMPL::DOM::Schema::SimpleNode>.
|
|
49
|
105
|
|
|
106 =cut
|
