Mercurial > pub > Impl
comparison Lib/IMPL/DOM/Navigator.pm @ 24:7f00786f8210
Первая рабочая реазизация схемы и навигаторов
| author | Sergey |
|---|---|
| date | Mon, 05 Oct 2009 00:48:49 +0400 |
| parents | 818c74b038ae |
| children | a8086f85a571 |
comparison
equal
deleted
inserted
replaced
| 23:716b287d4795 | 24:7f00786f8210 |
|---|---|
| 4 | 4 |
| 5 use base qw(IMPL::Object); | 5 use base qw(IMPL::Object); |
| 6 use IMPL::Class::Property; | 6 use IMPL::Class::Property; |
| 7 use IMPL::Class::Property::Direct; | 7 use IMPL::Class::Property::Direct; |
| 8 BEGIN { | 8 BEGIN { |
| 9 public _direct property Path => prop_get | owner_set; | 9 private _direct property _path => prop_all; |
| 10 public _direct property Current => prop_get | owner_set; | 10 private _direct property _state => prop_all; |
| 11 private _direct property _savedstates => prop_all; | |
| 12 public property Current => {get => \&_getCurrent}; | |
| 11 } | 13 } |
| 12 | 14 |
| 13 sub CTOR { | 15 sub CTOR { |
| 14 my ($this,$CurrentNode) = @_; | 16 my ($this,$CurrentNode) = @_; |
| 15 | 17 |
| 16 $this->{$Current} = $CurrentNode or die IMPL::InvalidArgumentException("A starting node is a required paramater"); | 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}] | |
| 17 } | 25 } |
| 18 | 26 |
| 19 sub Navigate { | 27 sub Navigate { |
| 20 my ($this,$query) = @_; | 28 my ($this,@path) = @_; |
| 21 | 29 |
| 22 if ( my ($newNode) = $this->{$Current}->selectNodes($query) ) { | 30 return unless @path; |
| 23 push @{$this->{$Path}}, $this->{$Current}; | 31 |
| 24 return $this->{$Current} = $newNode; | 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); | |
| 68 } else { | |
| 69 return $node->selectNodes($query); | |
| 70 } | |
| 71 } | |
| 72 | |
| 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; | |
| 92 } | |
| 93 | |
| 94 sub advanceNavigator { | |
| 95 my ($this) = @_; | |
| 96 | |
| 97 $this->{$_state}{current}++; | |
| 98 | |
| 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); | |
| 126 } | |
| 127 | |
| 128 sub Back { | |
| 129 my ($this,$steps) = @_; | |
| 130 | |
| 131 $steps ||= 1; | |
| 132 | |
| 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; | |
| 25 } else { | 140 } else { |
| 26 return undef; | 141 return undef; |
| 27 } | 142 } |
| 28 } | 143 } |
| 29 | 144 |
| 30 sub _NavigateNode { | 145 sub PathToString { |
| 31 my ($this,$newNode) = @_; | 146 my ($this,$delim) = @_; |
| 32 push @{$this->{$Path}}, $this->{$Current}; | 147 |
| 33 return $this->{$Current} = $newNode; | 148 $delim ||= '/'; |
| 34 } | 149 |
| 35 | 150 join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state}); |
| 36 sub _NavigateNodeStirct { | 151 } |
| 37 my ($this,$newNode) = @_; | 152 |
| 38 | 153 sub clone { |
| 39 die new IMPL::InvalidOperationException("A newNode doesn't belongs to the current") unless $newNode->parentNode == $this->{$Current}; | 154 my ($this) = @_; |
| 40 push @{$this->{$Path}}, $this->{$Current}; | 155 |
| 41 return $this->{$Current} = $newNode; | 156 my $newNavi = __PACKAGE__->surrogate; |
| 42 } | 157 |
| 43 | 158 $newNavi->{$_path} = [ map { { %{ $_ } } } @{$this->{$_path}} ] if $this->{$_path}; |
| 44 sub Back { | 159 $newNavi->{$_state} = { %{$this->{$_state}} }; |
| 45 my ($this) = @_; | 160 |
| 46 | 161 return $newNavi; |
| 47 if ( my $newNode = $this->{$Path} ? pop @{$this->{$Path}} : undef ) { | 162 |
| 48 return $this->{$Current} = $newNode; | 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}} }; | |
| 172 | |
| 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; | |
| 49 } else { | 205 } else { |
| 50 return undef; | 206 $this->applyState(); |
| 51 } | 207 return $result; |
| 52 } | 208 } |
| 53 | |
| 54 sub PathToString { | |
| 55 my $this = shift; | |
| 56 | |
| 57 join('/',map $_->nodeName, $this->{$Path} ? (@{$this->{$Path}}, $this->{$Current}) : $this->{$Current}); | |
| 58 } | 209 } |
| 59 | 210 |
| 60 1; | 211 1; |
| 61 | 212 |
| 62 __END__ | 213 __END__ |
| 64 | 215 |
| 65 =head1 DESCRIPTION | 216 =head1 DESCRIPTION |
| 66 | 217 |
| 67 DOM . | 218 DOM . |
| 68 | 219 |
| 220 (). | |
| 221 | |
| 222 , , | |
| 223 . | |
| 224 | |
| 69 =head1 METHODS | 225 =head1 METHODS |
| 70 | 226 |
| 71 =over | 227 =over |
| 72 | 228 |
| 73 =item C<$obj->new($nodeStart)> | 229 =item C<$obj->new($nodeStart)> |
| 74 | 230 |
| 75 . | 231 . |
| 76 | 232 |
| 77 =item C<$obj->Navigate($query)> | 233 =item C<$obj->Navigate([$query,...])> |
| 78 | 234 |
| 79 C<$query>. | 235 C<$query>. |
| 80 . | 236 . |
| 81 , . | 237 , . |
| 82 | 238 |
