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