view Lib/IMPL/DOM/Navigator.pm @ 27:b544a772b654

ORM in progress
author Sergey
date Fri, 16 Oct 2009 16:37:53 +0400
parents 7f00786f8210
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