Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Navigator.pm @ 201:0c018a247c8a
Reworked REST resource classes to be more transparent and intuitive
| author | sergey |
|---|---|
| date | Tue, 24 Apr 2012 19:52:07 +0400 |
| parents | 4d0e1962161c |
| children | a4d9126edcbb |
| 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 | |
| 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 _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 | |
| 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) { | |
| 50 $current = $this->advanceNavigator or return undef; | |
| 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 { | |
| 63 return undef; | |
| 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 | |
| 106 $this->Back or return undef; # that meams the end of the history | |
| 107 | |
| 108 undef while ( $this->advanceNavigator and not $this->Navigate($query)); | |
| 109 | |
| 110 return $this->Current; | |
| 111 } | |
| 112 return undef; | |
| 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 { | |
| 145 return undef; | |
| 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 { | |
| 168 return undef; | |
| 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(); | |
| 223 return undef; | |
| 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 |