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