view Lib/IMPL/DOM/Navigator/SchemaNavigator.pm @ 69:8c7b88bdb663

Cookie Simple auth support
author wizard
date Wed, 24 Mar 2010 17:41:41 +0300
parents 16ada169ca75
children c289ed9662ca
line wrap: on
line source

package IMPL::DOM::Navigator::SchemaNavigator;
use strict;
use warnings;

use base qw(IMPL::DOM::Navigator);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;

require IMPL::DOM::Schema::ComplexType;
require IMPL::DOM::Schema::NodeSet;
require IMPL::DOM::Schema::AnyNode;

__PACKAGE__->PassThroughArgs;

BEGIN {
    public _direct property Schema => prop_get;
    private _direct property _historySteps => prop_all;
}

sub CTOR {
    my ($this,$schema) = @_;
    
    $this->{$Schema} = $schema;
    
    die new IMPL::InvalidArgumentException("A schema object is required") unless $schema->isa('IMPL::DOM::Schema');
}

my $schemaAnyNode = IMPL::DOM::Schema::ComplexType->new(type => '::AnyNodeType', nativeType => 'IMPL::DOM::ComplexNode')->appendRange(
    IMPL::DOM::Schema::NodeSet->new()->appendRange(
        IMPL::DOM::Schema::AnyNode->new()
    )
);

sub NavigateName {
    my ($this,$name) = @_;
    
    die new IMPL::InvalidArgumentException('name is required') unless defined $name;
    
    # perform a safe navigation
    #return dosafe $this sub {
        my $steps = 1;
        # navigate to node
        if (
            my $node = $this->Navigate( sub {
                $_->isa('IMPL::DOM::Schema::Node') and (
                    $_->name eq $name
                    or
                    $_->nodeName eq 'AnyNode'
                    or
                    ( $_->nodeName eq 'SwitchNode' and $_->selectNodes( sub { $_->name eq $name } ) )
                )
            })
        ) {
            if ($node->nodeName eq 'AnyNode') {
                # if we navigate to the anynode
                # assume it to be ComplexType by default
                $node = $node->type ? $this->{$Schema}->resolveType($node->type) : $schemaAnyNode;
            } elsif ($node->nodeName eq 'SwitchNode') {
                # if we are in the switchnode
                # navigate to the target node
                $node = $this->Navigate(sub { $_->name eq $name });
                $steps ++;
            }
            
            if ($node->nodeName eq 'Node') {
                # if we navigate to a reference
                # resolve it
                $node = $this->{$Schema}->resolveType($node->type);
                $this->internalNavigateNodeSet($node);
                $steps++;
            } 
            
            # if target node is a complex node
            if ($node->isa('IMPL::DOM::Schema::ComplexNode')) {
                # navigate to it's content
                $this->internalNavigateNodeSet($node->content);
                $steps ++;
            }
            
            push @{$this->{$_historySteps}},$steps;
            
            # return found node schema
            return $node;
        } else {
            return undef; # abort navigation
        }
    #}
}

sub SchemaBack {
    my ($this) = @_;
    
    $this->Back(pop @{$this->{$_historySteps}}) if $this->{$_historySteps};
}

1;
__END__

=pod

=head1 DESCRIPTION

Помимо стандартных методов навигации позволяет переходить по элементам документа,
который данной схемой описывается.

=head1 METHODS

=over

=item C<< $navi->NavigateName($name) >>

Переходит на схему узла с указанным именем. Тоесть использует свойство C<name>.
В данном случае всегда происходит безопасная навигация, тоесть в случае неудачи,
навигатор останется на прежней позиции.

=item C<< $navi->SchemaBack >>

Возвращается на позицию до последней операции C<NavigateName>. Данный метод нужен
посокольку операция навигации по элементам описываемым схемой может приводить к
нескольким операциям навигации по самой схеме.

=back

=cut