Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Navigator.pm @ 358:248f95c1762a
added simple XML Sax parser
| author | sergey |
|---|---|
| date | Mon, 18 Nov 2013 01:25:35 +0400 |
| parents | 4ddb27ff4a0b |
| children | 010ceafd0c5a |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::DOM::Navigator; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 165 | 5 use parent qw(IMPL::Object); |
| 49 | 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 | |
| 238 | 17 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode; |
| 49 | 18 |
| 19 $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 }; | |
| 20 } | |
| 21 | |
| 22 sub _initNavigator { | |
| 23 my ($this,$CurrentNode) = @_; | |
| 24 | |
| 238 | 25 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode; |
| 49 | 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) { | |
| 235 | 49 $current = $this->advanceNavigator or return; |
| 49 | 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 { | |
| 235 | 62 return; |
| 49 | 63 } |
| 64 } | |
| 65 | |
| 66 $node; | |
| 67 } | |
| 68 | |
| 69 sub selectNodes { | |
| 70 my ($this,@path) = @_; | |
| 71 | |
| 122 | 72 return $this->Current->selectNodes(@path); |
| 49 | 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 | |
| 235 | 105 $this->Back or return; # that meams the end of the history |
| 49 | 106 |
| 107 undef while ( $this->advanceNavigator and not $this->Navigate($query)); | |
| 108 | |
| 109 return $this->Current; | |
| 110 } | |
| 235 | 111 return; |
| 49 | 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 if ($this->{$_path} and @{$this->{$_path}}) { | |
| 133 if ( (not $steps) || $steps == 1) { | |
| 134 $this->{$_state} = pop @{$this->{$_path}}; | |
| 135 } else { | |
| 136 $steps ||= 1; | |
| 137 | |
| 138 $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}}; | |
| 139 | |
| 140 $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0]; | |
| 141 } | |
| 142 $this->Current if defined wantarray; | |
| 143 } else { | |
| 235 | 144 return; |
| 49 | 145 } |
| 146 } | |
| 147 | |
| 148 sub PathToString { | |
| 149 my ($this,$delim) = @_; | |
| 150 | |
| 151 $delim ||= '/'; | |
| 152 | |
| 153 join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state}); | |
| 154 } | |
| 155 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
156 sub pathLength { |
| 194 | 157 my ($this) = @_; |
| 158 $this->{$_path} ? scalar @{$this->{$_path}} : 0; | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
159 } |
|
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 sub GetNodeFromHistory { |
| 194 | 162 my ($this,$index) = @_; |
| 163 | |
| 164 if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) { | |
| 165 return $state->{alternatives}[$state->{current}] | |
| 166 } else { | |
| 235 | 167 return; |
| 194 | 168 } |
|
104
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 |
| 49 | 171 sub clone { |
| 172 my ($this) = @_; | |
| 173 | |
| 174 my $newNavi = __PACKAGE__->surrogate; | |
| 175 | |
| 176 $newNavi->{$_path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; | |
| 177 $newNavi->{$_state} = { %{$this->{$_state}} }; | |
| 178 | |
| 179 return $newNavi; | |
| 180 | |
| 181 } | |
| 182 | |
| 183 sub saveState { | |
| 184 my ($this) = @_; | |
| 185 | |
| 186 my %state; | |
| 187 | |
| 188 $state{path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; | |
| 189 $state{state} = { %{$this->{$_state}} }; | |
| 190 | |
| 191 push @{$this->{$_savedstates}}, \%state; | |
| 192 } | |
| 193 | |
| 194 sub restoreState { | |
| 195 my ($this) = @_; | |
| 196 | |
| 197 if ( my $state = pop @{$this->{$_savedstates}||[]} ) { | |
| 198 $this->{$_path} = $state->{path}; | |
| 199 $this->{$_state} = $state->{state}; | |
| 200 } | |
| 201 } | |
| 202 | |
| 203 sub applyState { | |
| 204 my ($this) = @_; | |
| 205 | |
| 206 pop @{$this->{$_savedstates}||[]}; | |
| 207 } | |
| 208 | |
| 209 sub dosafe { | |
| 210 my ($this,$transaction) = @_; | |
| 211 | |
| 212 $this->saveState(); | |
| 213 | |
| 214 my $result; | |
| 215 | |
| 216 eval { | |
| 217 $result = $transaction->(); | |
| 218 }; | |
| 219 | |
| 220 if ($@) { | |
| 221 $this->restoreState(); | |
| 235 | 222 return; |
| 49 | 223 } else { |
| 224 $this->applyState(); | |
| 225 return $result; | |
| 226 } | |
| 227 } | |
| 228 | |
| 229 1; | |
| 230 | |
| 231 __END__ | |
| 232 =pod | |
| 233 | |
| 234 =head1 DESCRIPTION | |
| 235 | |
| 180 | 236 Объект для хождения по дереву DOM объектов. |
| 49 | 237 |
| 180 | 238 Результатом навигации является множество узлов (альтернатив). |
| 49 | 239 |
| 180 | 240 Состоянием навигатора является текущий набор узлов, позиция в данном наборе, |
| 241 а также запрос по которому были получены данные результаты. | |
| 49 | 242 |
| 180 | 243 Если при навигации указан путь сосящий из нескольких фильтров, то он разбивается |
| 244 этапы простой навигации по кадой из частей пути. На каждом элементарном этапе | |
| 245 навигации образуется ряд альтернатив, и при каждом следующем этапе навигации | |
| 246 альтернативы предыдущих этапов могут перебираться, до получения положительного | |
| 247 результата навигации, в противном случае навигация считается невозможной. | |
| 49 | 248 |
| 249 =head1 METHODS | |
| 250 | |
| 251 =over | |
| 252 | |
| 253 =item C<<$obj->new($nodeStart)>> | |
| 254 | |
| 180 | 255 Создает объект навигатора с указанной начальной позицией. |
| 49 | 256 |
| 257 =item C<<$obj->Navigate([$query,...])>> | |
| 258 | |
| 180 | 259 Перейти в новый узел используя запрос C<$query>. На данный момент запросом может |
| 260 быть только имя узла и будет взят только первый узел. Если по запросу ничего не | |
| 261 найдено, переход не будет осуществлен. | |
| 49 | 262 |
| 180 | 263 Возвращает либо новый узел в который перешли, либо C<undef>. |
| 49 | 264 |
| 265 =item C<<$obj->Back()>> | |
| 266 | |
| 180 | 267 Возвращается в предыдущий узел, если таковой есть. |
| 49 | 268 |
| 180 | 269 Возвращает либо узел в который перешли, либо C<undef>. |
| 49 | 270 |
| 271 =item C<<$obj->advanceNavigator()>> | |
| 272 | |
| 180 | 273 Переходит в следующую альтернативу, соответствующую текущему запросу. |
| 49 | 274 |
| 275 =back | |
| 276 | |
| 277 =cut |