Mercurial > pub > Impl

comparison lib/IMPL/DOM/Node.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::DOM::Node;
2 use strict;
3 use warnings;
4
5 use Scalar::Util qw(weaken);
6
7 use IMPL::lang;
8 use IMPL::Object::List;
9
10 use IMPL::Exception();
11 use IMPL::Const qw(:prop);
12 use IMPL::declare {
13 require => {
14 PropertyInfo => '-IMPL::Class::PropertyInfo'
15 },
16 base => [
17 'IMPL::Object' => undef
18 ],
19 props => [
20 nodeName => PROP_RO | PROP_DIRECT,
21 document => PROP_RO | PROP_DIRECT,
22 isComplex => { get => \&_getIsComplex },
23 nodeValue => PROP_RW | PROP_DIRECT,
24 childNodes => { get => \&_getChildNodes, isList => 1, direct => 1 },
25 parentNode => PROP_RO | PROP_DIRECT,
26 schemaNode => PROP_RO | PROP_DIRECT,
27 schemaType => PROP_RO | PROP_DIRECT,
28 _propertyMap => PROP_RW | PROP_DIRECT
29 ]
30 };
31
32 our %Axes = (
33 parent => \&selectParent,
34 siblings => \&selectSiblings,
35 child => \&childNodes,
36 document => \&selectDocument,
37 ancestor => \&selectAncestors,
38 descendant => \&selectDescendant
39 );
40
41 sub CTOR {
42 my ($this,%args) = @_;
43
44 $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required");
45 $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue};
46 if ( exists $args{document} ) {
47 $this->{$document} = delete $args{document};
48 weaken($this->{$document});
49 }
50
51 while ( my ($key,$value) = each %args ) {
52 $this->nodeProperty($key,$value);
53 }
54 }
55
56 sub insertNode {
57 my ($this,$node,$pos) = @_;
58
59 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node;
60
61 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode});
62
63 $this->childNodes->InsertAt($pos,$node);
64
65 $node->_setParent( $this );
66
67 return $node;
68 }
69
70 sub appendChild {
71 my ($this,$node) = @_;
72
73 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node;
74
75 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode});
76
77 my $children = $this->childNodes;
78 $children->Push($node);
79
80 $node->_setParent( $this );
81
82 return $node;
83 }
84
85 sub appendNode {
86 goto &appendChild;
87 }
88
89 sub appendRange {
90 my ($this,@range) = @_;
91
92 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if grep $_ == $this, @range;
93
94 foreach my $node (@range) {
95 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode});
96 $node->_setParent( $this );
97 }
98
99 $this->childNodes->Push(@range);
100
101 return $this;
102 }
103
104 sub _getChildNodes {
105 my ($this) = @_;
106
107 $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes};
108 return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes};
109 }
110
111 sub childNodesRef {
112 my ($this) = @_;
113 return scalar $this->_getChildNodes;
114 }
115
116 sub removeNode {
117 my ($this,$node) = @_;
118
119 if ($this == $node->{$parentNode}) {
120 $this->childNodes->RemoveItem($node);
121 $node->_setParent(undef);
122 return $node;
123 } else {
124 die new IMPL::InvalidOperationException("The specified node isn't belong to this node");
125 }
126 }
127
128 sub replaceNodeAt {
129 my ($this,$index,$node) = @_;
130
131 my $nodeOld = $this->childNodes->[$index];
132
133 die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node;
134
135 # unlink node from previous parent
136 $node->{$parentNode}->removeNode($node) if ($node->{$parentNode});
137
138 # replace (or set) old node
139 $this->childNodes->[$index] = $node;
140
141 # set new parent
142 $node->_setParent( $this );
143
144 # unlink old node if we have one
145 $nodeOld->_setParent(undef) if $nodeOld;
146
147 # return old node
148 return $nodeOld;
149 }
150
151 sub removeAt {
152 my ($this,$pos) = @_;
153
154 if ( my $node = $this->childNodes->RemoveAt($pos) ) {
155 $node->_setParent(undef);
156 return $node;
157 } else {
158 return undef;
159 }
160 }
161
162 sub removeLast {
163 my ($this) = @_;
164
165 if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) {
166 $node->_setParent(undef);
167 return $node;
168 } else {
169 return undef;
170 }
171 }
172
173 sub removeSelected {
174 my ($this,$query) = @_;
175
176 my @newSet;
177 my @result;
178
179 if (ref $query eq 'CODE') {
180 &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes};
181 } elsif (defined $query) {
182 $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes};
183 } else {
184 my $children = $this->childNodes;
185 $_->_setParent(undef) foreach @$children;
186 delete $this->{$childNodes};
187 return wantarray ? @$children : $children;
188 }
189
190 $_->_setParent(undef) foreach @result;
191
192 $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef;
193
194 return wantarray ? @result : \@result;
195 }
196
197 sub resolveAxis {
198 my ($this,$axis) = @_;
199 return $Axes{$axis}->($this)
200 }
201
202 sub selectNodes {
203 my $this = shift;
204 my $path;
205
206 if (@_ == 1) {
207 $path = $this->translatePath($_[0]);
208 } else {
209 $path = [@_];
210 }
211
212 my @set = ($this);
213
214 while (@$path) {
215 my $query = shift @$path;
216 @set = map $_->selectNodesAxis($query), @set;
217 }
218
219 return wantarray ? @set : \@set;
220 }
221
222 sub selectSingleNode {
223 my $this = shift;
224 my @result = $this->selectNodes(@_);
225 return $result[0];
226 }
227
228 sub selectNodesRef {
229 my $this = shift;
230
231 my @result = $this->selectNodes(@_);
232 return \@result;
233 }
234
235 sub translatePath {
236 my ($this,$path) = @_;
237
238 # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare
239 return [$path];
240 }
241
242 sub selectNodesAxis {
243 my ($this,$query,$axis) = @_;
244
245 $axis ||= 'child';
246
247 die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis};
248
249 my $nodes = $this->resolveAxis($axis);
250
251 my @result;
252
253 if (ref $query eq 'CODE') {
254 @result = grep &$query($_), @{$nodes};
255 } elsif (ref $query eq 'ARRAY' ) {
256 my %keys = map (($_,1),@$query);
257 @result = grep $keys{$_->nodeName}, @{$nodes};
258 } elsif (ref $query eq 'HASH') {
259 while( my ($axis,$filter) = each %$query ) {
260 push @result, $this->selectNodesAxis($filter,$axis);
261 }
262 } elsif (defined $query) {
263 @result = grep $_->nodeName eq $query, @{$nodes};
264 } else {
265 return wantarray ? @{$nodes} : $nodes;
266 }
267
268 return wantarray ? @result : \@result;
269 }
270
271 sub selectParent {
272 my ($this) = @_;
273
274 if ($this->parentNode) {
275 return wantarray ? $this->parentNode : [$this->parentNode];
276 } else {
277 return wantarray ? () : [];
278 }
279 }
280
281 sub selectSiblings {
282 my ($this) = @_;
283
284 if ($this->parentNode) {
285 return $this->parentNode->selectNodes( sub { $_ != $this } );
286 } else {
287 return wantarray ? () : [];
288 }
289 }
290
291 sub selectDocument {
292 my ($this) = @_;
293
294 if ($this->document) {
295 return wantarray ? $this->document : [$this->document];
296 } else {
297 return wantarray ? () : [];
298 }
299 }
300
301 sub selectDescendant {
302 wantarray ?
303 map $_->selectAll(), $_[0]->childNodes :
304 [map $_->selectAll(), $_[0]->childNodes]
305 }
306
307 sub selectAll {
308 map(selectAll($_),@{$_[0]->childNodes}) , $_[0]
309 }
310
311 sub selectAncestors {
312 my $parent = $_[0]->parentNode;
313
314 wantarray ?
315 ($parent ? ($parent->selectAncestors,$parent) : ()) :
316 [$parent ? ($parent->selectAncestors,$parent) : ()]
317 }
318
319 sub firstChild {
320 @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0];
321 }
322
323 sub _getIsComplex {
324 ($_[0]->{$childNodes} and $_[0]->{$childNodes}->Count) ? 1 : 0;
325 }
326
327 sub _updateDocRefs {
328 my ($this) = @_;
329
330 # this method is called by the parent node on his children, so we need no to check parent
331 $this->{$document} = $this->{$parentNode}->document;
332
333 # prevent cyclic
334 weaken($this->{$document}) if $this->{$document};
335
336 map $_->_updateDocRefs, @{$this->{$childNodes}} if $this->{$childNodes};
337 }
338
339 sub _setParent {
340 my ($this,$node) = @_;
341
342
343 if (($node || 0) != ($this->{$parentNode} || 0)) {
344 my $newOwner;
345 if ($node) {
346 $this->{$parentNode} = $node;
347 $newOwner = $node->document || 0;
348
349 # prevent from creating cyclicreferences
350 weaken($this->{$parentNode});
351
352 } else {
353 delete $this->{$parentNode};
354
355 #keep document
356 $newOwner = $this->{$document};
357 }
358
359 if (($this->{$document}||0) != $newOwner) {
360 $this->{$document} = $newOwner;
361 weaken($this->{$document}) if $newOwner;
362 $_->_updateDocRefs foreach @{$this->childNodes};
363 }
364 }
365 }
366
367 sub text {
368 my ($this) = @_;
369
370 join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes}));
371 }
372
373 sub nodeProperty {
374 my $this = shift;
375 my $name = shift;
376
377 return unless defined $name;
378
379 if (my $method = $this->can($name)) {
380 unshift @_,$this;
381 # use goto to preserve calling context
382 goto &$method;
383 }
384 # dynamic property
385 if (@_) {
386 # set
387 return $this->{$_propertyMap}{$name} = shift;
388 } else {
389 return $this->{$_propertyMap}{$name};
390 }
391 }
392
393 sub listProperties {
394 my ($this) = @_;
395
396 my %props = map {$_->name, 1} $this->GetMeta(PropertyInfo, sub { $_->attributes->{dom} },1);
397
398 return (keys %props,keys %{$this->{$_propertyMap}});
399 }
400
401 sub save {
402 my ($this,$writer) = @_;
403
404 if ( not ( $this->isComplex or defined $this->{$nodeValue} ) ) {
405 $writer->emptyTag(
406 $this->{$nodeName},
407 map {
408 $_,
409 $this->nodeProperty($_)
410 } grep defined $this->nodeProperty($_), $this->listProperties
411 );
412 } else {
413 $writer->startTag(
414 $this->{$nodeName},
415 map {
416 $_,
417 $this->nodeProperty($_)
418 } grep defined $this->nodeProperty($_), $this->listProperties
419 );
420 $writer->characters($this->{$nodeValue}) if $this->{$nodeValue};
421
422 $_->save($writer) foreach $this->childNodes;
423
424 $writer->endTag($this->{$nodeName});
425 }
426 }
427
428 sub qname {
429 $_[0]->{$nodeName};
430 }
431
432 sub path {
433 my ($this) = @_;
434
435 if ($this->parentNode) {
436 return $this->parentNode->path.'.'.$this->qname;
437 } else {
438 return $this->qname;
439 }
440 }
441
442 1;
443
444 __END__
445
446 =pod
447
448 =head1 NAME
449
450 C<IMPL::DOM::Node> Элемент DOM модели
451
452 =head1 DESCRIPTION
453
454 Базовый узел DOM модели. От него можно наследовать другие элементы DOM модели.
455
456 =head1 MEMBERS
457
458 =head2 PROPERTIES
459
460 =over
461
462 =item C<[get] nodeName>
463
464 Имя узла. Задается при создании.
465
466 =item C<[get] document>
467
468 Документ к которому принадлежит узел. Задается при поздании узла.
469
470 =item C<[get] isComplex>
471
472 Определяет является ли узел сложным (тоесть есть ли дети).
473
474 C<true> - есть, C<false> - нет.
475
476 =item C<[get,set] nodeValue>
477
478 Значение узла, обычно простой скаляр, но ничто не мешает туда
479 устанавливать любое значение.
480
481 =item C<[get,list] childNodes>
482
483 Список детей, является списокм C<IMPL::Object::List>.
484
485 =item C<[get] parentNode>
486
487 Ссылка на родительский элемент, если таковой имеется.
488
489 =item C<[get] schemaType>
490
491 Ссылка на узел из C<IMPL::DOM::Schema>, представляющий схему данных текущего узла. Может быть C<undef>.
492
493 =item C<[get] schemaNode>
494
495 Ссылка на узел из C<IMPL::DOM::Schema>, представляющий элемент схемы, объявляющий данный узел. Может быть C<undef>.
496
497 Отличается от свойства C<schemaType> тем, что узел в случае ссылки на тип узла, данной свойство будет содержать
498 описание ссылки C<IMPL::DOM::Schema::Node>, а свойство C<schema> например будет ссылаться на
499 C<IMPL::DOM::Schema::ComplexType>.
500
501 =back
502
503 =head2 METHODS
504
505 =cut