view Lib/IMPL/DOM/Navigator.pm @ 156:8638dd1374bf

Added template property to IMPL::Web::QueryHandler::PageFormat (this allows to specify exact template (filename, ref to a scalar, ref to a file handle)).
author wizard
date Tue, 05 Oct 2010 17:20:51 +0400
parents a7efb3117295
children 76515373dac0
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 _initNavigator {
    my ($this,$CurrentNode) = @_;
    
    die IMPL::InvalidArgumentException("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 undef;
                @alternatives = $current->selectNodes($query);
            }
            
            push @{$this->{$_path}},$this->{$_state};
            $this->{$_state} = {
                alternatives => \@alternatives,
                current => 0,
                query => $query
            };
            
            $node = $alternatives[0];
        } else {
            return undef;
        }
    }
    
    $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 undef; # that meams the end of the history

            undef while ( $this->advanceNavigator and not $this->Navigate($query));

            return $this->Current;
        }
        return undef;
    }
    
    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 $steps) || $steps == 1) {
            $this->{$_state} = pop @{$this->{$_path}};
        } else {
            $steps ||= 1;
            
            $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
            
            $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0];
        }
        $this->Current if defined wantarray;
    } else {
        return undef;
    }
}

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 undef;
	}
}

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>.

=item C<<$obj->advanceNavigator()>>

Переходит в следующую альтернативу, соответствующую текущему запросу.

=back

=cut