diff lib/IMPL/DOM/Navigator.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/DOM/Navigator.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,276 @@
+package IMPL::DOM::Navigator;
+use strict;
+use warnings;
+
+use parent qw(IMPL::Object);
+use IMPL::Class::Property;
+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->new("A starting node is a required paramater") unless $CurrentNode;
+    
+    $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
+}
+
+sub _initNavigator {
+    my ($this,$CurrentNode) = @_;
+    
+    die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode;
+    
+    $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
+    delete $this->{$_path};
+    delete $this->{$_savedstates};
+}
+
+sub _getCurrent {
+    $_[0]->{$_state}{alternatives}[$_[0]->{$_state}{current}]
+}
+
+sub Navigate {
+    my ($this,@path) = @_;
+    
+    return unless @path;
+    
+    my $node;
+    
+    foreach my $query (@path) {
+        if (my $current = $this->Current) {
+            
+            my @alternatives = $current->selectNodes($query);
+            
+            unless (@alternatives) {
+                $current = $this->advanceNavigator or return;
+                @alternatives = $current->selectNodes($query);
+            }
+            
+            push @{$this->{$_path}},$this->{$_state};
+            $this->{$_state} = {
+                alternatives => \@alternatives,
+                current => 0,
+                query => $query
+            };
+            
+            $node = $alternatives[0];
+        } else {
+            return;
+        }
+    }
+    
+    $node;
+}
+
+sub selectNodes {
+    my ($this,@path) = @_;
+    
+    return $this->Current->selectNodes(@path);
+}
+
+sub internalNavigateNodeSet {
+    my ($this,@nodeSet) = @_;
+    
+    push @{$this->{$_path}}, $this->{$_state};
+    
+    $this->{$_state} = {
+        alternatives => \@nodeSet,
+        current => 0
+    };
+    
+    $nodeSet[0];
+}
+
+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; # that meams the end of the history
+
+            undef while ( $this->advanceNavigator and not $this->Navigate($query));
+
+            return $this->Current;
+        }
+        return;
+    }
+    
+    return $this->Current;
+}
+
+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) = @_;
+    
+    if ($this->{$_path} and @{$this->{$_path}}) {
+        if ( (not defined $steps) || $steps == 1) {
+            $this->{$_state} = pop @{$this->{$_path}};
+        } elsif ($steps > 0) {
+            $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
+            
+            $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0];
+        }
+        $this->Current if defined wantarray;
+    } else {
+        return;
+    }
+}
+
+sub PathToString {
+    my ($this,$delim) = @_;
+    
+    $delim ||= '/';
+    
+    join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state});
+}
+
+sub pathLength {
+    my ($this) = @_;
+    $this->{$_path} ? scalar @{$this->{$_path}} : 0;
+}
+
+sub GetNodeFromHistory {
+    my ($this,$index) = @_;
+    
+    if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) {
+        return $state->{alternatives}[$state->{current}]
+    } else {
+        return;
+    }
+}
+
+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;
+    } 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>.
+
+=item C<<$obj->advanceNavigator()>>
+
+Переходит в следующую альтернативу, соответствующую текущему запросу.
+
+=back
+
+=cut