changeset 102:cf3b6ef2be22

Schema beta version
author wizard
date Fri, 07 May 2010 08:05:23 +0400
parents d8dc6cad3f55
children c289ed9662ca
files Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/DOM/Schema.pm Lib/IMPL/DOM/Schema/ComplexType.pm Lib/IMPL/DOM/Schema/NodeList.pm Lib/IMPL/DOM/Schema/NodeSet.pm Lib/IMPL/DOM/Schema/SimpleType.pm Lib/IMPL/DOM/Schema/ValidationError.pm _test/Resources/types.xml _test/temp.pl
diffstat 10 files changed, 52 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/DOM/Navigator/Builder.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Navigator/Builder.pm	Fri May 07 08:05:23 2010 +0400
@@ -42,6 +42,7 @@
         
         return $node;
     } else {
+    	warn $nodeName;
         die new IMPL::InvalidOperationException("The specified node is undefined", $nodeName);
     }
 }
--- a/Lib/IMPL/DOM/Node.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Fri May 07 08:05:23 2010 +0400
@@ -16,7 +16,7 @@
     public _direct property document => prop_get;
     public _direct property isComplex => { get => \&_getIsComplex } ;
     public _direct property nodeValue => prop_all;
-    public _direct property childNodes => { get => \&_getChildNodes };
+    public _direct property childNodes => { get => \&_getChildNodes }; # prop_list
     public _direct property parentNode => prop_get ;
     private _direct property _propertyMap => prop_all ;
 }
@@ -86,7 +86,7 @@
     my ($this) = @_;
     
     $this->{$childNodes} = new IMPL::Object::List() unless $this->{$childNodes};
-    return $this->{$childNodes};
+    return wantarray ? @{ $this->{$childNodes} } : $this->{$childNodes};
 }
 
 sub removeNode {
--- a/Lib/IMPL/DOM/Schema.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Fri May 07 08:05:23 2010 +0400
@@ -36,6 +36,12 @@
     $_[0]->{$_TypesMap}->{$_[1]};
 }
 
+sub CTOR {
+	my ($this,%args) = @_;
+	
+	$this->{$baseDir} = ($args{baseDir} || '.');
+}
+
 sub Create {
     my ($this,$nodeName,$class,$refArgs) = @_;
     
@@ -43,7 +49,6 @@
     
     if ($class->isa('IMPL::DOM::Schema::Validator')) {
     	$class = "IMPL::DOM::Schema::Validator::$nodeName";
-    	local $@;
     	unless (eval {$class->can('new')}) {
     		eval "require $class; 1;";
     		my $e = $@;
@@ -67,13 +72,15 @@
 sub Include {
 	my ($this,$file) = @_;
 	
-	my $schema = $this->LoadSchema($file);
+	my $schema = $this->LoadSchema(File::Spec->catfile($this->baseDir, $file));
 	
 	$this->appendRange( $schema->childNodes );
 }
 
 sub LoadSchema {
-	my ($this,$file,$base) = @_;
+	my ($this,$file) = @_;
+	
+	$file = File::Spec->rel2abs($file);
 	
 	my $class = ref $this || $this;
 	
@@ -84,7 +91,7 @@
 		)
 	);
 		
-	$reader->ParseFile($file) or die new IMPL::Exception("Failed to load a schema",$file);
+	$reader->ParseFile($file);
 	
 	my $schema = $reader->Navigator->Document;
 	
@@ -165,6 +172,7 @@
                     IMPL::DOM::Schema::Node->new(name => 'NodeSet', type => 'NodeSet'),
                     IMPL::DOM::Schema::Node->new(name => 'NodeList',type => 'NodeList'),
                 ),
+                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')
@@ -175,18 +183,21 @@
                     IMPL::DOM::Schema::Node->new(name => 'NodeSet', type => 'NodeSet'),
                     IMPL::DOM::Schema::Node->new(name => 'NodeList',type => 'NodeList'),
                 ),
+                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')
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'SimpleType', nativeType => 'IMPL::DOM::Schema::SimpleType')->appendRange(
-            IMPL::DOM::Schema::NodeSet->new()->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 => 'type')
         ),
         IMPL::DOM::Schema::ComplexType->new(type => 'SimpleNode', nativeType => 'IMPL::DOM::Schema::SimpleNode')->appendRange(
-            IMPL::DOM::Schema::NodeSet->new()->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')
@@ -195,6 +206,12 @@
             IMPL::DOM::Schema::NodeList->new()->appendRange(
                 IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
             )
+        ),
+        IMPL::DOM::Schema::ComplexType->new(type => 'Property', nativeType => 'IMPL::DOM::Schema::Property' )->appendRange(
+        	IMPL::DOM::Schema::NodeList->new()->appendRange(
+        		IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0)
+        	),
+        	IMPL::DOM::Schema::Property->new(name => 'name')
         )
     );
     
