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