view lib/IMPL/DOM/Schema/NodeList.pm @ 424:87af445663d7 ref20150831

IMPL::Object::_Base
author cin
date Tue, 03 Apr 2018 10:54:09 +0300
parents c6e90e02dd17
children
line wrap: on
line source

package IMPL::DOM::Schema::NodeList;
use strict;
use warnings;


use IMPL::declare {
	require => {
		ValidationError => 'IMPL::DOM::Schema::ValidationError',
		AnyNode => '-IMPL::DOM::Schema::AnyNode',
		Label => 'IMPL::DOM::Schema::Label'
	},
	base => [
		'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
	],
	props => [
		messageUnexpected => { get => 1, set => 1, dom => 1 },
		messageNodesRequired => { get => 1, set => 1, dom => 1}
	]
};

sub CTOR {
    my ($this,%args) = @_;
    
    $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
    $this->messageNodesRequired($args{messageNodesRequired} || 'A %schemaNode.name% is required in the node %parent.path%');
}

sub Validate {
    my ($this,$node,$ctx) = @_;
    
    my @nodes = map {
        {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 }
    } @{$this->childNodes};
    
    my $info = shift @nodes;
    
    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 ValidationError->new (
                message => $this->_MakeLabel( $this->messageUnexpected ),
                node => $child,
                parent => $node,
                schemaNode => $info->{schemaNode}
            ) if $info->{min} > $info->{seen}; # we trying to skip a schema node which has a quantifier
            
            $info = shift @nodes;
        }
        
        # return error if no more children allowed
        return ValidationError->new (
            message => $this->_MakeLabel( $this->messageUnexpected ),
            node => $child,
            parent => $node
        ) unless $info;
        
        # it's ok, we found schema element for child

        # validate
        while (my @errors = $info->{schemaNode}->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 ValidationError->new(
            message => $this->_MakeLabel( $this->messageUnexpected ),
            node => $child,
            parent => $node,
            schemaNode => $info->{schemaNode},
        ) if $info->{max} and $info->{seen} > $info->{max};
    }
    
    # no more children left (but may be should :)
    while ($info) {
        return ValidationError->new(
            message => $this->_MakeLabel( $this->messageNodesRequired ),
            parent => $node,
            schemaNode => $info->{schemaNode}
        ) if $info->{seen} < $info->{min};
        
        $info = shift @nodes;
    }
    return;
}

sub _MakeLabel {
	my ($this,$label) = @_;
	
	if ($label =~ /^ID:(\w+)$/) {
		return Label->new($this->document->stringMap, $1);
	} else {
		return $label;
	}
}

1;

__END__

=pod

=head1 DESCRIPTION

Содержимое для сложного узла. Порядок важен. Дочерними элементами могут быть
только C<IMPL::DOM::Schema::ComplexNode> и C<IMPL::DOM::Schema::SimpleNode>.

=cut