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