Mercurial > pub > Impl
view Lib/IMPL/DOM/Navigator.pm @ 24:7f00786f8210
Первая рабочая реазизация схемы и навигаторов
author | Sergey |
---|---|
date | Mon, 05 Oct 2009 00:48:49 +0400 |
parents | 818c74b038ae |
children | a8086f85a571 |
line wrap: on
line source
package IMPL::DOM::Navigator; use strict; use warnings; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Class::Property::Direct; BEGIN { private _direct property _path => prop_all; private _direct property _state => prop_all; private _direct property _savedstates => prop_all; public property Current => {get => \&_getCurrent}; } sub CTOR { my ($this,$CurrentNode) = @_; die IMPL::InvalidArgumentException("A starting node is a required paramater") unless $CurrentNode; $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 }; } sub _getCurrent { $_[0]->{$_state}{alternatives}[$_[0]->{$_state}{current}] } sub Navigate { my ($this,@path) = @_; return unless @path; foreach my $query (@path) { if (my $current = $this->Current) { my @alternatives = $this->Current->selectNodes($query); unless (@alternatives) { $this->advanceNavigator or return undef; @alternatives = $this->Current->selectNodes($query); } push @{$this->{$_path}},$this->{$_state}; $this->{$_state} = { alternatives => \@alternatives, current => 0, query => $query } } else { return undef; } } return $this->Current; } sub selectNodes { my ($this,@path) = @_; return internalSelectNodes($this->Current,@path); } sub internalSelectNodes { my $node = shift; my $query = shift; if (@_) { return map internalSelectNodes($_,@_), $node->selectNodes($query); } else { return $node->selectNodes($query); } } sub internalNavigateNodeSet { my ($this,@nodeSet) = @_; push @{$this->{$_path}}, $this->{$_state}; $this->{$_state} = { alternatives => \@nodeSet, current => 0 }; return $this->Current; } sub fetch { my ($this) = @_; my $result = $this->Current; $this->advanceNavigator; return $result; } sub advanceNavigator { my ($this) = @_; $this->{$_state}{current}++; if (@{$this->{$_state}{alternatives}} <= $this->{$_state}{current}) { if ( exists $this->{$_state}{query} ) { my $query = $this->{$_state}{query}; $this->Back or return 0; # that meams the end of the history undef while ( $this->advanceNavigator and not $this->Navigate($query)); return $this->Current ? 1 : 0; } return 0; } return 1; } sub doeach { my ($this,$code) = @_; local $_; do { for (my $i = $this->{$_state}{current}; $i < @{$this->{$_state}{alternatives}}; $i++) { $_ = $this->{$_state}{alternatives}[$i]; $code->(); } $this->{$_state}{current} = @{$this->{$_state}{alternatives}}; } while ($this->advanceNavigator); } sub Back { my ($this,$steps) = @_; $steps ||= 1; if ($this->{$_path} and @{$this->{$_path}}) { $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}}; ($this->{$_state}) = splice @{$this->{$_path}},-$steps; $this->Current; } else { return undef; } } sub PathToString { my ($this,$delim) = @_; $delim ||= '/'; join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state}); } sub clone { my ($this) = @_; my $newNavi = __PACKAGE__->surrogate; $newNavi->{$_path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; $newNavi->{$_state} = { %{$this->{$_state}} }; return $newNavi; } sub saveState { my ($this) = @_; my %state; $state{path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; $state{state} = { %{$this->{$_state}} }; push @{$this->{$_savedstates}}, \%state; } sub restoreState { my ($this) = @_; if ( my $state = pop @{$this->{$_savedstates}||[]} ) { $this->{$_path} = $state->{path}; $this->{$_state} = $state->{state}; } } sub applyState { my ($this) = @_; pop @{$this->{$_savedstates}||[]}; } sub dosafe { my ($this,$transaction) = @_; $this->saveState(); my $result; eval { $result = $transaction->(); }; if ($@) { $this->restoreState(); return undef; } else { $this->applyState(); return $result; } } 1; __END__ =pod =head1 DESCRIPTION DOM . (). , , . =head1 METHODS =over =item C<$obj->new($nodeStart)> . =item C<$obj->Navigate([$query,...])> C<$query>. . , . , C<undef>. =item C<$obj->Back()> , . , C<undef>. =back =cut