# HG changeset patch
# User wizard
# Date 1273531379 -14400
# Node ID 196bf443b5e1c5abe96fc2af245c073bdb3b3a06
# Parent  c289ed9662caf5573299d05e3e0a2b75897de6f4
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.

diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Document.pm
--- a/Lib/IMPL/DOM/Document.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Document.pm	Tue May 11 02:42:59 2010 +0400
@@ -17,6 +17,7 @@
     
     delete $refProps->{nodeName};
     
+    die new IMPL::Exception("class is not specified") unless $class;
     return $class->new(
         nodeName => $nodeName,
         document => $this,
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Navigator.pm
--- a/Lib/IMPL/DOM/Navigator.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Navigator.pm	Tue May 11 02:42:59 2010 +0400
@@ -165,6 +165,21 @@
     join($delim,map $_->{alternatives}[$_->{current}]->nodeName, $this->{$_path} ? (@{$this->{$_path}}, $this->{$_state}) : $this->{$_state});
 }
 
+sub pathLength {
+	my ($this) = @_;
+	$this->{$_path} ? scalar @{$this->{$_path}} : 0;
+}
+
+sub GetNodeFromHistory {
+	my ($this,$index) = @_;
+	
+	if (my $state = $this->{$_path} ? $this->{$_path}->[$index] : undef ) {
+		return $state->{alternatives}[$state->{current}]
+	} else {
+		return undef;
+	}
+}
+
 sub clone {
     my ($this) = @_;
     
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Navigator/Builder.pm
--- a/Lib/IMPL/DOM/Navigator/Builder.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Navigator/Builder.pm	Tue May 11 02:42:59 2010 +0400
@@ -6,12 +6,14 @@
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 require IMPL::DOM::Navigator::SchemaNavigator;
+require IMPL::DOM::Schema::ValidationError;
 
 BEGIN {
     private _direct property _schemaNavi => prop_all;
     private _direct property _nodesPath => prop_all;
     private _direct property _nodeCurrent => prop_all;
     private _direct property _docClass => prop_all;
+    public _direct property BuildErrors => prop_get | prop_list;
     public _direct property Document => prop_get | owner_set;
 }
 
@@ -26,8 +28,9 @@
     my ($this,$nodeName,%props) = @_;
     
     if (my $schemaNode = $this->{$_schemaNavi}->NavigateName($nodeName)) {
-        my $class = $schemaNode->can('nativeType') ? $schemaNode->nativeType : 'IMPL::DOM::Node';
-        $this->inflateProperties($schemaNode,\%props);
+        my $class = $schemaNode->can('nativeType') ? $schemaNode->nativeType || 'IMPL::DOM::Node' : 'IMPL::DOM::Node';
+        
+        my @errors = $this->inflateProperties($schemaNode,\%props);
         
         my $node;
         if (! $this->{$Document}) {
@@ -41,6 +44,20 @@
         
         $this->{$_nodeCurrent} = $node;
         
+        if (@errors) {
+        	$this->BuildErrors->Append(
+        		map {
+					IMPL::DOM::Schema::ValidationError->new(
+						Node => $node,
+						Source => $this->{$_schemaNavi}->SourceSchemaNode,
+						Schema => $schemaNode,
+						Message => $schemaNode->messageInflateError,
+						Error => $_
+					)        			
+        		} @errors
+        	);
+        }
+        
         return $node;
     } else {
         die new IMPL::InvalidOperationException("The specified node is undefined", $nodeName);
@@ -49,22 +66,36 @@
 
 sub inflateProperties {
 	my ($this,$schemaNode,$refProps) = @_;
-	
-	$refProps->{$_->name} = $_->inflator->new($refProps->{$_->name})
-		foreach $schemaNode->selectNodes(
-			sub {
-				$_->nodeName eq 'Property' and exists $refProps->{$_->name} and $_->inflator 
-			}
-		);
+	my @errors;
+	foreach my $schemaProp ( $schemaNode->selectNodes('Property') ) {
+		next if not exists $refProps->{$schemaProp->name};
+		my $result = eval {$schemaProp->inflateValue($refProps->{$schemaProp->name}) };
+		if (my $e = $@) {
+			push @errors, $e;
+		} else {
+			$refProps->{$schemaProp->name} = $result;
+		}		
+	}
+	return @errors;
 }
 
 sub inflateValue {
-	my ($this,$value) = @_;
-	my $schemaNode = $this->{$_schemaNavi}->Current;
-	if ($schemaNode->can('inflator') and my $inflator = $schemaNode->inflator) {
-		return $inflator->new($value);
+	my ($this,$value,$node) = @_;
+	
+	my $nodeSchema = $this->{$_schemaNavi}->Current;
+	
+	my $result = eval { $nodeSchema->inflateValue($value) };
+	if (my $e=$@) {
+		$this->BuildErrors->Append(new IMPL::DOM::Schema::ValidationError(
+			Schema =>  $nodeSchema,
+			Node => $node,
+			Error => $e,
+			Message => $nodeSchema->messageInflateError,
+			Source => $this->{$_schemaNavi}->SourceSchemaNode
+		));
+		return $value;
 	} else {
-		return $value;
+		return $result;
 	}
 }
 
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Navigator/SchemaNavigator.pm
--- a/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Navigator/SchemaNavigator.pm	Tue May 11 02:42:59 2010 +0400
@@ -38,7 +38,15 @@
     
     # perform a safe navigation
     #return dosafe $this sub {
-        my $steps = 1;
+        my $steps = 0;
+        # if we are currently in a ComplexNode, first go to it's content
+        if ($this->Current->isa('IMPL::DOM::Schema::ComplexNode')) {
+            # navigate to it's content
+            # ComplexNode
+            $this->internalNavigateNodeSet($this->Current->content);
+            $steps ++;
+        }
+        
         # navigate to node
         if (
             my $node = $this->Navigate( sub {
@@ -51,10 +59,13 @@
                 )
             })
         ) {
+        	$steps ++;
             if ($node->nodeName eq 'AnyNode') {
                 # if we navigate to the anynode
                 # assume it to be ComplexType by default
                 $node = $node->type ? $this->{$Schema}->resolveType($node->type) : $schemaAnyNode;
+                $this->internalNavigateNodeSet($node);
+                $steps ++;
             } elsif ($node->nodeName eq 'SwitchNode') {
                 # if we are in the switchnode
                 # navigate to the target node
@@ -70,13 +81,6 @@
                 $steps++;
             } 
             
-            # if target node is a complex node
-            if ($node->isa('IMPL::DOM::Schema::ComplexNode')) {
-                # navigate to it's content
-                $this->internalNavigateNodeSet($node->content);
-                $steps ++;
-            }
-            
             push @{$this->{$_historySteps}},$steps;
             
             # return found node schema
@@ -93,6 +97,19 @@
     $this->Back(pop @{$this->{$_historySteps}}) if $this->{$_historySteps};
 }
 
+sub SourceSchemaNode {
+	my ($this) = @_;
+	
+	if ($this->Current->isa('IMPL::DOM::Schema::SimpleType') or
+		$this->Current->isa('IMPL::DOM::Schema::ComplexType')
+	) {
+		# we a redirected
+		return $this->GetNodeFromHistory(-1);
+	} else {
+		return $this->Current;
+	}
+}
+
 1;
 __END__
 
@@ -107,16 +124,21 @@
 
 =over
 
-=item C<< $navi->NavigateName($name) >>
+=item C<NavigateName($name)>
 
 Переходит на схему узла с указанным именем. Тоесть использует свойство C<name>.
 
-=item C<< $navi->SchemaBack >>
+=item C<SchemaBack>
 
 Возвращается на позицию до последней операции C<NavigateName>. Данный метод нужен
 посокольку операция навигации по элементам описываемым схемой может приводить к
 нескольким операциям навигации по самой схеме.
 
+=item C<SourceSchemaNode>
+
+Получает схему узла из которого было выполнено перенаправление, например, C<IMPL::DOM::Schema::Node>.
+В остальных случаях совпадает со свойством C<Current>.
+
 =back
 
 =cut
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Node.pm
--- 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];
 }
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema.pm
--- a/Lib/IMPL/DOM/Schema.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Tue May 11 02:42:59 2010 +0400
@@ -15,6 +15,7 @@
 require IMPL::DOM::Schema::Validator;
 require IMPL::DOM::Navigator::Builder;
 require IMPL::DOM::XMLReader;
+require IMPL::DOM::Schema::InflateFactory;
 
 use base qw(IMPL::DOM::Document);
 use IMPL::Class::Property;
@@ -110,7 +111,7 @@
 sub Validate {
     my ($this,$node) = @_;
     
-    if ( my ($schemaNode) = $this->selectNodes(sub { $_[0]->name eq $node->nodeName })) {
+    if ( my ($schemaNode) = $this->selectNodes(sub { $_->isa('IMPL::DOM::Schema::Node') and $_[0]->name eq $node->nodeName })) {
         $schemaNode->Validate($node);
     } else {
         return new IMPL::DOM::Schema::ValidationError(Message=> "A specified document doesn't match the schema");
@@ -132,7 +133,7 @@
                 IMPL::DOM::Schema::Node->new(name => 'ComplexType', type => 'ComplexType', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleType', type => 'SimpleType', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'Node', type => 'Node', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::SimpleNode->new(name => 'Include', minOccur => 0, maxOccur=>'unbounded')->appendRange(
                     IMPL::DOM::Schema::Property->new(name => 'source')
                 )
@@ -142,9 +143,9 @@
             IMPL::DOM::Schema::NodeSet->new()->appendRange(
                 IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'Node', type=>'Node', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::SwitchNode->new(minOccur => 0, maxOccur => 1)->appendRange(
-                    IMPL::DOM::Schema::SimpleNode->new(name => 'AnyNode'),
+                    IMPL::DOM::Schema::Node->new(name => 'AnyNode', type => 'AnyNode'),
                     IMPL::DOM::Schema::Node->new(name => 'SwitchNode',type => 'SwitchNode')
                 )
             )
@@ -153,7 +154,7 @@
             IMPL::DOM::Schema::NodeSet->new()->appendRange(
                 IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type=>'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type=>'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'Node', type=>'Node', minOccur => 0, maxOccur=>'unbounded'),
             )
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'NodeList', nativeType => 'IMPL::DOM::Schema::NodeList')->appendRange(
@@ -161,8 +162,8 @@
                 IMPL::DOM::Schema::Node->new(name => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'),
                 IMPL::DOM::Schema::Node->new(name => 'SwitchNode',type => 'SwitchNode', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'Node', minOccur => 0, maxOccur=>'unbounded'),
-                IMPL::DOM::Schema::SimpleNode->new(name => 'AnyNode', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'Node', type => 'Node', minOccur => 0, maxOccur=>'unbounded'),
+                IMPL::DOM::Schema::Node->new(name => 'AnyNode', type => 'AnyNode', minOccur => 0, maxOccur=>'unbounded'),
             )
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'ComplexType', nativeType => 'IMPL::DOM::Schema::ComplexType')->appendRange(
@@ -192,14 +193,16 @@
             	IMPL::DOM::Schema::Node->new(name => 'Property', type=>'Property', maxOccur=>'unbounded', minOccur=>0),
                 IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0, type=>'Validator')
             ),
-            new IMPL::DOM::Schema::Property(name => 'type')
+            new IMPL::DOM::Schema::Property(name => 'type'),
+            new IMPL::DOM::Schema::Property(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'SimpleNode', nativeType => 'IMPL::DOM::Schema::SimpleNode')->appendRange(
             IMPL::DOM::Schema::NodeList->new()->appendRange(
             	IMPL::DOM::Schema::Node->new(name => 'Property', type=>'Property', maxOccur=>'unbounded', minOccur=>0),
                 IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0, type=>'Validator')
             ),
-            new IMPL::DOM::Schema::Property(name => 'name')
+            new IMPL::DOM::Schema::Property(name => 'name'),
+            new IMPL::DOM::Schema::Property(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'Validator', nativeType => 'IMPL::DOM::Schema::Validator')->appendRange(
             IMPL::DOM::Schema::NodeList->new()->appendRange(
@@ -210,8 +213,14 @@
         	IMPL::DOM::Schema::NodeList->new()->appendRange(
         		IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
         	),
-        	IMPL::DOM::Schema::Property->new(name => 'name')
-        )
+        	IMPL::DOM::Schema::Property->new(name => 'name'),
+        	new IMPL::DOM::Schema::Property(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
+        ),
+        IMPL::DOM::Schema::SimpleType->new(type => 'Node', nativeType => 'IMPL::DOM::Schema::Node')->appendRange(
+        	IMPL::DOM::Schema::Property->new(name => 'name'),
+        	IMPL::DOM::Schema::Property->new(name => 'type')
+        ),
+        IMPL::DOM::Schema::SimpleType->new(type => 'AnyNode', nativeType => 'IMPL::DOM::Schema::AnyNode')
     );
     
     $schema->Process;
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/InflateFactory.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Schema/InflateFactory.pm	Tue May 11 02:42:59 2010 +0400
@@ -0,0 +1,17 @@
+package IMPL::DOM::Schema::InflateFactory;
+use strict;
+
+require IMPL::Exception;
+require IMPL::Object::Factory;
+
+sub new {
+	my ($self,$value) = @_;
+	
+	if ($value =~ /^(\w+(?:::\w+)*)(?:\.(\w+))?$/) {
+		return IMPL::Object::Factory->new($1,undef,$2);	
+	} else {
+		die new IMPL::InvalidArgumentException("Expected value in the format PACKAGE::NAME.method_name",$value);
+	}
+}
+
+1;
\ No newline at end of file
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/Node.pm
--- a/Lib/IMPL/DOM/Schema/Node.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/Node.pm	Tue May 11 02:42:59 2010 +0400
@@ -37,13 +37,18 @@
     my ($this,$node) = @_;
     
     if (my $schemaType = $this->{$type} ? $this->document->resolveType($this->{$type}) : undef ) {
-        return $schemaType->Validate($node);
+        my @errors = $schemaType->Validate($node,{Source => $this});
+        return @errors;
     } else {
         return ();
     }
 }
 
