view Lib/IMPL/DOM/Schema/NodeList.pm @ 370:cbf4febf0930

ObjectMeta, Tests, migrating to the new metadata model.
author sergey
date Tue, 10 Dec 2013 03:02:01 +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