Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Node.pm @ 116:1722ca51537c
minor changes.
Auth no more throws an exception when fails
author | wizard |
---|---|
date | Mon, 31 May 2010 08:30:39 +0400 |
parents | 7b14e0122b79 |
children | a7efb3117295 |
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; |
194 my ($path) = @_; | |
195 | |
196 $path = ref $path eq 'ARRAY' ? $path : ( @_ == 1 ? $this->translatePath($path) : [@_]); | |
197 | |
198 my @set = ($this); | |
199 | |
200 while (my $query = shift @$path) { | |
201 @set = map $_->selectNodesAxis($query), @set; | |
202 } | |
203 | |
204 return wantarray ? @set : \@set; | |
205 } | |
206 | |
113 | 207 sub selectSingleNode { |
208 my $this = shift; | |
209 my @result = $this->selectNodes(@_); | |
210 return $result[0]; | |
211 } | |
212 | |
109
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
213 sub selectNodesRef { |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
214 my $this = shift; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
215 |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
216 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
|
217 return \@result; |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
218 } |
ddf0f037d460
IMPL::DOM::Node updated to support TT, (added childNodesRef and selectNodesRef for using from TT)
wizard
parents:
108
diff
changeset
|
219 |
108 | 220 sub translatePath { |
221 my ($this,$path) = @_; | |
222 | |
223 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare | |
224 return [$path]; | |
225 } | |
226 | |
227 sub selectNodesAxis { | |
228 my ($this,$query,$axis) = @_; | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
229 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
230 $axis ||= 'child'; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
231 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
232 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
|
233 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
234 my $nodes = $this->resolveAxis($axis); |
49 | 235 |
236 my @result; | |
237 | |
238 if (ref $query eq 'CODE') { | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
239 @result = grep &$query($_), @{$nodes}; |
49 | 240 } elsif (ref $query eq 'ARRAY' ) { |
241 my %keys = map (($_,1),@$query); | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
242 @result = grep $keys{$_->nodeName}, @{$nodes}; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
243 } elsif (ref $query eq 'HASH') { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
244 while( my ($axis,$filter) = each %$query ) { |
108 | 245 push @result, $this->selectNodesAxis($filter,$axis); |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
246 } |
49 | 247 } elsif (defined $query) { |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
248 @result = grep $_->nodeName eq $query, @{$nodes}; |
49 | 249 } else { |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
250 return wantarray ? @{$nodes} : $nodes; |
49 | 251 } |
252 | |
253 return wantarray ? @result : \@result; | |
254 } | |
255 | |
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
256 sub selectParent { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
257 my ($this) = @_; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
258 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
259 if ($this->parentNode) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
260 return wantarray ? $this->parentNode : [$this->parentNode]; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
261 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
262 return wantarray ? () : []; |
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 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
265 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
266 sub selectSiblings { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
267 my ($this) = @_; |
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 if ($this->parentNode) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
270 return $this->parentNode->selectNodes( sub { $_ != $this } ); |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
271 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
272 return wantarray ? () : []; |
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 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
275 |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
276 sub selectDocument { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
277 my ($this) = @_; |
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 if ($this->document) { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
280 return wantarray ? $this->document : [$this->document]; |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
281 } else { |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
282 return wantarray ? () : []; |
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 } |
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
102
diff
changeset
|
285 |
49 | 286 sub firstChild { |
287 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; | |
288 } | |
289 | |
290 sub _getIsComplex { | |
291 $_[0]->childNodes->Count ? 1 : 0; | |
292 } | |
293 | |
294 sub _updateDocRefs { | |
295 my ($this) = @_; | |
296 | |
297 # this method is called by the parent node on his children, so we need no to check parent | |
298 $this->{$document} = $this->{$parentNode}->document; | |
299 | |
300 # prevent cyclic | |
301 weaken($this->{$document}) if $this->{$document}; | |
302 | |
303 $_->_updateDocRefs foreach @{$this->{$childNodes}}; | |
304 } | |
305 | |
306 sub _setParent { | |
307 my ($this,$node) = @_; | |
308 | |
309 | |
310 if (($node || 0) != ($this->{$parentNode} || 0)) { | |
311 my $newOwner; | |
312 if ($node) { | |
313 $this->{$parentNode} = $node; | |
314 $newOwner = $node->document || 0; | |
315 | |
316 # prevent from creating cyclicreferences | |
317 weaken($this->{$parentNode}); | |
318 | |
319 } else { | |
320 delete $this->{$parentNode}; | |
75 | 321 |
322 #keep document | |
323 $newOwner = $this->{$document}; | |
49 | 324 } |
325 | |
326 if (($this->{$document}||0) != $newOwner) { | |
327 $this->{$document} = $newOwner; | |
328 weaken($this->{$document}) if $newOwner; | |
329 $_->_updateDocRefs foreach @{$this->childNodes}; | |
330 } | |
331 } | |
332 } | |
333 | |
334 sub text { | |
335 my ($this) = @_; | |
336 | |
337 join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes})); | |
338 } | |
339 | |
340 sub nodeProperty { | |
341 my $this = shift; | |
342 my $name = shift; | |
343 | |
344 if (@_) { | |
345 # set | |
346 return $this->{$_propertyMap}{$name} = shift; | |
347 } else { | |
348 return $this->{$_propertyMap}{$name}; | |
349 } | |
350 } | |
351 | |
352 sub qname { | |
353 $_[0]->{$nodeName}; | |
354 } | |
355 | |
356 sub path { | |
357 my ($this) = @_; | |
358 | |
359 if ($this->parentNode) { | |
360 return $this->parentNode->path.'.'.$this->qname; | |
361 } else { | |
362 return $this->qname; | |
363 } | |
364 } | |
365 | |
366 1; | |
75 | 367 |
368 __END__ | |
369 | |
370 =pod | |
371 | |
372 =head1 NAME | |
373 | |
374 C<IMPL::DOM::Node> Элемент DOM модели | |
375 | |
376 =head1 DESCRIPTION | |
377 | |
378 Базовый узел DOM модели. От него можно наследовать другие элементы DOM модели. | |
379 | |
380 =head1 MEMBERS | |
381 | |
382 =head2 PROPERTIES | |
383 | |
384 =over | |
385 | |
386 =item C<[get] nodeName> | |
387 | |
388 Имя узла. Задается при создании. | |
389 | |
390 =item C<[get] document> | |
391 | |
392 Документ к которому принадлежит узел. Задается при поздании узла. | |
393 | |
394 =item C<[get] isComplex> | |
395 | |
396 Определяет является ли узел сложным (тоесть есть ли дети). | |
397 | |
398 C<true> - есть, C<false> - нет. | |
399 | |
400 =item C<[get,set] nodeValue> | |
401 | |
402 Значение узла, обычно простой скаляр, но ничто не мешает туда | |
403 устанавливать любое значение. | |
404 | |
405 =item C<[get,list] childNodes> | |
406 | |
407 Список детей, является списокм C<IMPL::Object::List>. | |
408 | |
409 =item C<[get] parentNode> | |
410 | |
411 Ссылка на родительский элемент, если таковой имеется. | |
412 | |
413 =head2 METHODS | |
414 | |
415 =cut |