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