view Lib/IMPL/DOM/Schema/NodeList.pm @ 388:648dfaf642e0

DOM refactoring, removed inflators from DOM Schema, DOM validation - in progress
author cin
date Tue, 11 Feb 2014 20:22:01 +0400
parents b8c724f6de36
children 5aff94ba842f
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'
	},
	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 %schema.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->messageUnexpected,
                node => $child,
                parent => $node,
                schemaNode => $info->{schemaNode}
            ) if $info->{Min} > $info->{Seen};
            
            $info = shift @nodes;
        }
        
        # return error if no more children allowed
        return ValidationError->new (
            message => $this->messageUnexpected,
            node => $child,
            parent => $node
        ) 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->{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 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