view Lib/IMPL/DOM/Schema/NodeList.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 7f00786f8210
children 16ada169ca75
line wrap: on
line source

package IMPL::DOM::Schema::NodeList;
use strict;
use warnings;
use base qw(IMPL::DOM::Node);

use IMPL::Class::Property;
require IMPL::DOM::Schema::ValidationError;

our %CTOR = (
    'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
);

BEGIN {
    public property messageUnexpected => prop_all;
    public 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 %Node.path%');
}

sub Validate {
    my ($this,$node) = @_;
    
    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;
    
    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,
                Schema => $info->{Schema},
                Source => $this
            ) 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,
            Source => $this
        ) 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,
            Source => $this,
        ) 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,
            Node => $node,
            Source => $this,
            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