|
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',
|
|
389
|
9 AnyNode => '-IMPL::DOM::Schema::AnyNode',
|
|
|
10 Label => 'IMPL::DOM::Schema::Label'
|
|
388
|
11 },
|
|
|
12 base => [
|
|
|
13 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
|
|
|
14 ],
|
|
|
15 props => [
|
|
|
16 messageUnexpected => { get => 1, set => 1, dom => 1 },
|
|
|
17 messageNodesRequired => { get => 1, set => 1, dom => 1}
|
|
|
18 ]
|
|
|
19 };
|
|
49
|
20
|
|
|
21 sub CTOR {
|
|
|
22 my ($this,%args) = @_;
|
|
|
23
|
|
238
|
24 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
|
|
389
|
25 $this->messageNodesRequired($args{messageNodesRequired} || 'A %schemaNode.name% is required in the node %parent.path%');
|
|
49
|
26 }
|
|
|
27
|
|
|
28 sub Validate {
|
|
125
|
29 my ($this,$node,$ctx) = @_;
|
|
49
|
30
|
|
|
31 my @nodes = map {
|
|
388
|
32 {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 }
|
|
49
|
33 } @{$this->childNodes};
|
|
|
34
|
|
|
35 my $info = shift @nodes;
|
|
|
36
|
|
|
37 foreach my $child ( @{$node->childNodes} ) {
|
|
|
38 #skip schema elements
|
|
|
39 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
|
|
|
40 # if possible of course :)
|
|
388
|
41 return ValidationError->new (
|
|
389
|
42 message => $this->_MakeLabel( $this->messageUnexpected ),
|
|
236
|
43 node => $child,
|
|
|
44 parent => $node,
|
|
388
|
45 schemaNode => $info->{schemaNode}
|
|
389
|
46 ) if $info->{min} > $info->{seen}; # we trying to skip a schema node which has a quantifier
|
|
49
|
47
|
|
|
48 $info = shift @nodes;
|
|
|
49 }
|
|
|
50
|
|
|
51 # return error if no more children allowed
|
|
388
|
52 return ValidationError->new (
|
|
389
|
53 message => $this->_MakeLabel( $this->messageUnexpected ),
|
|
236
|
54 node => $child,
|
|
388
|
55 parent => $node
|
|
49
|
56 ) unless $info;
|
|
|
57
|
|
|
58 # it's ok, we found schema element for child
|
|
|
59
|
|
|
60 # validate
|
|
389
|
61 while (my @errors = $info->{schemaNode}->Validate( $child ) ) {
|
|
|
62 if( $info->{anyNode} and $info->{seen} >= $info->{min} ) {
|
|
49
|
63 # in case of any or switch node, skip it if possible
|
|
|
64 next if $info = shift @nodes;
|
|
|
65 }
|
|
|
66 return @errors;
|
|
|
67 }
|
|
|
68
|
|
389
|
69 $info->{seen}++;
|
|
49
|
70
|
|
|
71 # check count limits
|
|
389
|
72 return ValidationError->new(
|
|
|
73 message => $this->_MakeLabel( $this->messageUnexpected ),
|
|
236
|
74 node => $child,
|
|
|
75 parent => $node,
|
|
389
|
76 schemaNode => $info->{schemaNode},
|
|
|
77 ) if $info->{max} and $info->{seen} > $info->{max};
|
|
49
|
78 }
|
|
|
79
|
|
|
80 # no more children left (but may be should :)
|
|
|
81 while ($info) {
|
|
389
|
82 return ValidationError->new(
|
|
|
83 message => $this->_MakeLabel( $this->messageNodesRequired ),
|
|
236
|
84 parent => $node,
|
|
389
|
85 schemaNode => $info->{schemaNode}
|
|
|
86 ) if $info->{seen} < $info->{min};
|
|
49
|
87
|
|
|
88 $info = shift @nodes;
|
|
|
89 }
|
|
|
90 return;
|
|
|
91 }
|
|
|
92
|
|
389
|
93 sub _MakeLabel {
|
|
|
94 my ($this,$label) = @_;
|
|
|
95
|
|
|
96 if ($label =~ /^ID:(\w+)$/) {
|
|
|
97 return Label->new($this->document->stringMap, $1);
|
|
|
98 } else {
|
|
|
99 return $label;
|
|
|
100 }
|
|
|
101 }
|
|
|
102
|
|
49
|
103 1;
|
|
|
104
|
|
|
105 __END__
|
|
|
106
|
|
|
107 =pod
|
|
|
108
|
|
|
109 =head1 DESCRIPTION
|
|
|
110
|
|
180
|
111 Содержимое для сложного узла. Порядок важен. Дочерними элементами могут быть
|
|
|
112 только C<IMPL::DOM::Schema::ComplexNode> и C<IMPL::DOM::Schema::SimpleNode>.
|
|
49
|
113
|
|
|
114 =cut
|
