diff Lib/IMPL/DOM/Node.pm @ 104:196bf443b5e1

DOM::Schema RC0 inflators support, validation and some other things, Minor and major fixes almost for everything. A 'Source' property of the ValidationErrors generated from a NodeSet or a NodeList is subject to change in the future.
author wizard
date Tue, 11 May 2010 02:42:59 +0400
parents cf3b6ef2be22
children c6fb6964de4c
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Node.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Tue May 11 02:42:59 2010 +0400
@@ -21,6 +21,13 @@
     private _direct property _propertyMap => prop_all ;
 }
 
+our %Axes = (
+	parent => \&selectParent,
+	siblings => \&selectSiblings,
+	child => \&childNodes,
+	document => \&selectDocument
+);
+
 sub CTOR {
     my ($this,%args) = @_;
     
@@ -170,30 +177,82 @@
     return wantarray ? @result : \@result;
 }
 
+sub resolveAxis {
+	my ($this,$axis) = @_;
+	return $Axes{$axis}->($this)
+}
+
 sub selectNodes {
-    my ($this,$query) = @_;
+    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($_), @{$this->childNodes};
+        @result = grep &$query($_), @{$nodes};
     } elsif (ref $query eq 'ARRAY' ) {
         my %keys = map (($_,1),@$query);
-        @result = grep $keys{$_->nodeName}, @{$this->childNodes};
+        @result = grep $keys{$_->nodeName}, @{$nodes};
+    } elsif (ref $query eq 'HASH') {
+    	while( my ($axis,$filter) = each %$query ) {
+    		push @result, $this->selectNodes($filter,$axis);
+    	}
     } elsif (defined $query) {
-        @result = grep $_->nodeName eq $query, @{$this->childNodes};
+        @result = grep $_->nodeName eq $query, @{$nodes};
     } else {
-        if (wantarray) {
-            return @{$this->childNodes};
-        } else {
-            @result = $this->childNodes;
-            return \@result;
-        }
+        return wantarray ? @{$nodes} : $nodes;
     }
     
     return wantarray ? @result : \@result;
 }
 
+sub selectPath {
+	my ($this,$path) = @_;
+	
+	my @set = ($this);
+	
+	while (my $query = shift @$path) {
+		@set = map $_->selectNodes($query), @set;
+	}
+	
+	return wantarray ? @set : \@set;
+}
+
+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 firstChild {
     @_ >=2 ? $_[0]->replaceNodeAt(0,$_[1]) : $_[0]->childNodes->[0];
 }