Mercurial > pub > Impl
view Lib/IMPL/DOM/Navigator/SchemaNavigator.pm @ 28:6d33f75c6e1f
ORM in works
author | Sergey |
---|---|
date | Mon, 19 Oct 2009 04:13:54 +0400 |
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