Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Navigator.pm @ 250:129e48bb5afb
DOM refactoring
ObjectToDOM methods are virtual
QueryToDOM uses inflators
Fixed transform for the complex values in the ObjectToDOM
QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
| author | sergey |
|---|---|
| date | Wed, 07 Nov 2012 04:17:53 +0400 |
| parents | b8c724f6de36 |
| children | 4ddb27ff4a0b |
| 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 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 | |
| 238 | 18 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode; |
| 49 | 19 |
| 20 $this->{$_state} = { alternatives => [ $CurrentNode ], current => 0 }; | |
| 21 } | |
| 22 | |
| 23 sub _initNavigator { | |
| 24 my ($this,$CurrentNode) = @_; | |
| 25 | |
| 238 | 26 die IMPL::InvalidArgumentException->new("A starting node is a required paramater") unless $CurrentNode; |
| 49 | 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) { | |
| 235 | 50 $current = $this->advanceNavigator or return; |
| 49 | 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 { | |
| 235 | 63 return; |
| 49 | 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 | |
| 235 | 106 $this->Back or return; # that meams the end of the history |
| 49 | 107 |
| 108 undef while ( $this->advanceNavigator and not $this->Navigate($query)); | |
| 109 | |
| 110 return $this->Current; | |
| 111 } | |
| 235 | 112 return; |
| 49 | 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 { | |
| 235 | 145 return; |
| 49 | 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 { |
| 194 | 158 my ($this) = @_; |
| 159 $this->{$_path} ? scalar @{$this->{$_path}} : 0; | |
|
104
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 { |
| 194 | 163 my ($this,$index) = @_; |
| 164 | |
| 165 if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) { | |
| 166 return $state->{alternatives}[$state->{current}] | |
| 167 } else { | |
| 235 | 168 return; |
| 194 | 169 } |
|
104
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(); | |
| 235 | 223 return; |
| 49 | 224 } else { |
| 225 $this->applyState(); | |
| 226 return $result; | |
| 227 } | |
| 228 } | |
| 229 | |
| 230 1; | |
| 231 | |
| 232 __END__ | |
| 233 =pod | |
| 234 | |
| 235 =head1 DESCRIPTION | |
| 236 | |
| 180 | 237 Объект для хождения по дереву DOM объектов. |
| 49 | 238 |
| 180 | 239 Результатом навигации является множество узлов (альтернатив). |
| 49 | 240 |
| 180 | 241 Состоянием навигатора является текущий набор узлов, позиция в данном наборе, |
| 242 а также запрос по которому были получены данные результаты. | |
| 49 | 243 |
| 180 | 244 Если при навигации указан путь сосящий из нескольких фильтров, то он разбивается |
| 245 этапы простой навигации по кадой из частей пути. На каждом элементарном этапе | |
| 246 навигации образуется ряд альтернатив, и при каждом следующем этапе навигации | |
| 247 альтернативы предыдущих этапов могут перебираться, до получения положительного | |
| 248 результата навигации, в противном случае навигация считается невозможной. | |
| 49 | 249 |
| 250 =head1 METHODS | |
| 251 | |
| 252 =over | |
| 253 | |
| 254 =item C<<$obj->new($nodeStart)>> | |
| 255 | |
| 180 | 256 Создает объект навигатора с указанной начальной позицией. |
| 49 | 257 |
| 258 =item C<<$obj->Navigate([$query,...])>> | |
| 259 | |
| 180 | 260 Перейти в новый узел используя запрос C<$query>. На данный момент запросом может |
| 261 быть только имя узла и будет взят только первый узел. Если по запросу ничего не | |
| 262 найдено, переход не будет осуществлен. | |
| 49 | 263 |
| 180 | 264 Возвращает либо новый узел в который перешли, либо C<undef>. |
| 49 | 265 |
| 266 =item C<<$obj->Back()>> | |
| 267 | |
| 180 | 268 Возвращается в предыдущий узел, если таковой есть. |
| 49 | 269 |
| 180 | 270 Возвращает либо узел в который перешли, либо C<undef>. |
| 49 | 271 |
| 272 =item C<<$obj->advanceNavigator()>> | |
| 273 | |
| 180 | 274 Переходит в следующую альтернативу, соответствующую текущему запросу. |
| 49 | 275 |
| 276 =back | |
| 277 | |
| 278 =cut |