Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Navigator.pm @ 388:648dfaf642e0
DOM refactoring,
removed inflators from DOM Schema,
DOM validation - in progress
| author | cin |
|---|---|
| date | Tue, 11 Feb 2014 20:22:01 +0400 |
| parents | 010ceafd0c5a |
| children |
| 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) = @_; | |
| 368 | 132 |
| 49 | 133 if ($this->{$_path} and @{$this->{$_path}}) { |
| 368 | 134 if ( (not defined $steps) || $steps == 1) { |
| 49 | 135 $this->{$_state} = pop @{$this->{$_path}}; |
| 368 | 136 } elsif ($steps > 0) { |
| 49 | 137 $steps = @{$this->{$_path}} - 1 if $steps >= @{$this->{$_path}}; |
| 138 | |
| 139 $this->{$_state} = (splice @{$this->{$_path}},-$steps)[0]; | |
| 140 } | |
| 141 $this->Current if defined wantarray; | |
| 142 } else { | |
| 235 | 143 return; |
| 49 | 144 } |
| 145 } | |
| 146 | |
| 147 sub PathToString { | |
| 148 my ($this,$delim) = @_; | |
| 149 | |
| 150 $delim ||= '/'; | |
| 151 | |
| 152 join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state}); | |
| 153 } | |
| 154 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
155 sub pathLength { |
| 194 | 156 my ($this) = @_; |
| 157 $this->{$_path} ? scalar @{$this->{$_path}} : 0; | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
158 } |
|
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 sub GetNodeFromHistory { |
| 194 | 161 my ($this,$index) = @_; |
| 162 | |
| 163 if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) { | |
| 164 return $state->{alternatives}[$state->{current}] | |
| 165 } else { | |
| 235 | 166 return; |
| 194 | 167 } |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
168 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
169 |
| 49 | 170 sub clone { |
| 171 my ($this) = @_; | |
| 172 | |
| 173 my $newNavi = __PACKAGE__->surrogate; | |
| 174 | |
| 175 $newNavi->{$_path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; | |
| 176 $newNavi->{$_state} = { %{$this->{$_state}} }; | |
| 177 | |
| 178 return $newNavi; | |
| 179 | |
| 180 } | |
| 181 | |
| 182 sub saveState { | |
| 183 my ($this) = @_; | |
| 184 | |
| 185 my %state; | |
| 186 | |
| 187 $state{path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; | |
| 188 $state{state} = { %{$this->{$_state}} }; | |
| 189 | |
| 190 push @{$this->{$_savedstates}}, \%state; | |
| 191 } | |
| 192 | |
| 193 sub restoreState { | |
| 194 my ($this) = @_; | |
| 195 | |
| 196 if ( my $state = pop @{$this->{$_savedstates}||[]} ) { | |
| 197 $this->{$_path} = $state->{path}; | |
| 198 $this->{$_state} = $state->{state}; | |
| 199 } | |
| 200 } | |
| 201 | |
| 202 sub applyState { | |
| 203 my ($this) = @_; | |
| 204 | |
| 205 pop @{$this->{$_savedstates}||[]}; | |
| 206 } | |
| 207 | |
| 208 sub dosafe { | |
| 209 my ($this,$transaction) = @_; | |
| 210 | |
| 211 $this->saveState(); | |
| 212 | |
| 213 my $result; | |
| 214 | |
| 215 eval { | |
| 216 $result = $transaction->(); | |
| 217 }; | |
| 218 | |
| 219 if ($@) { | |
| 220 $this->restoreState(); | |
| 235 | 221 return; |
| 49 | 222 } else { |
| 223 $this->applyState(); | |
| 224 return $result; | |
| 225 } | |
| 226 } | |
| 227 | |
| 228 1; | |
| 229 | |
| 230 __END__ | |
| 231 =pod | |
| 232 | |
| 233 =head1 DESCRIPTION | |
| 234 | |
| 180 | 235 Объект для хождения по дереву DOM объектов. |
| 49 | 236 |
| 180 | 237 Результатом навигации является множество узлов (альтернатив). |
| 49 | 238 |
| 180 | 239 Состоянием навигатора является текущий набор узлов, позиция в данном наборе, |
| 240 а также запрос по которому были получены данные результаты. | |
| 49 | 241 |
| 180 | 242 Если при навигации указан путь сосящий из нескольких фильтров, то он разбивается |
| 243 этапы простой навигации по кадой из частей пути. На каждом элементарном этапе | |
| 244 навигации образуется ряд альтернатив, и при каждом следующем этапе навигации | |
| 245 альтернативы предыдущих этапов могут перебираться, до получения положительного | |
| 246 результата навигации, в противном случае навигация считается невозможной. | |
| 49 | 247 |
| 248 =head1 METHODS | |
| 249 | |
| 250 =over | |
| 251 | |
| 252 =item C<<$obj->new($nodeStart)>> | |
| 253 | |
| 180 | 254 Создает объект навигатора с указанной начальной позицией. |
| 49 | 255 |
| 256 =item C<<$obj->Navigate([$query,...])>> | |
| 257 | |
| 180 | 258 Перейти в новый узел используя запрос C<$query>. На данный момент запросом может |
| 259 быть только имя узла и будет взят только первый узел. Если по запросу ничего не | |
| 260 найдено, переход не будет осуществлен. | |
| 49 | 261 |
| 180 | 262 Возвращает либо новый узел в который перешли, либо C<undef>. |
| 49 | 263 |
| 264 =item C<<$obj->Back()>> | |
| 265 | |
| 180 | 266 Возвращается в предыдущий узел, если таковой есть. |
| 49 | 267 |
| 180 | 268 Возвращает либо узел в который перешли, либо C<undef>. |
| 49 | 269 |
| 270 =item C<<$obj->advanceNavigator()>> | |
| 271 | |
| 180 | 272 Переходит в следующую альтернативу, соответствующую текущему запросу. |
| 49 | 273 |
| 274 =back | |
| 275 | |
| 276 =cut |