Mercurial > pub > Impl

changeset 389:5aff94ba842f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DOM Schema refactoring complete
author cin
date Wed, 12 Feb 2014 13:36:24 +0400
parents 648dfaf642e0
children de1f875e8875
files Lib/IMPL/DOM/Schema.pm Lib/IMPL/DOM/Schema/AnyNode.pm Lib/IMPL/DOM/Schema/ComplexType.pm Lib/IMPL/DOM/Schema/Label.pm Lib/IMPL/DOM/Schema/NodeList.pm Lib/IMPL/DOM/Schema/NodeSet.pm Lib/IMPL/DOM/Schema/Property.pm Lib/IMPL/DOM/Schema/SimpleType.pm Lib/IMPL/DOM/Schema/SwitchNode.pm Lib/IMPL/DOM/Schema/ValidationError.pm Lib/IMPL/DOM/Schema/Validator.pm Lib/IMPL/DOM/Schema/Validator/Compare.pm Lib/IMPL/DOM/Schema/Validator/RegExp.pm Lib/IMPL/DOM/XMLReader.pm Lib/IMPL/Web/View/Metadata/FormMeta.pm _test/Test/Web/View.pm
diffstat 16 files changed, 338 insertions(+), 242 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Schema.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -19,7 +19,6 @@
 	    Validator => 'IMPL::DOM::Schema::Validator',
 	    Builder => 'IMPL::DOM::Navigator::Builder',
 	    XMLReader => 'IMPL::DOM::XMLReader', # XMLReader references Schema
-	    InflateFactory => 'IMPL::DOM::Schema::InflateFactory',
 	    Loader => 'IMPL::Code::Loader',
 	    StringMap => 'IMPL::Resources::StringLocaleMap'
 	},
@@ -61,7 +60,7 @@
     return $type if $type;
     
     foreach my $base ($this->baseSchemas) {
-    	last if $type = $base->resolveType($typeName);
+    	last if $type = $base->ResolveType($typeName);
     }
     
     die IMPL::KeyNotFoundException->new($typeName)
@@ -242,16 +241,14 @@
                 Node->new(name => 'Property', type=>'Property', maxOccur=>'unbounded', minOccur=>0),
                 AnyNode->new(maxOccur => 'unbounded', minOccur => 0, type=>'Validator')
             ),
