Mercurial > pub > Impl
comparison lib/IMPL/DOM/Schema/NodeList.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
| author | cin |
|---|---|
| date | Fri, 04 Sep 2015 19:40:23 +0300 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 406:f23fcb19d3c1 | 407:c6e90e02dd17 |
|---|---|
| 1 package IMPL::DOM::Schema::NodeList; | |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 5 | |
| 6 use IMPL::declare { | |
| 7 require => { | |
| 8 ValidationError => 'IMPL::DOM::Schema::ValidationError', | |
| 9 AnyNode => '-IMPL::DOM::Schema::AnyNode', | |
| 10 Label => 'IMPL::DOM::Schema::Label' | |
| 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 }; | |
| 20 | |
| 21 sub CTOR { | |
| 22 my ($this,%args) = @_; | |
| 23 | |
| 24 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%'); | |
| 25 $this->messageNodesRequired($args{messageNodesRequired} || 'A %schemaNode.name% is required in the node %parent.path%'); | |
| 26 } | |
| 27 | |
| 28 sub Validate { | |
| 29 my ($this,$node,$ctx) = @_; | |
| 30 | |
| 31 my @nodes = map { | |
| 32 {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 } | |
| 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 :) | |
| 41 return ValidationError->new ( | |
| 42 message => $this->_MakeLabel( $this->messageUnexpected ), | |
| 43 node => $child, | |
| 44 parent => $node, | |
| 45 schemaNode => $info->{schemaNode} | |
| 46 ) if $info->{min} > $info->{seen}; # we trying to skip a schema node which has a quantifier | |
| 47 | |
| 48 $info = shift @nodes; | |
| 49 } | |
| 50 | |
| 51 # return error if no more children allowed | |
| 52 return ValidationError->new ( | |
| 53 message => $this->_MakeLabel( $this->messageUnexpected ), | |
| 54 node => $child, | |
| 55 parent => $node | |
| 56 ) unless $info; | |
| 57 | |
| 58 # it's ok, we found schema element for child | |
| 59 | |
| 60 # validate | |
| 61 while (my @errors = $info->{schemaNode}->Validate( $child ) ) { | |
| 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 ValidationError->new( | |
| 73 message => $this->_MakeLabel( $this->messageUnexpected ), | |
| 74 node => $child, | |
| 75 parent => $node, | |
| 76 schemaNode => $info->{schemaNode}, | |
| 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 ValidationError->new( | |
| 83 message => $this->_MakeLabel( $this->messageNodesRequired ), | |
| 84 parent => $node, | |
| 85 schemaNode => $info->{schemaNode} | |
| 86 ) if $info->{seen} < $info->{min}; | |
| 87 | |
| 88 $info = shift @nodes; | |
| 89 } | |
| 90 return; | |
| 91 } | |
| 92 | |
| 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 | |
| 103 1; | |
| 104 | |
| 105 __END__ | |
| 106 | |
| 107 =pod | |
| 108 | |
| 109 =head1 DESCRIPTION | |
| 110 | |
| 111 Содержимое для сложного узла. Порядок важен. Дочерними элементами могут быть | |
| 112 только C<IMPL::DOM::Schema::ComplexNode> и C<IMPL::DOM::Schema::SimpleNode>. | |
| 113 | |
| 114 =cut |
