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

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::DOM::Navigator;
2 use strict;
3 use warnings;
4
5 use parent qw(IMPL::Object);
6 use IMPL::Class::Property;
7 BEGIN {
8 private _direct property _path => prop_all;
9 private _direct property _state => prop_all;
10 private _direct property _savedstates => prop_all;
11 public property Current => {get => \&_getCurrent};
12 }
13
14 sub CTOR {
15 my ($this,$CurrentNode) = @_;
16
17 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode;
18
19 $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
20 }
21
22 sub _initNavigator {
23 my ($this,$CurrentNode) = @_;
24
25 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode;
26
27 $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 };
28 delete $this->{$_path};
29 delete $this->{$_savedstates};
30 }
31
32 sub _getCurrent {
33 $_[0]->{$_state}{alternatives}[$_[0]->{$_state}{current}]
34 }
35
36 sub Navigate {
37 my ($this,@path) = @_;
38
39 return unless @path;
40
41 my $node;
42
43 foreach my $query (@path) {
44 if (my $current = $this->Current) {
45
46 my @alternatives = $current->selectNodes($query);
47
48 unless (@alternatives) {
49 $current = $this->advanceNavigator or return;
50 @alternatives = $current->selectNodes($query);
51 }
52
53 push @{$this->{$_path}},$this->{$_state};
54 $this->{$_state} = {
55 alternatives => \@alternatives,
56 current => 0,
57 query => $query
58 };
59
60 $node = $alternatives[0];
61 } else {
62 return;
63 }
64 }
65
66 $node;
67 }
68
69 sub selectNodes {
70 my ($this,@path) = @_;
71
72 return $this->Current->selectNodes(@path);
73 }
74
75 sub internalNavigateNodeSet {
76 my ($this,@nodeSet) = @_;
77
78 push @{$this->{$_path}}, $this->{$_state};
79
80 $this->{$_state} = {
81 alternatives => \@nodeSet,
82 current => 0
83 };
84
85 $nodeSet[0];
86 }
87
88 sub fetch {
89 my ($this) = @_;
90
91 my $result = $this->Current;
92 $this->advanceNavigator;
93 return $result;
94 }
95
96 sub advanceNavigator {
97 my ($this) = @_;
98
99 $this->{$_state}{current}++;
100
101 if (@{$this->{$_state}{alternatives}} <= $this->{$_state}{current}) {
102 if ( exists $this->{$_state}{query} ) {
103 my $query = $this->{$_state}{query};
104
105 $this->Back or return; # that meams the end of the history
106
107 undef while ( $this->advanceNavigator and not $this->Navigate($query));
108
109 return $this->Current;
110 }
111 return;
112 }
113
114 return $this->Current;
115 }
116
117 sub doeach {
118 my ($this,$code) = @_;
119 local $_;
120
121 do {
122 for (my $i = $this->{$_state}{current}; $i < @{$this->{$_state}{alternatives}}; $i++) {
123 $_ = $this->{$_state}{alternatives}[$i];
124 $code->();
125 }
126 $this->{$_state}{current} = @{$this->{$_state}{alternatives}};
127 } while ($this->advanceNavigator);
128 }
129
130 sub Back {
131 my ($this,$steps) = @_;
132
133 if ($this->{$_path} and @{$this->{$_path}}) {
134 if ( (not defined $steps) || $steps == 1) {
135 $this->{$_state} = pop @{$this->{$_path}};
136 } elsif ($steps > 0) {
137 $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}};
138
139 $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0];
140 }
141 $this->Current if defined wantarray;
142 } else {
143 return;
144 }
145 }
146
147 sub PathToString {
148 my ($this,$delim) = @_;
149
150 $delim ||= '/';
151
152 join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state});
153 }
154
155 sub pathLength {
156 my ($this) = @_;
157 $this->{$_path} ? scalar @{$this->{$_path}} : 0;
158 }
159
160 sub GetNodeFromHistory {
161 my ($this,$index) = @_;
162
163 if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) {
164 return $state->{alternatives}[$state->{current}]
165 } else {
166 return;
167 }
168 }
169
170 sub clone {
171 my ($this) = @_;
172
173 my $newNavi = __PACKAGE__->surrogate;
174
175 $newNavi->{$_path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path};
176 $newNavi->{$_state} = { %{$this->{$_state}} };
177
178 return $newNavi;
179
180 }
181
182 sub saveState {
183 my ($this) = @_;
184
185 my %state;
186
187 $state{path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path};
188 $state{state} = { %{$this->{$_state}} };
189
190 push @{$this->{$_savedstates}}, \%state;
191 }
192
193 sub restoreState {
194 my ($this) = @_;
195
196 if ( my $state = pop @{$this->{$_savedstates}||[]} ) {
197 $this->{$_path} = $state->{path};
198 $this->{$_state} = $state->{state};
199 }
200 }
201
202 sub applyState {
203 my ($this) = @_;
204
205 pop @{$this->{$_savedstates}||[]};
206 }
207
208 sub dosafe {
209 my ($this,$transaction) = @_;
210
211 $this->saveState();
212
213 my $result;
214
215 eval {
216 $result = $transaction->();
217 };
218
219 if ($@) {
220 $this->restoreState();
221 return;
222 } else {
223 $this->applyState();
224 return $result;
225 }
226 }
227
228 1;
229
230 __END__
231 =pod
232
233 =head1 DESCRIPTION
234
235 Объект для хождения по дереву DOM объектов.
236
237 Результатом навигации является множество узлов (альтернатив).
238
239 Состоянием навигатора является текущий набор узлов, позиция в данном наборе,
240 а также запрос по которому были получены данные результаты.
241
242 Если при навигации указан путь сосящий из нескольких фильтров, то он разбивается
243 этапы простой навигации по кадой из частей пути. На каждом элементарном этапе
244 навигации образуется ряд альтернатив, и при каждом следующем этапе навигации
245 альтернативы предыдущих этапов могут перебираться, до получения положительного
246 результата навигации, в противном случае навигация считается невозможной.
247
248 =head1 METHODS
249
250 =over
251
252 =item C<<$obj->new($nodeStart)>>
253
254 Создает объект навигатора с указанной начальной позицией.
255
256 =item C<<$obj->Navigate([$query,...])>>
257
258 Перейти в новый узел используя запрос C<$query>. На данный момент запросом может
259 быть только имя узла и будет взят только первый узел. Если по запросу ничего не
260 найдено, переход не будет осуществлен.
261
262 Возвращает либо новый узел в который перешли, либо C<undef>.
263
264 =item C<<$obj->Back()>>
265
266 Возвращается в предыдущий узел, если таковой есть.
267
268 Возвращает либо узел в который перешли, либо C<undef>.
269
270 =item C<<$obj->advanceNavigator()>>
271
272 Переходит в следующую альтернативу, соответствующую текущему запросу.
273
274 =back
275
276 =cut