# HG changeset patch
# User wizard
# Date 1276177431 -14400
# Node ID a4b0a819bbda54fe8da84edcb273eb5885481a67
# Parent  e30bdd040fe3005b5a65c7bbadd75a3fa78c8bff
Small fixes in IMPL::DOM::Schema

diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/ComplexType.pm
--- a/Lib/IMPL/DOM/Schema/ComplexType.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexType.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -36,7 +36,7 @@
 	if ($this->{$nativeType}) {
 		return new IMPL::DOM::Schema::ValidationError(
 			Node => $node,
-			Source => $ctx && $ctx->{Source} || $this,
+			Source => $ctx->{Source} || $this,
 			Schema => $this,
 			Message => $this->messageWrongType
 		) unless $node->isa($this->{$nativeType});
diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/NodeList.pm
--- a/Lib/IMPL/DOM/Schema/NodeList.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeList.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -23,13 +23,14 @@
 }
 
 sub Validate {
-    my ($this,$node) = @_;
+    my ($this,$node,$ctx) = @_;
     
     my @nodes = map {
         {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 }
     } @{$this->childNodes};
     
     my $info = shift @nodes;
+    my $sourceSchema = $ctx->{Source} || $this->parentNode;
     
     foreach my $child ( @{$node->childNodes} ) {
         #skip schema elements
@@ -40,7 +41,7 @@
                 Node => $child,
                 Parent => $node,
                 Schema => $info->{Schema},
-                Source => $this
+                Source => $sourceSchema
             ) if $info->{Min} > $info->{Seen};
             
             $info = shift @nodes;
@@ -51,7 +52,7 @@
             Message => $this->messageUnexpected,
             Node => $child,
             Parent => $node,
-            Source => $this
+            Source => $sourceSchema
         ) unless $info;
         
         # it's ok, we found schema element for child
@@ -74,7 +75,7 @@
             Message => $this->messageUnexpected,
             Node => $child,
             Parent => $node,
-            Source => $this,
+            Source => $sourceSchema,
         ) if $info->{Max} and $info->{Seen} > $info->{Max};
     }
     
@@ -83,7 +84,7 @@
         return new IMPL::DOM::Schema::ValidationError (
             Error => 1,
             Message => $this->messageNodesRequired,
-            Source => $this,
+            Source => $sourceSchema,
             Parent => $node,
             Schema => $info->{Schema}
         ) if $info->{Seen} < $info->{Min};
diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/NodeSet.pm
--- a/Lib/IMPL/DOM/Schema/NodeSet.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeSet.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -24,12 +24,14 @@
 }
 
 sub Validate {
-    my ($this,$node) = @_;
+    my ($this,$node,$ctx) = @_;
     
     my @errors;
     
     my %nodes;
     my $anyNode;
+    my $sourceSchema = $ctx->{Source} || $this->parentNode;
+    
     foreach (@{$this->childNodes}) {
         if ($_->isa('IMPL::DOM::Schema::AnyNode')) {
             $anyNode = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 };
@@ -42,7 +44,7 @@
         if (my $info = $nodes{$child->nodeName} || $anyNode) {
             $info->{Seen}++;
             push @errors,new IMPL::DOM::Schema::ValidationError (
-                Source => $this,
+                Source => $sourceSchema,
                 Node => $child,
                 Parent => $node,
                 Schema => $info->{Schema},
@@ -54,7 +56,7 @@
             }
         } else {
             push @errors, new IMPL::DOM::Schema::ValidationError (
-                Source => $this,
+                Source => $sourceSchema,
                 Node => $child,
                 Parent => $node,
                 Message => $this->messageUnexpected
@@ -64,7 +66,7 @@
     
     foreach my $info (values %nodes) {
         push @errors, new IMPL::DOM::Schema::ValidationError (
-            Source => $this,
+            Source => $sourceSchema,
             Schema => $info->{Schema},
             Parent => $node,
             Message => $this->messageMin
diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/SwitchNode.pm
--- a/Lib/IMPL/DOM/Schema/SwitchNode.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/SwitchNode.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -23,12 +23,12 @@
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->messageNoMatch($args{messageNoMatch} || 'A node %Node.nodeName% isn\'t expected in the %Node.parentNode.path%');
+    $this->messageNoMatch($args{messageNoMatch} || 'A node %Node.nodeName% isn\'t expected in the %Parent.path%');
 }
 
 sub Validate {
-    my ($this,$node) = @_;
-    
+    my ($this,$node,$ctx) = @_;
+        
     if ( my ($schema) = $this->selectNodes(sub {$_[0]->name eq $node->nodeName} ) ) {
         return $schema->Validate($node);
     } else {
diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/ValidationError.pm
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/ValidationError.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -25,7 +25,13 @@
     $this->{$Node} = $args{Node};
     $this->{$Schema} = $args{Schema} if $args{Schema};
     $this->{$Source} = $args{Source} if $args{Source};
-    $this->{$Parent} = $args{Parent} if $args{Parent};
+    if ($args{Parent}) {
+    	$this->{$Parent} = $args{Parent};
+    } elsif ($args{Node}) {
+    	$this->{$Parent} = $args{Node}->parentNode;
+    } else {
+    	die new IMPL::InvalidArgumentException("A 'Parent' or a 'Node' parameter is required");
+    }
     $this->{$Message} = FormatMessage(delete $args{Message}, \%args) if $args{Message};
 }
 
@@ -35,3 +41,81 @@
 }
 
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::DOM::Schema::ValidationError> - Описывает ошибку в документе.
+
+=head1 DESCRIPTION
+
+При проверке документа на ошибки формирования возвращается массив с объектами
+C<IMPL::DOM::Schema::ValidationError>, каждая из которых описывает одну ошибку
+в документе.
+
+С помощью данного объекта осущетсвляется привязка элемента схемы, элемента документа
+и сообщения о причине возникновения ошибки.
+
+=head1 MEMBERS
+
+=over
+=item C<[get] Node>
+
+
+Узел в документе который привел к ошибке. Как правило это либо простые узлы, либо
+узлы, которые не могут присутствоать в данном месте по схеме.
+
+Данное свойство может быть C<undef>. 
+
+=item C<[get] Parent>
+
+Родительский узел в котором произошла ошибка. Используется в случаях, когда C<Node>
+не указан, например, если по схеме должен существовать дочерний узел с определенным
+именем, а в реальном документе его нет.
+
+Также это свойство может использоваться при формировании сообщения.
+
+=item C<[get] Schema>
+
+Схема для C<Node> или узла который должен присутсвовать если C<Node> не задан.
+
+=item C<[get] Source>
+
+Схема, проверка которой привела к возникновению ошибки. Поскольку схемы могут
+использовать ссылки, то данное свойство нужно для получения схемы узла, а не
+схемы его типа.
+
+Тоесть проверка схемы узла C<IMPL::DOM::Schema::Node> приводит к проверке схемы
+типа, например, C<IMPL::DOM::Schema::ComplexType>, а свойство C<Source> будет
+указывать именно на C<IMPL::DOM::Schema::Node>.
+
+=item C<[get] Message>
+
+Возвращает форматированное сообщение об ошибке.
+
+=item C<toString()>
+
+Преобразует ошибку к строке, возвращает значение свойства C<Message>
+
+=back
+
+=head1 REMARKS
+
+=begin code
+
+my $doc = IMPL::DOM::XMLReader->LoadDocument('data.xml');
+my $schema = IMPL::DOM::Schema->LoadSchema('schema.xml');
+
+my @errors = $schema->Validate($doc);
+
+my $node = $doc->selectSingleNode('user','name');
+
+# Получаем все ошибки относящиеся к данному узлу
+my @nodeErrors = grep { ($_->Node || $_->Parent) == $node } @errors;  
+
+=end code
+
+=cut
diff -r e30bdd040fe3 -r a4b0a819bbda Lib/IMPL/DOM/Schema/Validator/Compare.pm
--- a/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Thu Jun 10 02:45:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Thu Jun 10 17:43:51 2010 +0400
@@ -9,7 +9,7 @@
 BEGIN {
 	public property targetProperty => prop_all;
 	public property op => prop_all;
-	public property nodePath => prop_get | owner_set;
+	public property nodePath => prop_all;
 	public property optional => prop_all;
 	private property _pathTranslated => prop_all;
 	private property _targetNode => prop_all;
@@ -20,6 +20,7 @@
 	'IMPL::DOM::Schema::Validator' => sub {
 		my %args = @_;
 		$args{nodeName} ||= 'Compare';
+		delete @args{qw(targetProperty op nodePath optional message)};
 		%args;
 	}
 );
@@ -114,7 +115,7 @@
 	
 	my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath));
 	
-	my ($foreignNode) = $node->selectNodes($query);
+	my ($foreignNode) = $node->selectNodes(@$query);
 	
 	my $Source = $ctx && $ctx->{Source} || $this->parentNode;
 	
diff -r e30bdd040fe3 -r a4b0a819bbda _test/Web.t
--- a/_test/Web.t	Thu Jun 10 02:45:59 2010 +0400
+++ b/_test/Web.t	Thu Jun 10 17:43:51 2010 +0400
@@ -8,7 +8,6 @@
 
 my $plan = new IMPL::Test::Plan qw(
     Test::Web::TT
-    Test::Web::Application
 );
 
 $plan->AddListener(new IMPL::Test::TAPListener);
diff -r e30bdd040fe3 -r a4b0a819bbda _test/temp.pl
--- a/_test/temp.pl	Thu Jun 10 02:45:59 2010 +0400
+++ b/_test/temp.pl	Thu Jun 10 17:43:51 2010 +0400
@@ -1,7 +1,6 @@
 #!/usr/bin/perl
 use strict;
 
-my $var = "  some stuff";
-
-$var =~ tr/f/ome/;
+my $var ;
+$var->{dool} = '';
 print $var;
\ No newline at end of file