# HG changeset patch
# User cin
# Date 1392135721 -14400
# Node ID 648dfaf642e0e4b78c100a82d24ea25bd01307ef
# Parent  4cc6cc370fb27a0b2d984d37e13026c5ea27c604
DOM refactoring,
removed inflators from DOM Schema,
DOM validation - in progress

diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Node.pm
--- a/Lib/IMPL/DOM/Node.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -393,7 +393,7 @@
 sub listProperties {
     my ($this) = @_;
     
-    my %props = map {$_->name, 1} $this->GetMeta(PropertyInfo, sub { $_->attributes->{domProperty}},1);
+    my %props = map {$_->name, 1} $this->GetMeta(PropertyInfo, sub { $_->attributes->{dom} },1);
     
     return (keys %props,keys %{$this->{$_propertyMap}});
 }
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Property.pm
--- a/Lib/IMPL/DOM/Property.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Property.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -9,7 +9,7 @@
 
 sub _dom($) {
     my ($prop_info) = @_;
-    $prop_info->{domProperty} = 1;
+    $prop_info->{dom} = 1;
     return $prop_info;
 }
 
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/ComplexNode.pm
--- a/Lib/IMPL/DOM/Schema/ComplexNode.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexNode.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -2,19 +2,18 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::Node);
-use IMPL::Class::Property;
+use IMPL::declare {
+	base => [
+		'IMPL::DOM::Schema::Node' => sub {my %args = @_; $args{nodeName} ||= 'ComplexNode'; %args }
+	],
+	props => [
+		content => {
+	        get => \&_getContent,
+	        set => \&_setContent
+	    }
+	]
+};
 
