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,
        schemaNode => PROP_RO | PROP_DIRECT,
        schemaType => 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] schemaType>

Ссылка на узел из C<IMPL::DOM::Schema>, представляющий схему данных текущего узла. Может быть C<undef>.

=item C<[get] schemaNode>

Ссылка на узел из C<IMPL::DOM::Schema>, представляющий элемент схемы, объявляющий данный узел. Может быть C<undef>.

Отличается от свойства C<schemaType> тем, что узел в случае ссылки на тип узла, данной свойство будет содержать
описание ссылки C<IMPL::DOM::Schema::Node>, а свойство C<schema> например будет ссылаться на
C<IMPL::DOM::Schema::ComplexType>.

=back 

=head2 METHODS

=cut