view Lib/IMPL/DOM/Schema/NodeSet.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 5aff94ba842f
line wrap: on
line source

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

use parent qw(IMPL::DOM::Node);
use IMPL::Class::Property;
use IMPL::DOM::Property qw(_dom);

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

BEGIN {
    public _dom property messageUnexpected => prop_all;
    public _dom property messageMax => prop_all;
    public _dom property messageMin => prop_all;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $this->messageMax( $args{messageMax} || 'Too many %node.nodeName% nodes');
    $this->messageMin( $args{messageMin} || '%schema.name% nodes expected');
    $this->messageUnexpected( $args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
}

sub Validate {
    my ($this,$node,$ctx) = @_;
    
    my @errors;
    
    my %nodes;
    my $anyNode;
    my $sourceSchema = $ctx->{Source} || $this->parentNode;
    
    foreach (@{$this->childNodes}) {
        if ($_->isa('IMPL::DOM::Schema::AnyNode')) {
            $anyNode = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 };
        } else {
            $nodes{$_->name} = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 };
        }
    }
    
    foreach my $child ( @{$node->childNodes} ) {
        if (my $info = $nodes{$child->nodeName} || $anyNode) {
            $info->{Seen}++;
            push @errors,new IMPL::DOM::Schema::ValidationError (
                source => $sourceSchema,
                node => $child,
                parent => $node,
                schema => $info->{Schema},
                message => $this->messageMax
            ) if ($info->{Max} and $info->{Seen} > $info->{Max});
            
            if (my @localErrors = $info->{Schema}->Validate($child)) {
                push @errors,@localErrors;
            }
        } else {
            push @errors, new IMPL::DOM::Schema::ValidationError (
                source => $sourceSchema,
                node => $child,
                parent => $node,
                message => $this->messageUnexpected
            )
        }
    }
    
    foreach my $info (values %nodes) {
        push @errors, new IMPL::DOM::Schema::ValidationError (
            source => $sourceSchema,
            schema => $info->{Schema},
            parent => $node,
            message => $this->messageMin
        ) if $info->{Min} > $info->{Seen};
    }
    
    return @errors;
}

1;

__END__

=pod

=head1 DESCRIPTION

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

При проверке данного правила, проверяются имеющиеся элементы на соответсие схемы
и количества встречаемости, после чего проверяются количественные ограничения
для несуществующих элементов.

=cut