-            Property->new(name => 'type'),
-            Property->new(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
+            Property->new(name => 'type')
         ),
         ComplexType->new(type => 'SimpleNode', nativeType => 'IMPL::DOM::Schema::SimpleNode')->appendRange(
             NodeList->new()->appendRange(
                 Node->new(name => 'Property', type=>'Property', maxOccur=>'unbounded', minOccur=>0),
                 AnyNode->new(maxOccur => 'unbounded', minOccur => 0, type=>'Validator')
             ),
-            Property->new(name => 'name'),
-            Property->new(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
+            Property->new(name => 'name')
         ),
         ComplexType->new(type => 'Validator', nativeType => 'IMPL::DOM::Schema::Validator')->appendRange(
             NodeList->new()->appendRange(
@@ -262,8 +259,7 @@
             NodeList->new()->appendRange(
                 AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
             ),
-            Property->new(name => 'name'),
-            Property->new(name => 'inflator', optional => 1, inflator => 'IMPL::DOM::Schema::InflateFactory')
+            Property->new(name => 'name')
         ),
         SimpleType->new(type => 'Node', nativeType => 'IMPL::DOM::Schema::Node')->appendRange(
             Property->new(name => 'name'),
--- a/Lib/IMPL/DOM/Schema/AnyNode.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/AnyNode.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -2,17 +2,17 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::Node);
-
-our %CTOR = (
-    'IMPL::DOM::Schema::Node' => sub {
-        my %args = @_;
-        $args{nodeName} ||= 'AnyNode';
-        $args{name} = '::any';
-        
-        %args;
-    }
-);
+use IMPL::declare {
+	base => [
+		'IMPL::DOM::Schema::Node' => sub {
+	        my %args = @_;
+	        $args{nodeName} ||= 'AnyNode';
+	        $args{name} = '::any';
+	        
+	        %args;
+	    }
+	]
+};
 
 1;
 
--- a/Lib/IMPL/DOM/Schema/ComplexType.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexType.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -3,6 +3,10 @@
 use warnings;
 
 use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
 	base => [
 		'IMPL::DOM::Schema::ComplexNode' => sub {
 	        my %args = @_;
@@ -24,18 +28,18 @@
     my ($this,%args) = @_;
     
     $this->{$nativeType} = $args{nativeType};
-    $this->{$messageWrongType} = $args{messageWrongType} || "A complex node '%node.path%' is expected to be %schema.nativeType%";
+    $this->{$messageWrongType} = $args{messageWrongType} || "A complex node '%node.path%' is expected to be %schemaType.nativeType%";
 }
 
 sub Validate {
     my ($this, $node,$ctx) = @_;
     
     if ($this->{$nativeType}) {
-        return new IMPL::DOM::Schema::ValidationError(
+        return ValidationError->new (
             node => $node,
             schemaNode => $ctx->{schemaNode} || $this,
             schemaType => $this,
-            message => $this->messageWrongType
+            message => $this->_MakeLabel($this->messageWrongType)
         ) unless $node->isa($this->{$nativeType});
     }
     
@@ -46,5 +50,15 @@
     $_[0]->nodeName.'[type='.$_[0]->type.']';
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 
 1;
--- a/Lib/IMPL/DOM/Schema/Label.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Label.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -50,4 +50,10 @@
 	return $this->_map->GetString($this->_id);
 }
 
+sub Format {
+	my ($this,$args) = @_;
+	
+	return $this->_map->GetString($this->_id,$args);
+}
+
 1;
\ No newline at end of file
--- a/Lib/IMPL/DOM/Schema/NodeList.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeList.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -6,7 +6,8 @@
 use IMPL::declare {
 	require => {
 		ValidationError => 'IMPL::DOM::Schema::ValidationError',
-		AnyNode => '-IMPL::DOM::Schema::AnyNode'
+		AnyNode => '-IMPL::DOM::Schema::AnyNode',
+		Label => 'IMPL::DOM::Schema::Label'
 	},
 	base => [
 		'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
@@ -21,7 +22,7 @@
     my ($this,%args) = @_;
     
     $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
-    $this->messageNodesRequired($args{messageNodesRequired} || 'A %schema.name% is required in the node %parent.path%');
+    $this->messageNodesRequired($args{messageNodesRequired} || 'A %schemaNode.name% is required in the node %parent.path%');
 }
 
 sub Validate {
@@ -38,60 +39,67 @@
         while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
             # if possible of course :)
             return ValidationError->new (
-                message => $this->messageUnexpected,
+                message => $this->_MakeLabel( $this->messageUnexpected ),
                 node => $child,
                 parent => $node,
                 schemaNode => $info->{schemaNode}
-            ) if $info->{Min} > $info->{Seen};
+            ) if $info->{min} > $info->{seen}; # we trying to skip a schema node which has a quantifier
             
             $info = shift @nodes;
         }
         
         # return error if no more children allowed
         return ValidationError->new (
-            message => $this->messageUnexpected,
+            message => $this->_MakeLabel( $this->messageUnexpected ),
             node => $child,
             parent => $node
         ) unless $info;
         
         # it's ok, we found schema element for child
-        # but it may be any node or switching node wich would not satisfy current child
 
         # validate
-        while (my @errors = $info->{schemaNode}->Validate($child)) {
-            if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
+        while (my @errors = $info->{schemaNode}->Validate( $child ) ) {
+            if( $info->{anyNode} and $info->{seen} >= $info->{min} ) {
                 # in case of any or switch node, skip it if possible
                 next if $info = shift @nodes;
             }
             return @errors;
         }
         
-        $info->{Seen}++;
+        $info->{seen}++;
         
         # check count limits
-        return new IMPL::DOM::Schema::ValidationError (
-            message => $this->messageUnexpected,
+        return ValidationError->new(
+            message => $this->_MakeLabel( $this->messageUnexpected ),
             node => $child,
             parent => $node,
-            source => $sourceSchema,
-        ) if $info->{Max} and $info->{Seen} > $info->{Max};
+            schemaNode => $info->{schemaNode},
+        ) if $info->{max} and $info->{seen} > $info->{max};
     }
     
     # no more children left (but may be should :)
     while ($info) {
-        return new IMPL::DOM::Schema::ValidationError (
-            error => 1,
-            message => $this->messageNodesRequired,
-            source => $sourceSchema,
+        return ValidationError->new(
+            message => $this->_MakeLabel( $this->messageNodesRequired ),
             parent => $node,
-            schema => $info->{Schema}
-        ) if $info->{Seen} < $info->{Min};
+            schemaNode => $info->{schemaNode}
+        ) if $info->{seen} < $info->{min};
         
         $info = shift @nodes;
     }
     return;
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/DOM/Schema/NodeSet.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeSet.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -2,25 +2,28 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Node);
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-
-our %CTOR = (
-    'IMPL::DOM::Node' => sub { nodeName => 'NodeSet' }
-);
-
-BEGIN {
-    public _dom property messageUnexpected => prop_all;
-    public _dom property messageMax => prop_all;
-    public _dom property messageMin => prop_all;
-}
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError',
+		AnyNode => '-IMPL::DOM::Schema::AnyNode'
+	},
+	base => [
+		'IMPL::DOM::Node' => sub { nodeName => 'NodeSet' }
+	],
+	props => [
+		messageUnexpected => { get => 1, set => 1, dom => 1},
+		messageMax => { get => 1, set => 1, dom => 1},
+		messageMin => { get => 1, set => 1, dom => 1}
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
     
     $this->messageMax( $args{messageMax} || 'Too many %node.nodeName% nodes');
-    $this->messageMin( $args{messageMin} || '%schema.name% nodes expected');
+    $this->messageMin( $args{messageMin} || '%schemaNode.name% nodes expected');
     $this->messageUnexpected( $args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
 }
 
@@ -31,52 +34,58 @@
     
     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 };
+        if ($_->isa(AnyNode)) {
+            $anyNode = {schemaNode => $_, min => $_->minOccur, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , seen => 0 };
         } else {
-            $nodes{$_->name} = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 };
+            $nodes{$_->name} = {schemaNode => $_, min => $_->minOccur, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , seen => 0 };
         }
     }
     
     foreach my $child ( @{$node->childNodes} ) {
         if (my $info = $nodes{$child->nodeName} || $anyNode) {
-            $info->{Seen}++;
-            push @errors,new IMPL::DOM::Schema::ValidationError (
-                source => $sourceSchema,
+            $info->{seen}++;
+            push @errors,ValidationError->new(
+                schemaNode => $info->{schemaNode},
                 node => $child,
                 parent => $node,
-                schema => $info->{Schema},
-                message => $this->messageMax
-            ) if ($info->{Max} and $info->{Seen} > $info->{Max});
+                message =>  $this->_MakeLabel($this->messageMax)
+            ) if ($info->{max} and $info->{seen} > $info->{max});
             
-            if (my @localErrors = $info->{Schema}->Validate($child)) {
+            if (my @localErrors = $info->{schemaNode}->Validate($child)) {
                 push @errors,@localErrors;
             }
         } else {
-            push @errors, new IMPL::DOM::Schema::ValidationError (
-                source => $sourceSchema,
+            push @errors, ValidationError->new(
                 node => $child,
                 parent => $node,
-                message => $this->messageUnexpected
+                message => $this->_MakeLabel($this->messageUnexpected)
             )
         }
     }
     
     foreach my $info (values %nodes) {
-        push @errors, new IMPL::DOM::Schema::ValidationError (
-            source => $sourceSchema,
-            schema => $info->{Schema},
+        push @errors, ValidationError->new(
+            schemaNode => $info->{schemaNode},
             parent => $node,
-            message => $this->messageMin
-        ) if $info->{Min} > $info->{Seen};
+            message => $this->_MakeLabel($this->messageMin)
+        ) if $info->{min} > $info->{seen};
     }
     
     return @errors;
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/DOM/Schema/Property.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Property.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -2,56 +2,66 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::SimpleNode);
-require IMPL::DOM::Node;
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-
-__PACKAGE__->PassThroughArgs;
-
-BEGIN {
-    public _dom property messageRequired => prop_all;
-}
-
-our %CTOR = (
-    'IMPL::DOM::Schema::SimpleNode' => sub {
-        my %args = @_;
-        
-        $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;
-    }
-);
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		DOMNode => 'IMPL::DOM::Node',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
+	base => [
+		'IMPL::DOM::Schema::SimpleNode' => sub {
+	        my %args = @_;
+	        
+	        $args{maxOccur} = 1;
+	        $args{minOccur} = delete $args{optional} ? 0 : 1;
+	        $args{nodeName} ||= 'Property';
+	        
+	        return %args;
+	    }
+	],
+	props => [
+		messageRequired => { get => 1, set => 1, dom => 1 }
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->messageRequired($args{messageRequired} || 'A property %schema.name% is required in the %node.qname%');
+    $this->messageRequired($args{messageRequired} || 'A property %schemaNode.name% is required in the %node.qname%');
 }
 
 sub Validate {
     my ($this,$node,$ctx) = @_;
     
-    my $prop = $this->name;
-    # buld a pseudo node for the property value 
-    my $nodeProp = new IMPL::DOM::Node(nodeName => '::property', nodeValue => eval { $node->$prop() } || $node->nodeProperty($prop));
+    my $nodeValue = $node->nodeProperty($this->name);
         
-    if ($nodeProp->nodeValue) {
-        # we have a value so validate it
-        return $this->SUPER::Validate($nodeProp,$ctx);
+    if (length $nodeValue) {
+    	# we have a value so validate it
+    	
+    	# buld a pseudo node for the property value 	
+    	my $nodeProp = DOMNode->new(nodeName => '::property', nodeValue => $nodeValue);
+        
+        return $this->SUPER::Validate($nodeProp);
+        
     } elsif($this->minOccur) {
         # we don't have a value but it's a mandatory property
-        return new IMPL::DOM::Schema::ValidationError(
-            message => $this->messageRequired,
+        return ValidationError->new(
+            message => $this->_MakeLabel($this->messageRequired),
             node => $node,
-            schema => $this,
-            source => $ctx && $ctx->{Source} || $this
+            schemaNode => $this
         );
     }
     return ();
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
--- a/Lib/IMPL/DOM/Schema/SimpleType.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/SimpleType.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -2,43 +2,44 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::SimpleNode);
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-
-BEGIN {
-    public _dom _direct property nativeType => prop_get;
-    public _dom _direct property messageWrongType => prop_get;
-}
-
-our %CTOR = (
-    'IMPL::DOM::Schema::SimpleNode' => sub {
-        my %args = @_;
-        $args{nodeName} = 'SimpleType';
-        $args{minOccur} = 0;
-        $args{maxOccur} = 'unbounded';
-        $args{name} ||= 'SimpleType';
-        delete @args{qw(nativeType messageWrongType)};
-        %args
-    }
-);
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
+	base => [
+		'IMPL::DOM::Schema::SimpleNode' => sub {
+	        my %args = @_;
+	        $args{nodeName} = 'SimpleType';
+	        $args{minOccur} = 0;
+	        $args{maxOccur} = 'unbounded';
+	        $args{name} ||= 'SimpleType';
+	        delete @args{qw(nativeType messageWrongType)};
+	        %args
+	    }
+	],
+	props => [
+		nativeType => { get => 1, set => 1, direct => 1, dom => 1},
+		messageWrongType => { get => 1, set => 1, direct => 1, dom => 1 }
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
     
     $this->{$nativeType} = $args{nativeType} if $args{nativeType};
-    $this->{$messageWrongType} = $args{messageWrongType} || "A simple node '%node.path%' is expected to be %schema.nativeType%"; 
+    $this->{$messageWrongType} = $args{messageWrongType} || "A simple node '%node.path%' is expected to be %schemaType.nativeType%"; 
 }
 
 sub Validate {
     my ($this, $node, $ctx) = @_;
     
     if ($this->{$nativeType}) {
-        return new IMPL::DOM::Schema::ValidationError(
+        return ValidationError->new(
             node => $node,
-            source => $ctx && $ctx->{Source} || $this,
-            schema => $this,
-            message => $this->messageWrongType
+            schemaNode => $ctx->{schemaNode} || $this,
+            schemaType => $this,
+            message => $this->_MakeLabel($this->messageWrongType)
         ) unless $node->isa($this->{$nativeType});
     }
     return $this->SUPER::Validate($node,$ctx);
@@ -48,6 +49,16 @@
     $_[0]->nodeName.'[type='.$_[0]->type.']';
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/DOM/Schema/SwitchNode.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/SwitchNode.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -2,24 +2,24 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::AnyNode);
-use IMPL::Class::Property;
-require IMPL::DOM::Schema::ValidationError;
-use IMPL::DOM::Property qw(_dom);
-
-our %CTOR = (
-    'IMPL::DOM::Schema::AnyNode' => sub {
-        my %args = @_;
-        
-        $args{nodeName} ||= 'SwitchNode';
-        
-        %args;
-    }
-);
-
-BEGIN {
-    public _dom property messageNoMatch => prop_all;
-}
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
+	base => [
+		'IMPL::DOM::Schema::AnyNode' => sub {
+	        my %args = @_;
+	        
+	        $args{nodeName} ||= 'SwitchNode';
+	        
+	        %args;
+	    }
+	],
+	props => [
+		messageNoMatch => { get => 1, set => 1, dom => 1 } 
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
@@ -31,16 +31,25 @@
     my ($this,$node,$ctx) = @_;
         
     if ( my ($schema) = $this->selectNodes(sub {$_[0]->name eq $node->nodeName} ) ) {
-        return $schema->Validate($node);
+        return $schema->Validate($node,$ctx);
     } else {
-        return new IMPL::DOM::Schema::ValidationError(
+        return ValidationError->new(
             node => $node,
-            source => $this,
-            message => $this->messageNoMatch
+            message => $this->_MakeLabel($this->messageNoMatch)
         );
     }
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
 
 __END__
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/ValidationError.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -6,24 +6,32 @@
     '""' => \&toString,
     'fallback' => 1;
 
-use parent qw(IMPL::Object);
-use IMPL::Class::Property;
+use IMPL::lang qw(is);
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Label => '-IMPL::DOM::Schema::Label' 
+	},
+	base => [
+		'IMPL::Object' => undef
+	],
+	props => [
+		node => PROP_RO | PROP_DIRECT,
+		schemaNode => PROP_RO | PROP_DIRECT,
+		schemaType => PROP_RO | PROP_DIRECT,
+		parent => PROP_RO | PROP_DIRECT,
+		message => PROP_RO | PROP_DIRECT  
+	]
+};
 use IMPL::Resources::Format qw(FormatMessage);
 
-BEGIN {
-    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 {
     my ($this,%args) = @_;
     
     $this->{$node} = $args{node};
-    $this->{$schema} = $args{schema} if $args{schema};
-    $this->{$source} = $args{source} if $args{source};
+    $this->{$schemaNode} = $args{schemaNode} if $args{schemaNode};
+    $this->{$schemaType} = $args{schemaType} if $args{schemaType};
+    
     if ($args{parent}) {
         $this->{$parent} = $args{parent};
     } elsif ($args{node}) {
@@ -32,13 +40,10 @@
         die new IMPL::InvalidArgumentException("A 'parent' or a 'node' parameter is required");
     }
     
-    if(my $msg = $args{message}) {
-    	if (my($msgId) = ( $msg =~ /^ID:([\w\.]+)$/ ) ) {
-    		$this->{$message} = ($args{schema} || $args{source})->document->stringMap->GetString($msgId, \%args);
-    	} else {
-    		$this->{$message} = FormatMessage(delete $args{message}, \%args) if $args{message};
-    	}
+    if ($args{message}) {
+    	$this->{$message} = is($args{message},Label) ? $args{message}->Format(\%args) : FormatMessage($args{message}, \%args) ;
     }
+    
 }
 
 sub toString {
--- a/Lib/IMPL/DOM/Schema/Validator.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Validator.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -1,10 +1,12 @@
 package IMPL::DOM::Schema::Validator;
 use strict;
-use parent qw(IMPL::DOM::Node);
 
 require IMPL::Exception;
-
-__PACKAGE__->PassThroughArgs;
+use IMPL::declare {
+	base => [
+		'IMPL::DOM::Node' => '@_'
+	]
+};
 
 sub Validate {
     my ($this,$node) = @_;
--- a/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Validator/Compare.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -1,30 +1,32 @@
 package IMPL::DOM::Schema::Validator::Compare;
 use strict;
 
-use parent qw(IMPL::DOM::Schema::Validator);
-
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
+	base => [
+		'IMPL::DOM::Schema::Validator' => sub {
+	        my %args = @_;
+	        $args{nodeName} ||= 'Compare';
+	        delete @args{qw(targetProperty op nodePath optional message)};
+	        %args;
+	    }
+	],
+	props => [
+		targetProperty => PROP_RW,
+		op => PROP_RW,
+		nodePath => PROP_RW,
+		optional => PROP_RW,
+		_pathTranslated => PROP_RW,
+		_targetNode => PROP_RW,
+		_schemaNode => PROP_RW,
+		message => PROP_RW
+	] 
+};
 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_all;
-    public property optional => prop_all;
-    private property _pathTranslated => prop_all;
-    private property _targetNode => prop_all;
-    private property _sourceSchema => prop_all;
-    public property message => prop_all;
-}
-
-our %CTOR = (
-    'IMPL::DOM::Schema::Validator' => sub {
-        my %args = @_;
-        $args{nodeName} ||= 'Compare';
-        delete @args{qw(targetProperty op nodePath optional message)};
-        %args;
-    }
-);
 
 our %Ops = (
     '='  => \&_equals,
@@ -47,7 +49,7 @@
     $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->message($args{message} || 'The value of %node.path% %schemaNode.op% %value% (%schemaNode.nodePath%)' );
     $this->optional($args{optional}) if $args{optional};
 }
 
@@ -94,8 +96,10 @@
                             Schema => $this->parentNode,
                             Node => $this->_targetNode,
                             schema => $this->parentNode,
+                            schemaType => $this->parentNode,
                             node => $this->_targetNode,
-                            source => $this->_sourceSchema
+                            source => $this->_schemaNode,
+                            schemaNode => $this->_schemaNode
                         },\&_resovleProperty)
                     ) or return 0 foreach @parsedFilters;
                 return 1;
@@ -117,9 +121,10 @@
     
     my @result;
     
-    my $Source = $ctx && $ctx->{Source} || $this->parentNode;
+    my $schemaNode = $ctx->{schemaNode};
+    my $schemaType = $ctx->{schemaType};
     
-    $this->_sourceSchema($Source);
+    $this->_schemaNode($schemaNode);
     
     $this->_targetNode($node);
     
@@ -138,26 +143,26 @@
             $value = $foreignNode->nodeValue;
         }
         
-        push @result, new IMPL::DOM::Schema::ValidationError(
+        push @result, ValidationError->new(
             node => $node,
             foreignNode => $foreignNode,
             value => $value,
-            source => $Source,
-            schema => $this->parentNode,
-            message => $this->message
+            schemaNode => $schemaNode,
+            schemaType => $schemaType,
+            message => $this->_MakeLabel($this->message)
         ) unless $this->op->(_resovleProperty($node,$this->targetProperty),$value);
     } elsif (not $this->optional) {
-        push @result,  new IMPL::DOM::Schema::ValidationError(
+        push @result, ValidationError->new(
             node => $node,
             value => '',
-            source => $Source,
-            schema => $this->parentNode,
-            message => $this->message
+            schemaNode => $schemaNode,
+            schemaType => $schemaType,
+            message => $this->_MakeLabel( $this->message )
         );
     }
     
     $this->_targetNode(undef);
-    $this->_sourceSchema(undef);
+    $this->_schemaNode(undef);
     
     return @result;
 }
@@ -216,6 +221,16 @@
     $_[0] >= $_[1];
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
 
 __END__
@@ -235,8 +250,8 @@
 
 <schema>
     <SimpleType type="retype_field">
-        <Property name="linkedNode" message="Для узла %Node.nodeName% необходимо задать свойство %Source.name%"/>
-        <Compare op="eq" nodePath="sibling:*[nodeName eq '%Node.linkedNode%']"/>
+        <Property name="linkedNode" message="Для узла %node.nodeName% необходимо задать свойство %schemaNode.name%"/>
+        <Compare op="eq" nodePath="sibling:*[nodeName eq '%node.linkedNode%']"/>
     </SimpleType>
 </schema>
 
--- a/Lib/IMPL/DOM/Schema/Validator/RegExp.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Validator/RegExp.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -1,27 +1,30 @@
 package IMPL::DOM::Schema::Validator::RegExp;
 use strict;
-use parent qw(IMPL::DOM::Schema::Validator);
 
-our %CTOR = (
-    'IMPL::DOM::Schema::Validator' => sub {
-        my %args = @_;
-        $args{nodeName} ||= 'RegExp';
-        %args;
-    }
-);
-
-use IMPL::Class::Property;
-
-BEGIN {
-    public property message => prop_all;
-    public property launder => prop_all;
-    private property _rx => prop_all;
-}
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Label => 'IMPL::DOM::Schema::Label',
+		ValidationError => 'IMPL::DOM::Schema::ValidationError'
+	},
+	base => [
+		'IMPL::DOM::Schema::Validator' => sub {
+	        my %args = @_;
+	        $args{nodeName} ||= 'RegExp';
+	        %args;
+	    }
+	],
+	props => [
+		message => { get => 1, set =>1, dom =>1 },
+		launder => { get => 1, set =>1, dom =>1 },
+		_rx => { get=> 1, set=> 1}
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
     
-    $this->message($args{message} || "A %node.nodeName% doesn't match to the format %schema.display%");
+    $this->message($args{message} || "A %node.nodeName% doesn't match to the format %schemaNode.label%");
 }
 
 sub Validate {
@@ -29,11 +32,11 @@
     
     my $rx = $this->_rx() || $this->_rx( map qr{$_}, $this->nodeValue );
     
-    return new IMPL::DOM::Schema::ValidationError(
+    return ValidationError->new (
         node => $node,
-        source => $ctx && $ctx->{Source} || $this->parentNode,
-        schema => $this->parentNode,
-        message => $this->message
+        schemaNode => $ctx->{schemaNode},
+        schemaType => $ctx->{schemaType},
+        message => $this->_MakeLabel($this->message)
     ) unless (not $node->isComplex) and $node->nodeValue =~ /($rx)/;
     
     $node->nodeValue($1) if $this->launder;
@@ -41,4 +44,14 @@
     return ();
 }
 
+sub _MakeLabel {
+	my ($this,$label) = @_;
+	
+	if ($label =~ /^ID:(\w+)$/) {
+		return Label->new($this->document->stringMap, $1);
+	} else {
+		return $label;
+	}
+}
+
 1;
--- a/Lib/IMPL/DOM/XMLReader.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/DOM/XMLReader.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -93,7 +93,6 @@
     my $doc = $parser->Navigator->Document;
     my @errors;
     if ($schema) {
-        @errors = $parser->Navigator->BuildErrors;
         push @errors, $schema->Validate($doc);
     }
     
--- a/Lib/IMPL/Web/View/Metadata/FormMeta.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/Lib/IMPL/Web/View/Metadata/FormMeta.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -95,9 +95,8 @@
 
 sub _IsOwnError {
     my ($nodes,$source,$err) = @_;
-
-    #TODO: review filter
- 	return 1 if ($err->node && grep($err->node == $_, @$nodes)) || (not(@$nodes) && $err->schema == $source );
+    
+ 	return 1 if ($err->node && grep($err->node == $_, @$nodes)) || (not(@$nodes) && $err->schemaNode && $err->schemaNode == $source );
     
     return 0;
 }
--- a/_test/Test/Web/View.pm	Tue Feb 11 20:22:01 2014 +0400
+++ b/_test/Test/Web/View.pm	Wed Feb 12 13:36:24 2014 +0400
@@ -59,10 +59,10 @@
 		
 		my $meta = FormMeta->new(
 			$doc,
-			$doc->schemaSource->type,
+			$doc->schemaNode->type,
 			{
-				decl => $doc->schemaSource,
-				schema => $doc->schema,
+				decl => $doc->schemaNode,
+				schema => $doc->schemaType,
 				errors => $errors
 			}
 		);