-sub inflator { undef; }
+sub inflateValue {
+	$_[1];
+}
+
+sub inflator { undef }
 
 sub qname {
     $_[0]->nodeName.'[name='.$_[0]->{$name}.']';
@@ -56,8 +61,8 @@
 
 =head1 SYNOPSIS
 
-package Restriction;
-use base qw(IMPL::DOM::Schema::Item);
+package SchemaEntity;
+use base qw(IMPL::DOM::Schema::Node);
 
 sub Validate {
     my ($this,$node) = @_;
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/Property.pm
--- a/Lib/IMPL/DOM/Schema/Property.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/Property.pm	Tue May 11 02:42:59 2010 +0400
@@ -10,7 +10,7 @@
 __PACKAGE__->PassThroughArgs;
 
 BEGIN {
-    public property RequiredMessage => prop_all;
+    public property messageRequired => prop_all;
 }
 
 our %CTOR = (
@@ -20,6 +20,7 @@
         $args{maxOccur} = 1;
         $args{minOccur} = delete $args{optional} ? 0 : 1;
         $args{nodeName} ||= 'Property';
+        $args{messageInflateError} ||= "Failed to inflate a property '%Schema.name%' of a node '%Node.path%': %Error.Message%";
         
         return %args;
     }
@@ -28,11 +29,11 @@
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->RequiredMessage($args{RequiredMessage} || 'A property %Schema.name% is required in the %Node.qname%');
+    $this->messageRequired($args{messageRequired} || 'A property %Schema.name% is required in the %Node.qname%');
 }
 
 sub Validate {
-    my ($this,$node) = @_;
+    my ($this,$node,$ctx) = @_;
     
     my $prop = $this->name;
     
@@ -41,16 +42,17 @@
         
     if ($nodeProp->nodeValue) {
     	# we have a value so validate it
-    	return $this->SUPER::Validate($nodeProp);
+    	return $this->SUPER::Validate($nodeProp,$ctx);
     } elsif($this->minOccur) {
     	# we don't have a value but it's a mandatory property
         return new IMPL::DOM::Schema::ValidationError(
-            Message => $this->RequiredMessage,
+            Message => $this->messageRequired,
             Node => $node,
-            Schema => $this
+            Schema => $this,
+            Source => $ctx && $ctx->{Source} || $this
         );
     }
-    
+    return ();
 }
 
 1;
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/SimpleNode.pm
--- a/Lib/IMPL/DOM/Schema/SimpleNode.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/SimpleNode.pm	Tue May 11 02:42:59 2010 +0400
@@ -8,6 +8,7 @@
 
 BEGIN {
 	public _direct property inflator => prop_get;
+	public _direct property messageInflateError => prop_get;
 }
 
 our %CTOR = (
@@ -17,13 +18,28 @@
 sub CTOR {
 	my ($this,%args) = @_;
 	
-	$this->{$inflator} = $args{inflator} if $args{iflator};
+	$this->{$inflator} = $args{inflator} if $args{inflator};
+	$this->{$messageInflateError} = $args{messageInflateError} || 'Failed to inflate nodeValue %Node.path%: %Error%';
 }
 
 sub Validate {
-    my ($this,$node) = @_;
+    my ($this,$node,$ctx) = @_;
+    
+    my @result;
+    
+    push @result, $_->Validate($node,$ctx) foreach $this->childNodes;
     
-    return map $_->Validate($node), @{$this->childNodes};
+    return @result;
+}
+
+sub inflateValue {
+	my ($this,$value) = @_;
+	
+	if ( my $inflator = $this->inflator ) {
+		return $inflator->new($value);
+	} else {
+		return $value;
+	}
 }
 
 1;
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/SimpleType.pm
--- a/Lib/IMPL/DOM/Schema/SimpleType.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/SimpleType.pm	Tue May 11 02:42:59 2010 +0400
@@ -25,17 +25,17 @@
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->{$nativeType} = $args{nativeType};
+    $this->{$nativeType} = $args{nativeType} if $args{nativeType};
     $this->{$messageWrongType} = $args{messageWrongType} || "A simple node '%Node.path%' is expected to be %Schema.nativeType%"; 
 }
 
 sub Validate {
-	my ($this, $node) = @_;
+	my ($this, $node, $ctx) = @_;
 	
 	if ($this->{$nativeType}) {
 		return new IMPL::DOM::Schema::ValidationError(
 			Node => $node,
-			Source => $this,
+			Source => $ctx && $ctx->{Source} || $this,
 			Schema => $this,
 			Message => $this->messageWrongType
 		) unless $node->isa($this->{$nativeType});
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/ValidationError.pm
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/ValidationError.pm	Tue May 11 02:42:59 2010 +0400
@@ -2,17 +2,21 @@
 use strict;
 use warnings;
 
+use overload
+    '""' => \&toString,
+    'fallback' => 1;
+
 use base qw(IMPL::Object);
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 use IMPL::Resources::Format qw(FormatMessage);
 
 BEGIN {
-    public _direct property Node => prop_get;
-    public _direct property Schema => prop_get;
-    public _direct property Source => prop_get;
-    public _direct property Parent => prop_get;
-    public _direct property Message => prop_get;
+    public _direct property Node => prop_get; # target document node (if exists)
+    public _direct property Schema => prop_get; # a schema for the target node (if exists) 
+    public _direct property Source => prop_get; # a schema which triggered this error (can be equal to the Schema)
+    public _direct property Parent => prop_get; 
+    public _direct property Message => prop_get; # displayable message
 }
 
 sub CTOR {
@@ -25,4 +29,9 @@
     $this->{$Message} = FormatMessage(delete $args{Message}, \%args) if $args{Message};
 }
 
+sub toString {
+	(my $this) = @_;
+	return $this->Message;
+}
+
 1;
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/Validator/Compare.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Tue May 11 02:42:59 2010 +0400
@@ -0,0 +1,237 @@
+package IMPL::DOM::Schema::Validator::Compare;
+use strict;
+
+use base qw(IMPL::DOM::Schema::Validator);
+
+use IMPL::Resources::Format qw(FormatMessage);
+use IMPL::Class::Property;
+
+BEGIN {
+	public property targetProperty => prop_all;
+	public property op => prop_all;
+	public property nodePath => prop_get | owner_set;
+	public property optional => prop_all;
+	private property _pathTranslated => prop_all;
+	private property _targetNode => prop_all;
+	public property message => prop_all;
+}
+
+our %CTOR = (
+	'IMPL::DOM::Schema::Validator' => sub {
+		my %args = @_;
+		$args{nodeName} ||= 'Compare';
+		%args;
+	}
+);
+
+our %Ops = (
+	'='  => \&_equals,
+	'eq' => \&_equalsString,
+	'!=' => \&_notEquals,
+	'ne' => \&_notEqualsString,
+	'=~' => \&_matchRx,
+	'!~' => \&_notMatchRx,
+	'<'  => \&_less,
+	'>'  => \&_greater,
+	'lt' => \&_lessString,
+	'gt' => \&_greaterString
+);
+
+my $rxOps = map qr/$_/, join( '|', keys %Ops );
+
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->targetProperty($args{targetProperty} || 'nodeValue');
+	$this->op( $Ops{ $args{op} || '=' } ) or die new IMPL::InvalidArgumentException("Invalid parameter value",'op',$args{op},$this->path);
+	$this->nodePath($args{nodePath}) or die new IMPL::InvalidArgumentException("The argument is required", 'nodePath', $this->path);
+	$this->message($args{message} || 'The value of %Node.path% %Source.op% %Value% (%Source.nodePath%)' );
+	$this->optional($args{optional}) if $args{optional};
+}
+
+sub TranslatePath {
+	my ($this,$path) = @_;
+	
+	$path ||= '';
+	
+	my @selectQuery;
+	
+	my $i = 0;
+	
+	foreach my $chunk (split /\//,$path) {
+		$chunk = 'document:*' if $i == 0 and not length $chunk;
+		next if not length $chunk;
+		
+		my $query;		
+		my ($axis,$filter) = ( $chunk =~ /^(?:(\w+):)?(.*)$/);
+		
+		if ($filter =~ /^\w+|\*$/ ) {
+			$query = $filter eq '*' ? undef : $filter;
+		} elsif ( $filter =~ /^(\w+|\*)\s*((?:\[\s*\w+\s*(?:=|!=|=~|!~|eq|ne|lt|gt|)\s*["'](?:[\\'"]|\\[\\"'])*["']\])+)$/) {
+			my ($nodeName,$filterArgs) = ($1,$2);
+			
+			my @parsedFilters = map {
+				my ($prop,$op,$value) = ($_ =~ /\s*(\w+)\s*(=|!=|=~|!~)\s*(["'](?:[\\'"]|\\[\\"'])*["'])/);
+				$value =~ s/\\[\\'"]/$1/g;
+				{
+					prop => $prop,
+					op => $Ops{$op},
+					value => $value
+				}
+			} grep ( $_, split ( /[\]\[]+/,$filterArgs ) );
+			
+			$query = sub {
+				my ($node) = shift;
+				
+				$node->nodeName eq $nodeName or return 0 if $nodeName ne '*';
+				$_->{op}->(
+						_resovleProperty($node,$_->{prop}),
+						FormatMessage($_->{value},{
+							Schema => $this->parentNode,
+							Node => $this->_targetNode
+						},\&_resovleProperty)
+					) or return 0 foreach @parsedFilters;
+				
+			};
+		} else {
+			die new IMPL::Exception("Invalid query syntax",$path,$chunk);
+		}
+		
+		push @selectQuery, $axis ? { $axis => $query } : $query;
+		
+		$i++;
+	}
+	
+	return \@selectQuery;
+}
+
+sub Validate {
+	my ($this,$node,$ctx) = @_;
+	
+	my @result;
+	
+	$this->_targetNode($node);
+	
+	my $query = $this->_pathTranslated() || $this->_pathTranslated($this->TranslatePath($this->nodePath));
+	
+	my ($foreignNode) = $node->selectPath($query);
+	
+	my $Source = $ctx && $ctx->{Source} || $this->parentNode;
+	
+	if ($foreignNode) {
+		my $value = $this->nodeValue;
+		
+		if ($value) {
+			$value = FormatMessage($value, { Schema => $this->parentNode, Node => $this->_targetNode, ForeignNode => $foreignNode },\&_resovleProperty);
+		} else {
+			$value = $foreignNode->nodeValue;
+		}
+		
+		push @result, new IMPL::DOM::Schema::ValidationError(
+			Node => $node,
+			ForeignNode => $foreignNode,
+			Value => $value,
+			Source => $Source,
+			Schema => $this->parentNode,
+			Message => $this->message
+		) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value);
+	} elsif (not $this->optional) {
+		push @result,  new IMPL::DOM::Schema::ValidationError(
+			Node => $node,
+			Value => '',
+			Source => $Source,
+			Schema => $this->parentNode,
+			Message => $this->message
+		);
+	}
+	
+	$this->_targetNode(undef);
+	
+	return @result;
+}
+
+sub _resovleProperty {
+	my ($node,$prop) = @_;
+	
+	return $node->can($prop) ? $node->$prop() : $node->nodeProperty($prop);
+}
+
+sub _matchRx {
+	$_[0] =~ $_[1];
+}
+
+sub _notMatchRx {
+	$_[0] !~ $_[1];
+}
+
+sub _equals {
+	$_[0] == $_[1];
+}
+
+sub _notEquals {
+	$_[0] != $_[0];
+}
+
+sub _equalsString {
+	$_[0] eq $_[1];
+}
+
+sub _notEqualsString {
+	$_[0] ne $_[1];
+}
+
+sub _less {
+	$_[0] < $_[1];
+}
+
+sub _greater {
+	$_[0] > $_[1];
+}
+
+sub _lessString {
+	$_[0] lt $_[1];
+}
+
+sub _greaterString {
+	$_[0] gt $_[1];
+}
+
+sub _lessEq {
+	$_[0] <= $_[1];
+}
+
+sub _greaterEq {
+	$_[0] >= $_[1];
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::DOM::Schema::Validator::Compare> - ограничение на содержимое текущего узла,
+сравнивая его со значением другого узла.
+
+=head1 SYNOPSIS
+
+Пример типа описания поля с проверочным полем
+
+=begin code xml
+
+<schema>
+	<SimpleType type="retype_field">
+		<Property name="linkedNode" message="Для узла %Node.nodeName% необходимо задать свойство %Source.name%"/>
+		<Compare op="eq" nodePath="sibling:*[nodeName eq '%Node.linkedNode%']"/>
+	</SimpleType>
+</schema>
+
+=begin code xml
+
+=head1 DESCRIPTION
+
+Позволяет сравнивать значение текущего узла со значением другого узла. 
+
+=cut
\ No newline at end of file
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/Schema/Validator/RegExp.pm
--- a/Lib/IMPL/DOM/Schema/Validator/RegExp.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/Validator/RegExp.pm	Tue May 11 02:42:59 2010 +0400
@@ -17,21 +17,22 @@
 }
 
 sub CTOR {
-	my ($this) = @_;
+	my ($this,%args) = @_;
 	
-	$this->message("A %Node.nodeName% doesn't match to the format %Schema.name%");
+	$this->message($args{message} || "A %Node.nodeName% doesn't match to the format %Schema.display%");
 }
 
 sub Validate {
-	my ($this,$node) = @_;
+	my ($this,$node,$ctx) = @_;
 	
 	my $rx = $this->nodeValue;
 	return new IMPL::DOM::Schema::ValidationError(
 		Node => $node,
-		Source => $this,
+		Source => ( $ctx && $ctx->{Source} ) || $this->parentNode,
 		Schema => $this->parentNode,
 		Message => $this->message
 	) unless (not $node->isComplex) and $node->nodeValue =~ /$rx/;
+	return ();
 }
 
 1;
\ No newline at end of file
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/DOM/XMLReader.pm
--- a/Lib/IMPL/DOM/XMLReader.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/DOM/XMLReader.pm	Tue May 11 02:42:59 2010 +0400
@@ -6,6 +6,9 @@
 use IMPL::Class::Property;
 use IMPL::Class::Property::Direct;
 use XML::Parser;
+require IMPL::DOM::Schema;
+require IMPL::DOM::Navigator::Builder;
+require IMPL::DOM::Navigator::SimpleBuilder;
 
 __PACKAGE__->PassThroughArgs;
 
@@ -44,7 +47,6 @@
     $parser->parsefile($in);
 }
 
-
 sub _OnBegin {
     my ($this,$element,%attrs) = @_;
     
@@ -55,8 +57,7 @@
 
 sub _OnEnd {
     my ($this,$element) = @_;
-    
-    $this->{$_current}->nodeValue($this->Navigator->inflateValue( $this->{$_text} ) ) if length $this->{$_text};
+    $this->{$_current}->nodeValue($this->Navigator->inflateValue( $this->{$_text}, $this->{$_current} ) ) if length $this->{$_text};
     $this->{$_text} = pop @{$this->{$_textHistory}};
     $this->{$_current} = $this->Navigator->Back;
 }
@@ -66,6 +67,34 @@
     $this->{$_text} .= $val;
 }
 
+sub LoadDocument {
+	my ($self,$file,$schema) = @_;
+	
+	my $parser;
+	if ($schema) {
+		$schema = IMPL::DOM::Schema->LoadSchema($schema) if not ref $schema;
+		$parser = $self->new(
+			Navigator => IMPL::DOM::Navigator::Builder->new(
+				'IMPL::DOM::Document',
+				$schema
+			)
+		);
+	} else {
+		$parser = $self->new(
+			Navigator => IMPL::DOM::Navigator::SimpleBuilder->new()
+		);
+	}
+	
+	$parser->ParseFile($file);
+	my $doc = $parser->Navigator->Document;
+	if ($schema) {
+		my @errors = $parser->Navigator->BuildErrors;
+		push @errors, $schema->Validate($doc);
+		die new IMPL::Exception("Loaded document doesn't match the schema", @errors) if @errors;
+	}
+	return $doc;
+}
+
 1;
 
 __END__
diff -r c289ed9662ca -r 196bf443b5e1 Lib/IMPL/Resources/Format.pm
--- a/Lib/IMPL/Resources/Format.pm	Fri May 07 18:17:40 2010 +0400
+++ b/Lib/IMPL/Resources/Format.pm	Tue May 11 02:42:59 2010 +0400
@@ -7,26 +7,33 @@
 our @EXPORT_OK = qw(&FormatMessage);
 
 sub FormatMessage {
-    my ($string,$args) = @_;
+    my ($string,$args,$resolver) = @_;
     
-    $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]")/ge;
+    $resolver ||= \&_defaultResolver;
+    
+    $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]",$resolver)/ge;
     
     return $string;
 }
 
 sub _getvalue {
-    my ($obj,$path,$default) = @_;
+    my ($obj,$path,$default,$resolver) = @_;
     
     foreach my $chunk (split /\./,$path) {
-        if (eval { $obj->can( $chunk ) } ) {
-            $obj = $obj->$chunk();
-        } elsif (UNIVERSAL::isa($obj,'HASH')) {
+    	return $default unless $obj;
+        if (ref $obj eq 'HASH') {
             $obj = $obj->{$chunk};
         } else {
-            return $default;
+            $obj = $resolver->($obj,$chunk);
         }
     }
     return $obj;
 }
 
+sub _defaultResolver {
+	my ($obj,$prop) = @_;
+	
+	return ( eval { $obj->can($prop) } ? $obj->$prop() : undef );
+}
+
 1;
diff -r c289ed9662ca -r 196bf443b5e1 _test/temp.pl
--- a/_test/temp.pl	Fri May 07 18:17:40 2010 +0400
+++ b/_test/temp.pl	Tue May 11 02:42:59 2010 +0400
@@ -1,11 +1,7 @@
 #!/usr/bin/perl
 use strict;
 
-local $@;
+my $var = "  some stuff";
 
-{
-	eval 'die "boolshit"';
-	my $e = $@;
-	
-	die "msg: $e" if $e;
-}
\ No newline at end of file
+$var =~ tr/f/ome/;
+print $var;
\ No newline at end of file