diff Lib/IMPL/DOM/Schema/SimpleType.pm @ 389:5aff94ba842f

DOM Schema refactoring complete
author cin
date Wed, 12 Feb 2014 13:36:24 +0400
parents 4ddb27ff4a0b
children
line wrap: on
line diff
--- 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__