--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/DOM/Node.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,505 @@
+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->Push($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->Push(@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->{dom} },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