view Lib/IMPL/DOM/Node.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 915df8fcd16f
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;
    public _direct property document => prop_get;
    public _direct property isComplex => { get => \&_getIsComplex } ;
    public _direct property nodeValue => prop_all;
    public _direct property childNodes => { get => \&_getChildNodes };
    public _direct property parentNode => prop_get ;
    private _direct property _propertyMap => prop_all ;
}

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});
    }
    
    $this->{$_propertyMap} = \%args;
}

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 _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};
            $newOwner = 0;
        }
        
        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 (@_) {
        # 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;