view Lib/IMPL/DOM/Navigator/SchemaNavigator.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 a8086f85a571
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) = @_;
    
    # 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 {
            die; # 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