--- a/Lib/IMPL/DOM/Schema/ComplexType.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/ComplexType.pm	Fri May 07 08:05:23 2010 +0400
@@ -27,5 +27,9 @@
     $this->{$nativeType} = $args{nativeType};
 }
 
+sub qname {
+	$_[0]->nodeName.'[name='.$_[0]->type.']';
+}
+
 
 1;
--- a/Lib/IMPL/DOM/Schema/NodeList.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeList.pm	Fri May 07 08:05:23 2010 +0400
@@ -19,7 +19,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 %Node.path%');
+    $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Parent.path%');
 }
 
 sub Validate {
@@ -38,6 +38,7 @@
             return new IMPL::DOM::Schema::ValidationError (
                 Message => $this->messageUnexpected,
                 Node => $child,
+                Parent => $node,
                 Schema => $info->{Schema},
                 Source => $this
             ) if $info->{Min} > $info->{Seen};
@@ -49,6 +50,7 @@
         return new IMPL::DOM::Schema::ValidationError (
             Message => $this->messageUnexpected,
             Node => $child,
+            Parent => $node,
             Source => $this
         ) unless $info;
         
@@ -71,6 +73,7 @@
             Error => 1,
             Message => $this->messageUnexpected,
             Node => $child,
+            Parent => $node,
             Source => $this,
         ) if $info->{Max} and $info->{Seen} > $info->{Max};
     }
@@ -81,6 +84,7 @@
             Error => 1,
             Message => $this->messageNodesRequired,
             Source => $this,
+            Parent => $node,
             Schema => $info->{Schema}
         ) if $info->{Seen} < $info->{Min};
         
--- a/Lib/IMPL/DOM/Schema/NodeSet.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/NodeSet.pm	Fri May 07 08:05:23 2010 +0400
@@ -44,6 +44,7 @@
             push @errors,new IMPL::DOM::Schema::ValidationError (
                 Source => $this,
                 Node => $child,
+                Parent => $node,
                 Schema => $info->{Schema},
                 Message => $this->messageMax
             ) if ($info->{Max} and $info->{Seen} > $info->{Max});
@@ -55,6 +56,7 @@
             push @errors, new IMPL::DOM::Schema::ValidationError (
                 Source => $this,
                 Node => $child,
+                Parent => $node,
                 Message => $this->messageUnexpected
             )
         }
@@ -64,6 +66,7 @@
         push @errors, new IMPL::DOM::Schema::ValidationError (
             Source => $this,
             Schema => $info->{Schema},
+            Parent => $node,
             Message => $this->messageMin
         ) if $info->{Min} > $info->{Seen};
     }
--- a/Lib/IMPL/DOM/Schema/SimpleType.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/SimpleType.pm	Fri May 07 08:05:23 2010 +0400
@@ -27,5 +27,9 @@
     $this->{$nativeType} = $args{nativeType};
 }
 
+sub qname {
+	$_[0]->nodeName.'[name='.$_[0]->type.']';
+}
+
 
 1;
--- a/Lib/IMPL/DOM/Schema/ValidationError.pm	Thu May 06 17:55:59 2010 +0400
+++ b/Lib/IMPL/DOM/Schema/ValidationError.pm	Fri May 07 08:05:23 2010 +0400
@@ -11,6 +11,7 @@
     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;
 }
 
@@ -20,6 +21,7 @@
     $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};
     $this->{$Message} = FormatMessage(delete $args{Message}, \%args) if $args{Message};
 }
 
--- a/_test/Resources/types.xml	Thu May 06 17:55:59 2010 +0400
+++ b/_test/Resources/types.xml	Fri May 07 08:05:23 2010 +0400
@@ -1,6 +1,7 @@
 <schema>
 	<SimpleType type="email" nativeType="SCALAR">
 		<RegExp message="Неверный формат %Node.name_no%">^\w+(\.\w+)*@$\w+(\.\w+)+</RegExp>
+		<Property name='locale'/>
 	</SimpleType>
 	<SimpleType type="scalar" nativeType="SCALAR"/>
 	<SimpleType type="date" nativeType="DateTime">
--- a/_test/temp.pl	Thu May 06 17:55:59 2010 +0400
+++ b/_test/temp.pl	Fri May 07 08:05:23 2010 +0400
@@ -1,6 +1,11 @@
 #!/usr/bin/perl
 use strict;
 
-use IMPL::Security::Context;
+local $@;
 
-print IMPL::Security::Context->current->principal->name;
\ No newline at end of file
+{
+	eval 'die "boolshit"';
+	my $e = $@;
+	
+	die "msg: $e" if $e;
+}
\ No newline at end of file