view Lib/IMPL/DOM/Node.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents dd4d72600c69
children a8086f85a571
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 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 $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;