Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Node.pm @ 122:a7efb3117295
Fixed bug in IMPL::DOM::Navigator::selectNodes
Fixed bug in IMPL::DOM::Node::selectNodes
renamed operator 'type' to 'typeof' in IMPL::Object::Abstract
A proper implementation of the IMPL::DOM::Node::nodeProperty and a related changes in the IMPL::DOM::Property module, now the last is very simple.
author | wizard |
---|---|
date | Tue, 08 Jun 2010 20:12:45 +0400 |
parents | 1722ca51537c |
children | e30bdd040fe3 |
rev | line source |
---|---|
49 | 1 package IMPL::DOM::Node; |
2 use strict; | |
3 use warnings; | |
4 | |
5 use base qw(IMPL::Object); | |
6 | |
7 use IMPL::Object::List; | |
8 use IMPL::Class::Property; | |
9 use IMPL::Class::Property::Direct; | |
10 use Scalar::Util qw(weaken); | |
11 | |
12 use IMPL::Exception; | |
13 | |
14 BEGIN { | |
15 public _direct property nodeName => prop_get; | |
16 public _direct property document => prop_get; | |
17 public _direct property isComplex => { get => \&_getIsComplex } ; | |
18 public _direct property nodeValue => prop_all; | |
102 | 19 public _direct property childNodes => { get => \&_getChildNodes }; # prop_list |
49 | 20 public _direct property parentNode => prop_get ; |
21 private _direct property _propertyMap => prop_all ; | |
116 | 22 |
23 __PACKAGE__->class_data(property_bind => {}); | |
49 | 24 } |
25 | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
26 our %Axes = ( |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
27 parent => \&selectParent, |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
28 siblings => \&selectSiblings, |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
29 child => \&childNodes, |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
30 document => \&selectDocument |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
31 ); |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
32 |
49 | 33 sub CTOR { |
34 my ($this,%args) = @_; | |
35 | |
36 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); | |
37 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; | |
38 if ( exists $args{document} ) { | |
39 $this->{$document} = delete $args{document}; | |
40 weaken($this->{$document}); | |
41 } | |
42 | |
43 $this->{$_propertyMap} = \%args; | |
44 } | |
45 | |
46 sub insertNode { | |
47 my ($this,$node,$pos) = @_; | |
48 | |
49 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
50 | |
51 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
52 | |
53 $this->childNodes->InsertAt($pos,$node); | |
54 | |
55 $node->_setParent( $this ); | |
56 | |
57 return $node; | |
58 } | |
59 | |
60 sub appendChild { | |
61 my ($this,$node) = @_; | |
62 | |
63 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
64 | |
65 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
66 | |
67 my $children = $this->childNodes; | |
68 $children->Append($node); | |
69 | |
70 $node->_setParent( $this ); | |
71 | |
72 return $node; | |
73 } | |
74 | |
75 sub appendNode { | |
76 goto &appendChild; | |
77 } | |
78 | |
79 sub appendRange { | |
80 my ($this,@range) = @_; | |
81 | |
82 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if grep $_ == $this, @range; | |
83 | |
84 foreach my $node (@range) { | |
85 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
86 $node->_setParent( $this ); | |
87 } | |
88 | |
89 $this->childNodes->Append(@range); | |
90 | |
91 return $this; | |
92 } | |
93 | |
94 sub _getChildNodes { | |
95 my ($this) = @_; | |
96 | |
97 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; | |
102 | 98 return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes}; |
49 | 99 } |
100 | |
109
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
101 sub childNodesRef { |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
102 my ($this) = @_; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
103 return scalar $this->_getChildNodes; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
104 } |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
105 |
49 | 106 sub removeNode { |
107 my ($this,$node) = @_; | |
108 | |
109 if ($this == $node->{$parentNode}) { | |
110 $this->childNodes->RemoveItem($node); | |
111 $node->_setParent(undef); | |
112 return $node; | |
113 } else { | |
114 die new IMPL::InvalidOperationException("The specified node isn't belong to this node"); | |
115 } | |
116 } | |
117 | |
118 sub replaceNodeAt { | |
119 my ($this,$index,$node) = @_; | |
120 | |
121 my $nodeOld = $this->childNodes->[$index]; | |
122 | |
123 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; | |
124 | |
125 # unlink node from previous parent | |
126 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); | |
127 | |
128 # replace (or set) old node | |
129 $this->childNodes->[$index] = $node; | |
130 | |
131 # set new parent | |
132 $node->_setParent( $this ); | |
133 | |
134 # unlink old node if we have one | |
135 $nodeOld->_setParent(undef) if $nodeOld; | |
136 | |
137 # return old node | |
138 return $nodeOld; | |
139 } | |
140 | |
141 sub removeAt { | |
142 my ($this,$pos) = @_; | |
143 | |
144 if ( my $node = $this->childNodes->RemoveAt($pos) ) { | |
145 $node->_setParent(undef); | |
146 return $node; | |
147 } else { | |
148 return undef; | |
149 } | |
150 } | |
151 | |
152 sub removeLast { | |
153 my ($this) = @_; | |
154 | |
155 if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) { | |
156 $node->_setParent(undef); | |
157 return $node; | |
158 } else { | |
159 return undef; | |
160 } | |
161 } | |
162 | |
163 sub removeSelected { | |
164 my ($this,$query) = @_; | |
165 | |
166 my @newSet; | |
167 my @result; | |
168 | |
169 if (ref $query eq 'CODE') { | |
170 &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
171 } elsif (defined $query) { | |
172 $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; | |
173 } else { | |
174 my $children = $this->childNodes; | |
175 $_->_setParent(undef) foreach @$children; | |
176 delete $this->{$childNodes}; | |
177 return wantarray ? @$children : $children; | |
178 } | |
179 | |
180 $_->_setParent(undef) foreach @result; | |
181 | |
182 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; | |
183 | |
184 return wantarray ? @result : \@result; | |
185 } | |
186 | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
187 sub resolveAxis { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
188 my ($this,$axis) = @_; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
189 return $Axes{$axis}->($this) |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
190 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
191 |
49 | 192 sub selectNodes { |
108 | 193 my $this = shift; |
122 | 194 my $path; |
108 | 195 |
122 | 196 if (@_ == 1) { |
197 $path = $this->translatePath($_[0]); | |
198 } else { | |
199 $path = [@_]; | |
200 } | |
108 | 201 |
202 my @set = ($this); | |
203 | |
122 | 204 while (@$path) { |
205 my $query = shift @$path; | |
108 | 206 @set = map $_->selectNodesAxis($query), @set; |
207 } | |
208 | |
209 return wantarray ? @set : \@set; | |
210 } | |
211 | |
113 | 212 sub selectSingleNode { |
213 my $this = shift; | |
214 my @result = $this->selectNodes(@_); | |
215 return $result[0]; | |
216 } | |
217 | |
109
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
218 sub selectNodesRef { |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
219 my $this = shift; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
220 |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
221 my @result = $this->selectNodes(@_); |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
222 return \@result; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
223 } |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
224 |
108 | 225 sub translatePath { |
226 my ($this,$path) = @_; | |
227 | |
228 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare | |
229 return [$path]; | |
230 } | |
231 | |
232 sub selectNodesAxis { | |
233 my ($this,$query,$axis) = @_; | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
234 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
235 $axis ||= 'child'; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
236 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
237 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis}; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
238 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
239 my $nodes = $this->resolveAxis($axis); |
49 | 240 |
241 my @result; | |
242 | |
243 if (ref $query eq 'CODE') { | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
244 @result = grep &$query($_), @{$nodes}; |
49 | 245 } elsif (ref $query eq 'ARRAY' ) { |
246 my %keys = map (($_,1),@$query); | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
247 @result = grep $keys{$_->nodeName}, @{$nodes}; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
248 } elsif (ref $query eq 'HASH') { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
249 while( my ($axis,$filter) = each %$query ) { |
108 | 250 push @result, $this->selectNodesAxis($filter,$axis); |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
251 } |
49 | 252 } elsif (defined $query) { |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
253 @result = grep $_->nodeName eq $query, @{$nodes}; |
49 | 254 } else { |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
255 return wantarray ? @{$nodes} : $nodes; |
49 | 256 } |
257 | |
258 return wantarray ? @result : \@result; | |
259 } | |
260 | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
261 sub selectParent { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
262 my ($this) = @_; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
263 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
264 if ($this->parentNode) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
265 return wantarray ? $this->parentNode : [$this->parentNode]; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
266 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
267 return wantarray ? () : []; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
268 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
269 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
270 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
271 sub selectSiblings { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
272 my ($this) = @_; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
273 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
274 if ($this->parentNode) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
275 return $this->parentNode->selectNodes( sub { $_ != $this } ); |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
276 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
277 return wantarray ? () : []; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
278 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
279 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
280 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
281 sub selectDocument { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
282 my ($this) = @_; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
283 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
284 if ($this->document) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
285 return wantarray ? $this->document : [$this->document]; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
286 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
287 return wantarray ? () : []; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
288 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
289 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
290 |
49 | 291 sub firstChild { |
292 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; | |
293 } | |
294 | |
295 sub _getIsComplex { | |
296 $_[0]->childNodes->Count ? 1 : 0; | |
297 } | |
298 | |
299 sub _updateDocRefs { | |
300 my ($this) = @_; | |
301 | |
302 # this method is called by the parent node on his children, so we need no to check parent | |
303 $this->{$document} = $this->{$parentNode}->document; | |
304 | |
305 # prevent cyclic | |
306 weaken($this->{$document}) if $this->{$document}; | |
307 | |
308 $_->_updateDocRefs foreach @{$this->{$childNodes}}; | |
309 } | |
310 | |
311 sub _setParent { | |
312 my ($this,$node) = @_; | |
313 | |
314 | |
315 if (($node || 0) != ($this->{$parentNode} || 0)) { | |
316 my $newOwner; | |
317 if ($node) { | |
318 $this->{$parentNode} = $node; | |
319 $newOwner = $node->document || 0; | |
320 | |
321 # prevent from creating cyclicreferences | |
322 weaken($this->{$parentNode}); | |
323 | |
324 } else { | |
325 delete $this->{$parentNode}; | |
75 | 326 |
327 #keep document | |
328 $newOwner = $this->{$document}; | |
49 | 329 } |
330 | |
331 if (($this->{$document}||0) != $newOwner) { | |
332 $this->{$document} = $newOwner; | |
333 weaken($this->{$document}) if $newOwner; | |
334 $_->_updateDocRefs foreach @{$this->childNodes}; | |
335 } | |
336 } | |
337 } | |
338 | |
339 sub text { | |
340 my ($this) = @_; | |
341 | |
342 join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes})); | |
343 } | |
344 | |
345 sub nodeProperty { | |
346 my $this = shift; | |
347 my $name = shift; | |
348 | |
122 | 349 if (my $method = $this->can($name)) { |
350 return &$method($this,@_); | |
351 } | |
352 | |
49 | 353 if (@_) { |
122 | 354 # set |
355 return $this->{$_propertyMap}{$name} = shift; | |
356 } else { | |
357 return $this->{$_propertyMap}{$name}; | |
49 | 358 } |
359 } | |
360 | |
122 | 361 sub listProperties { |
362 my ($this) = @_; | |
363 | |
364 my %props = map {$_->Name, 1} $this->get_meta(typeof IMPL::Class::PropertyInfo, sub { $_->Attributes->{domProperty}},1); | |
365 | |
366 return (keys %props,keys %{$this->{$_propertyMap}}); | |
367 } | |
368 | |
49 | 369 sub qname { |
370 $_[0]->{$nodeName}; | |
371 } | |
372 | |
373 sub path { | |
374 my ($this) = @_; | |
375 | |
376 if ($this->parentNode) { | |
377 return $this->parentNode->path.'.'.$this->qname; | |
378 } else { | |
379 return $this->qname; | |
380 } | |
381 } | |
382 | |
383 1; | |
75 | 384 |
385 __END__ | |
386 | |
387 =pod | |
388 | |
389 =head1 NAME | |
390 | |
391 C<IMPL::DOM::Node> Элемент DOM модели | |
392 | |
393 =head1 DESCRIPTION | |
394 | |
395 Базовый узел DOM модели. От него можно наследовать другие элементы DOM модели. | |
396 | |
397 =head1 MEMBERS | |
398 | |
399 =head2 PROPERTIES | |
400 | |
401 =over | |
402 | |
403 =item C<[get] nodeName> | |
404 | |
405 Имя узла. Задается при создании. | |
406 | |
407 =item C<[get] document> | |
408 | |
409 Документ к которому принадлежит узел. Задается при поздании узла. | |
410 | |
411 =item C<[get] isComplex> | |
412 | |
413 Определяет является ли узел сложным (тоесть есть ли дети). | |
414 | |
415 C<true> - есть, C<false> - нет. | |
416 | |
417 =item C<[get,set] nodeValue> | |
418 | |
419 Значение узла, обычно простой скаляр, но ничто не мешает туда | |
420 устанавливать любое значение. | |
421 | |
422 =item C<[get,list] childNodes> | |
423 | |
424 Список детей, является списокм C<IMPL::Object::List>. | |
425 | |
426 =item C<[get] parentNode> | |
427 | |
428 Ссылка на родительский элемент, если таковой имеется. | |
429 | |
430 =head2 METHODS | |
431 | |
432 =cut |