view Lib/IMPL/DOM/Node.pm @ 84:e568c7c8b743

Minor changes to the test infrastructure
author wizard
date Wed, 14 Apr 2010 17:38:11 +0400
parents 915df8fcd16f
children cf3b6ef2be22
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};
            
            #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 (@_) {
        # 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;

__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>

Ссылка на родительский элемент, если таковой имеется.

=head2 METHODS

=cut