Mercurial > pub > Impl
view Lib/IMPL/DOM/Node.pm @ 171:59e5fcb59d86
Исправления, изменена концепция веб-форм
author | sourcer |
---|---|
date | Mon, 06 Jun 2011 03:30:36 +0400 |
parents | 76515373dac0 |
children | aaab45153411 |
line wrap: on
line source
package IMPL::DOM::Node; use strict; use warnings; use parent 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; public _direct property document => prop_get; public _direct property isComplex => { get => \&_getIsComplex } ; public _direct property nodeValue => prop_all; public _direct property childNodes => { get => \&_getChildNodes }; # prop_list public _direct property parentNode => prop_get | owner_set; public _direct property schema => prop_get | owner_set; public _direct property schemaSource => prop_get | owner_set; private _direct property _propertyMap => prop_all ; __PACKAGE__->class_data(property_bind => {}); } 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}; $_->_updateDocRefs foreach @{$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; 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->get_meta(typeof IMPL::Class::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