view Lib/IMPL/DOM/Schema/NodeSet.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children df6b4f054957
line wrap: on
line source

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

use base qw(IMPL::DOM::Node);
use IMPL::Class::Property;

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

BEGIN {
    public property messageUnexpected => prop_all;
    public property messageMax => prop_all;
    public 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) = @_;
    
    my @errors;
    
    my %nodes;
    my $anyNode;
    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 => $this,
                Node => $child,
                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 => $this,
                Node => $child,
                Schema => $info->{Schema},
                Message => $this->messageUnexpected
            )
        }
    }
    
    foreach my $info (values %nodes) {
        push @errors, new IMPL::DOM::Schema::ValidationError (
            Source => $this,
            Schema => $info->{Schema},
            Node => $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