Mercurial > pub > Impl
view Lib/IMPL/DOM/Node.pm @ 385:0d63f5273307
sync
author | sergey |
---|---|
date | Tue, 11 Feb 2014 01:05:55 +0400 |
parents | 77df11605d3a |
children | 4edd36025051 |
line wrap: on
line source
package IMPL::DOM::Node; use strict; use warnings; use Scalar::Util qw(weaken); use IMPL::lang; use IMPL::Object::List; use IMPL::Exception(); use IMPL::Const qw(:prop); use IMPL::declare { require => { PropertyInfo => '-IMPL::Class::PropertyInfo' }, base => [ 'IMPL::Object' => undef ], props => [ nodeName => PROP_RO | PROP_DIRECT, document => PROP_RO | PROP_DIRECT, isComplex => { get => \&_getIsComplex }, nodeValue => PROP_RW | PROP_DIRECT, childNodes => { get => \&_getChildNodes, isList => 1, direct => 1 }, parentNode => PROP_RO | PROP_DIRECT, schema => PROP_RO | PROP_DIRECT, schemaSource => PROP_RO | PROP_DIRECT, _propertyMap => PROP_RW | PROP_DIRECT ] }; our %Axes = ( parent => \&selectParent, siblings => \&selectSiblings, child => \&childNodes, document => \&selectDocument, ancestor => \&selectAncestors, descendant => \&selectDescendant ); sub CTOR { my ($this,%args) = @_; $this->{$nodeName} = delete $args{nodeName} or die new IMPL::InvalidArgumentException("A name is required"); $this->{$nodeValue} = delete $args{nodeValue} if exists $args{nodeValue}; if ( exists $args{document} ) { $this->{$document} = delete $args{document}; weaken($this->{$document}); } while ( my ($key,$value) = each %args ) { $this->nodeProperty($key,$value); } } 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 appendChild { 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 appendNode { goto &appendChild; } 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 wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes}; } sub childNodesRef { my ($this) = @_; return scalar $this->_getChildNodes; } 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 resolveAxis { my ($this,$axis) = @_; return $Axes{$axis}->($this) } sub selectNodes { my $this = shift; my $path; if (@_ == 1) { $path = $this->translatePath($_[0]); } else { $path = [@_]; } my @set = ($this); while (@$path) { my $query = shift @$path; @set = map $_->selectNodesAxis($query), @set; } return wantarray ? @set : \@set; } sub selectSingleNode { my $this = shift; my @result = $this->selectNodes(@_); return $result[0]; } sub selectNodesRef { my $this = shift; my @result = $this->selectNodes(@_); return \@result; } sub translatePath { my ($this,$path) = @_; # TODO: Move path compilation here from IMPL::DOM::Schema::Validator::Compare return [$path]; } sub selectNodesAxis { my ($this,$query,$axis) = @_; $axis ||= 'child'; die new IMPL::InvalidOperationException('Unknown axis',$axis) unless exists $Axes{$axis}; my $nodes = $this->resolveAxis($axis); my @result; if (ref $query eq 'CODE') { @result = grep &$query($_), @{$nodes}; } elsif (ref $query eq 'ARRAY' ) { my %keys = map (($_,1),@$query); @result = grep $keys{$_->nodeName}, @{$nodes}; } elsif (ref $query eq 'HASH') { while( my ($axis,$filter) = each %$query ) { push @result, $this->selectNodesAxis($filter,$axis); } } elsif (defined $query) { @result = grep $_->nodeName eq $query, @{$nodes}; } else { return wantarray ? @{$nodes} : $nodes; } return wantarray ? @result : \@result; } sub selectParent { my ($this) = @_; if ($this->parentNode) { return wantarray ? $this->parentNode : [$this->parentNode]; } else { return wantarray ? () : []; } } sub selectSiblings { my ($this) = @_; if ($this->parentNode) { return $this->parentNode->selectNodes( sub { $_ != $this } ); } else { return wantarray ? () : []; } } sub selectDocument { my ($this) = @_; if ($this->document) { return wantarray ? $this->document : [$this->document]; } else { return wantarray ? () : []; } } sub selectDescendant { wantarray ? map $_->selectAll(), $_[0]->childNodes : [map $_->selectAll(), $_[0]->childNodes] } sub selectAll { map(selectAll($_),@{$_[0]->childNodes}) , $_[0] } sub selectAncestors { my $parent = $_[0]->parentNode; wantarray ? ($parent ? ($parent->selectAncestors,$parent) : ()) : [$parent ? ($parent->selectAncestors,$parent) : ()] } sub firstChild { @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0]; } sub _getIsComplex { ($_[0]->{$childNodes} and $_[0]->{$childNodes}->Count) ? 1 : 0; } sub _updateDocRefs { my ($this) = @_; # this method is called by the parent node on his children, so we need no to check parent $this->{$document} = $this->{$parentNode}->document; # prevent cyclic weaken($this->{$document}) if $this->{$document}; map $_->_updateDocRefs, @{$this->{$childNodes}} if $this->{$childNodes}; } sub _setParent { my ($this,$node) = @_; if (($node || 0) != ($this->{$parentNode} || 0)) { my $newOwner; if ($node) { $this->{$parentNode} = $node; $newOwner = $node->document || 0; # prevent from creating cyclicreferences weaken($this->{$parentNode}); } else { delete $this->{$parentNode}; #keep document $newOwner = $this->{$document}; } if (($this->{$document}||0) != $newOwner) { $this->{$document} = $newOwner; weaken($this->{$document}) if $newOwner; $_->_updateDocRefs foreach @{$this->childNodes}; } } } sub text { my ($this) = @_; join ('', $this->nodeValue || '', map ($_->text || '', @{$this->childNodes})); } sub nodeProperty { my $this = shift; my $name = shift; return unless defined $name; if (my $method = $this->can($name)) { unshift @_,$this; # use goto to preserve calling context goto &$method; } # dynamic property if (@_) { # set return $this->{$_propertyMap}{$name} = shift; } else { return $this->{$_propertyMap}{$name}; } } sub listProperties { my ($this) = @_; my %props = map {$_->name, 1} $this->GetMeta(PropertyInfo, sub { $_->attributes->{domProperty}},1); return (keys %props,keys %{$this->{$_propertyMap}}); } sub save { my ($this,$writer) = @_; if ( not ( $this->isComplex or defined $this->{$nodeValue} ) ) { $writer->emptyTag( $this->{$nodeName}, map { $_, $this->nodeProperty($_) } grep defined $this->nodeProperty($_), $this->listProperties ); } else { $writer->startTag( $this->{$nodeName}, map { $_, $this->nodeProperty($_) } grep defined $this->nodeProperty($_), $this->listProperties ); $writer->characters($this->{$nodeValue}) if $this->{$nodeValue}; $_->save($writer) foreach $this->childNodes; $writer->endTag($this->{$nodeName}); } } sub qname { $_[0]->{$nodeName}; } sub path { my ($this) = @_; if ($this->parentNode) { return $this->parentNode->path.'.'.$this->qname; } else { return $this->qname; } } 1; __END__ =pod =head1 NAME C<IMPL::DOM::Node> Элемент DOM модели =head1 DESCRIPTION Базовый узел DOM модели. От него можно наследовать другие элементы DOM модели. =head1 MEMBERS =head2 PROPERTIES =over =item C<[get] nodeName> Имя узла. Задается при создании. =item C<[get] document> Документ к которому принадлежит узел. Задается при поздании узла. =item C<[get] isComplex> Определяет является ли узел сложным (тоесть есть ли дети). C<true> - есть, C<false> - нет. =item C<[get,set] nodeValue> Значение узла, обычно простой скаляр, но ничто не мешает туда устанавливать любое значение. =item C<[get,list] childNodes> Список детей, является списокм C<IMPL::Object::List>. =item C<[get] parentNode> Ссылка на родительский элемент, если таковой имеется. =item C<[get] schema> Ссылка на узел из C<IMPL::DOM::Schema>, представляющий схему данных текущего узла. Может быть C<undef>. =item C<[get] schema> Ссылка на узел из C<IMPL::DOM::Schema>, представляющий элемент схемы, объявляющий данный узел. Может быть C<undef>. Отличается от свойства C<schema> тем, что узел в случае ссылки на тип узла, данной свойство будет содержать описание ссылки C<IMPL::DOM::Schema::Node>, а свойство C<schema> например будет ссылаться на C<IMPL::DOM::Schema::ComplexType>. =back =head2 METHODS =cut