-BEGIN {
-    public property content => {
-        get => \&_getContent,
-        set => \&_setContent
-    }
-}
-
-our %CTOR = (
-    'IMPL::DOM::Schema::Node' => sub {my %args = @_; $args{nodeName} ||= 'ComplexNode'; %args }
-);
 
 sub _getContent {
     $_[0]->firstChild;
@@ -27,6 +26,10 @@
 sub Validate {
     my ($this,$node,$ctx) = @_;
     
+    # для случаев анонимных типов, указанных прямо в узле
+    $ctx->{schemaNode} ||= $this;
+    $ctx->{schemaType} = $this;
+    
     map $_->Validate($node,$ctx), @{$this->childNodes};
 }
 
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/ComplexType.pm
--- a/Lib/IMPL/DOM/Schema/ComplexType.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexType.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -2,26 +2,23 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::ComplexNode);
-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::ComplexNode' => sub {
-        my %args = @_;
-        $args{nodeName} ||= 'ComplexType';
-        $args{minOccur} = 0;
-        $args{maxOccur} = 'unbounded';
-        $args{name} ||= 'ComplexType';
-        delete @args{qw(nativeType messageWrongType)};
-        %args
-    }
-);
+use IMPL::declare {
+	base => [
+		'IMPL::DOM::Schema::ComplexNode' => sub {
+	        my %args = @_;
+	        $args{nodeName} ||= 'ComplexType';
+	        $args{minOccur} = 0;
+	        $args{maxOccur} = 'unbounded';
+	        $args{name} ||= 'ComplexType';
+	        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) = @_;
@@ -36,11 +33,12 @@
     if ($this->{$nativeType}) {
         return new IMPL::DOM::Schema::ValidationError(
             node => $node,
-            source => $ctx->{Source} || $this,
-            schema => $this,
+            schemaNode => $ctx->{schemaNode} || $this,
+            schemaType => $this,
             message => $this->messageWrongType
         ) unless $node->isa($this->{$nativeType});
     }
+    
     return $this->SUPER::Validate($node,$ctx);
 }
 
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/InflateFactory.pm
--- a/Lib/IMPL/DOM/Schema/InflateFactory.pm	Tue Feb 11 01:13:47 2014 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-package IMPL::DOM::Schema::InflateFactory;
-use strict;
-
-require IMPL::Exception;
-require IMPL::Object::Factory;
-
-sub new {
-    my ($self,$value,$schema) = @_;
-    
-    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;
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/Node.pm
--- a/Lib/IMPL/DOM/Schema/Node.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/Node.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -47,8 +47,10 @@
 sub Validate {
     my ($this,$node,$ctx) = @_;
     
+    $ctx->{schemaNode} = $this; # запоминаем источник ссылки
+    
     if (my $schemaType = $this->{$type} ? $this->document->ResolveType($this->{$type}) : undef ) {
-        my @errors = $schemaType->Validate($node,{Source => $this});
+        my @errors = $schemaType->Validate($node,$ctx);
         return @errors;
     } else {
         return ();
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/NodeList.pm
--- a/Lib/IMPL/DOM/Schema/NodeList.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeList.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -1,20 +1,21 @@
 package IMPL::DOM::Schema::NodeList;
 use strict;
 use warnings;
-use parent qw(IMPL::DOM::Node);
 
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-require IMPL::DOM::Schema::ValidationError;
 
-our %CTOR = (
-    'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
-);
-
-BEGIN {
-    public _dom property messageUnexpected => prop_all;
-    public _dom property messageNodesRequired => prop_all;
-}
+use IMPL::declare {
+	require => {
+		ValidationError => 'IMPL::DOM::Schema::ValidationError',
+		AnyNode => '-IMPL::DOM::Schema::AnyNode'
+	},
+	base => [
+		'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
+	],
+	props => [
+		messageUnexpected => { get => 1, set => 1, dom => 1 },
+		messageNodesRequired => { get => 1, set => 1, dom => 1}
+	]
+};
 
 sub CTOR {
     my ($this,%args) = @_;
@@ -27,40 +28,37 @@
     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 }
+        {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, 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
         while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
             # if possible of course :)
-            return new IMPL::DOM::Schema::ValidationError (
+            return ValidationError->new (
                 message => $this->messageUnexpected,
                 node => $child,
                 parent => $node,
-                schema => $info->{Schema},
-                source => $sourceSchema
+                schemaNode => $info->{schemaNode}
             ) if $info->{Min} > $info->{Seen};
             
             $info = shift @nodes;
         }
         
         # return error if no more children allowed
-        return new IMPL::DOM::Schema::ValidationError (
+        return ValidationError->new (
             message => $this->messageUnexpected,
             node => $child,
-            parent => $node,
-            source => $sourceSchema
+            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->{Schema}->Validate($child)) {
+        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;
diff -r 4cc6cc370fb2 -r 648dfaf642e0 Lib/IMPL/DOM/Schema/SimpleNode.pm
--- a/Lib/IMPL/DOM/Schema/SimpleNode.pm	Tue Feb 11 01:13:47 2014 +0400
+++ b/Lib/IMPL/DOM/Schema/SimpleNode.pm	Tue Feb 11 20:22:01 2014 +0400
@@ -2,36 +2,23 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::DOM::Schema::Node);
-use IMPL::Class::Property;
-use IMPL::DOM::Property qw(_dom);
-
-BEGIN {
-    public _dom _direct property inflator => prop_get;
-    public _dom _direct property messageInflateError => prop_get;
-}
-
-our %CTOR = (
-    'IMPL::DOM::Schema::Node' => sub {
-        my %args = @_;
-        $args{nodeName} ||= 'SimpleNode';
-        delete @args{qw(inflator messageInflateError)};
-        %args
-    }
-);
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    if ( $args{inflator} ) {
-        $this->{$inflator} = $args{inflator} ;
-        $this->{$messageInflateError} = exists $args{messageInflateError} ? $args{messageInflateError} : 'Failed to inflate nodeValue %node.path%: %error%';
-    }
-}
+use IMPL::declare {
+	base => [
+		'IMPL::DOM::Schema::Node' => sub {
+			my %args = @_;
+        	$args{nodeName} ||= 'SimpleNode';
+            %args
+		}
+	]
+};
 
 sub Validate {
     my ($this,$node,$ctx) = @_;
     
+    $ctx->{schemaNode} ||= $this; # для безымянных типов
+    
+    $ctx->{schemaType} = $this;
+    
     my @result;
     
     push @result, $_->Validate($node,$ctx) foreach $this->childNodes;
@@ -39,16 +26,6 @@
     return @result;
 }
 
-sub inflateValue {
-    my ($this,$value) = @_;
-    
-    if ( my $inflator = $this->inflator ) {
-        return $inflator->new($value,$this);
-    } else {
-        return $value;
-    }
-}
-
 1;
 
 __END__