Mercurial > pub > Impl
view Lib/IMPL/DOM/Schema/NodeList.pm @ 263:0f59b2de72af
*fixed IMPL::DOM::Schema circular module references
*modified IMPL::Object::Singleton, added auto-activation
*code cleanups, docs
author | sergey |
---|---|
date | Wed, 09 Jan 2013 05:17:44 +0400 |
parents | b8c724f6de36 |
children | 648dfaf642e0 |
line wrap: on
line source
package IMPL::DOM::Schema::NodeList; use strict; use warnings; use parent qw(IMPL::DOM::Node); use IMPL::Class::Property; use IMPL::DOM::Property qw(_dom); require IMPL::DOM::Schema::ValidationError; our %CTOR = ( 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' } ); BEGIN { public _dom property messageUnexpected => prop_all; public _dom property messageNodesRequired => prop_all; } sub CTOR { my ($this,%args) = @_; $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%'); $this->messageNodesRequired($args{messageNodesRequired} || 'A %schema.name% is required in the node %parent.path%'); } sub Validate { my ($this,$node,$ctx) = @_; my @nodes = map { {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 } } @{$this->childNodes}; my $info = shift @nodes; my $sourceSchema = $ctx->{Source} || $this->parentNode; foreach my $child ( @{$node->childNodes} ) { #skip schema elements while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { # if possible of course :) return new IMPL::DOM::Schema::ValidationError ( message => $this->messageUnexpected, node => $child, parent => $node, schema => $info->{Schema}, source => $sourceSchema ) if $info->{Min} > $info->{Seen}; $info = shift @nodes; } # return error if no more children allowed return new IMPL::DOM::Schema::ValidationError ( message => $this->messageUnexpected, node => $child, parent => $node, source => $sourceSchema ) unless $info; # it's ok, we found schema element for child # but it may be any node or switching node wich would not satisfy current child # validate while (my @errors = $info->{Schema}->Validate($child)) { if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) { # in case of any or switch node, skip it if possible next if $info = shift @nodes; } return @errors; } $info->{Seen}++; # check count limits return new IMPL::DOM::Schema::ValidationError ( message => $this->messageUnexpected, node => $child, parent => $node, source => $sourceSchema, ) if $info->{Max} and $info->{Seen} > $info->{Max}; } # no more children left (but may be should :) while ($info) { return new IMPL::DOM::Schema::ValidationError ( error => 1, message => $this->messageNodesRequired, source => $sourceSchema, parent => $node, schema => $info->{Schema} ) if $info->{Seen} < $info->{Min}; $info = shift @nodes; } return; } 1; __END__ =pod =head1 DESCRIPTION Содержимое для сложного узла. Порядок важен. Дочерними элементами могут быть только C<IMPL::DOM::Schema::ComplexNode> и C<IMPL::DOM::Schema::SimpleNode>. =cut