view Lib/IMPL/DOM/Schema/NodeList.pm @ 215:77a9934a44af

sync, migrating to XML::Compile
author cin
date Sun, 19 Aug 2012 22:27:43 +0400
parents d1676be8afcc
children 2904da230022
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 (
            Error => 1,
            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