Mercurial > pub > Impl
view Lib/IMPL/DOM/Node.pm @ 25:9dd67fa91ee3
small fix in the dom schema
works under text schema
author | Sergey |
---|---|
date | Tue, 13 Oct 2009 17:51:25 +0400 |
parents | 7f00786f8210 |
children | dd4d72600c69 |
line wrap: on
line source
package IMPL::DOM::Node; use strict; use warnings; use base qw(IMPL::Object); use IMPL::Object::List; use IMPL::Class::Property; use IMPL::Class::Property::Direct; use Scalar::Util qw(weaken); use IMPL::Exception; BEGIN { public _direct property nodeName => prop_get | owner_set; public _direct property isComplex => { get => \&_getIsComplex } ; public _direct property nodeValue => prop_all; public _direct property childNodes => { get => \&_getChildNodes }; public _direct property parentNode => prop_get ; public _direct property rootNode => { get => \&_getRootNode}; private _direct property _propertyMap => prop_all ; } sub CTOR { my ($this,%args) = @_; $this->nodeName($args{nodeName}) or die new IMPL::InvalidArgumentException("A name is required"); $this->nodeValue($args{nodeValue}); } sub insertNode { my ($this,$node,$pos) = @_; die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); $this->childNodes->InsertAt($pos,$node); $node->_setParent( $this ); return $node; } sub appendNode { my ($this,$node) = @_; die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); my $children = $this->childNodes; $children->Append($node); $node->_setParent( $this ); return $node; } sub appendRange { my ($this,@range) = @_; die new IMPL::InvalidOperationException("You can't insert the node to itselft") if grep $_ == $this, @range; foreach my $node (@range) { $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); $node->_setParent( $this ); } $this->childNodes->Append(@range); return $this; } sub _getChildNodes { my ($this) = @_; $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes}; return $this->{$childNodes}; } sub removeNode { my ($this,$node) = @_; if ($this == $node->{$parentNode}) { $this->childNodes->RemoveItem($node); $node->_setParent(undef); return $node; } else { die new IMPL::InvalidOperationException("The specified node isn't belong to this node"); } } sub replaceNodeAt { my ($this,$index,$node) = @_; my $nodeOld = $this->childNodes->[$index]; die new IMPL::InvalidOperationException("You can't insert the node to itselft") if $this == $node; # unlink node from previous parent $node->{$parentNode}->removeNode($node) if ($node->{$parentNode}); # replace (or set) old node $this->childNodes->[$index] = $node; # set new parent $node->_setParent( $this ); # unlink old node if we have one $nodeOld->_setParent(undef) if $nodeOld; # return old node return $nodeOld; } sub removeAt { my ($this,$pos) = @_; if ( my $node = $this->childNodes->RemoveAt($pos) ) { $node->_setParent(undef); return $node; } else { return undef; } } sub removeLast { my ($this) = @_; if ( my $node = $this->{$childNodes} ? $this->{$childNodes}->RemoveLast() : undef) { $node->_setParent(undef); return $node; } else { return undef; } } sub removeSelected { my ($this,$query) = @_; my @newSet; my @result; if (ref $query eq 'CODE') { &$query($_) ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; } elsif (defined $query) { $_->nodeName eq $query ? push @result, $_ : push @newSet, $_ foreach @{$this->childNodes}; } else { my $children = $this->childNodes; $_->_setParent(undef) foreach @$children; delete $this->{$childNodes}; return wantarray ? @$children : $children; } $_->_setParent(undef) foreach @result; $this->{$childNodes} = @newSet ? bless \@newSet ,'IMPL::Object::List' : undef; return wantarray ? @result : \@result; } sub selectNodes { my ($this,$query) = @_; my @result; if (ref $query eq 'CODE') { @result = grep &$query($_), @{$this->childNodes}; } elsif (ref $query eq 'ARRAY' ) { my %keys = map (($_,1),@$query); @result = grep $keys{$_->nodeName}, @{$this->childNodes}; } elsif (defined $query) { @result = grep $_->nodeName eq $query, @{$this->childNodes}; } else { if (wantarray) { return @{$this->childNodes}; } else { @result = $this->childNodes; return \@result; } } return wantarray ? @result : \@result; } sub firstChild { @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; } sub _getIsComplex { $_[0]->childNodes->Count ? 1 : 0; } sub _getRootNode { $_[0]->{$rootNode} || $_[0]; } sub _updateRootRefs { my ($this) = @_; if ( my $newRoot = $this->{$parentNode} ? $this->{$parentNode}->rootNode : undef) { if ($this->{$rootNode} ? $this->{$rootNode} != $newRoot : 1 ) { $this->{$rootNode} = $newRoot; weaken($this->{$rootNode}); if ($this->{$childNodes}) { $_->_updateRootRefs foreach @{$this->{$childNodes}}; } } } elsif($this->{$rootNode}) { delete $this->{$rootNode}; if ($this->{$childNodes}) { $_->_updateRootRefs foreach @{$this->{$childNodes}}; } } } sub _setParent { my ($this,$node) = @_; if (($node || 0) != ($this->{$parentNode} || 0)) { if ($node) { $this->{$parentNode} = $node; # prevent from creating cyclicreferences weaken($this->{$parentNode}); } else { delete $this->{$parentNode}; } $this->_updateRootRefs; } } sub text { my ($this) = @_; join '', $this->nodeValue || '', map $_->nodeValue || '', @{$this->childNodes}; } sub nodeProperty { my $this = shift; my $name = shift; if (@_) { # set return $this->{$_propertyMap}{$name} = shift; } else { return $this->{$_propertyMap}{$name}; } } sub qname { $_[0]->{$nodeName}; } sub path { my ($this) = @_; if ($this->parentNode) { return $this->parentNode->path.'.'.$this->qname; } else { return $this->qname; } } 1;