# HG changeset patch # User wizard # Date 1273205123 -14400 # Node ID cf3b6ef2be22ece13f25b50626557097560378a1 # Parent d8dc6cad3f55e013c66c310dffeb05be7becec16 Schema beta version diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Navigator/Builder.pm --- 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); } } diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Node.pm --- 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 { diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema.pm --- 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') ) ); diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema/ComplexType.pm --- 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; diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema/NodeList.pm --- 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}; diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema/NodeSet.pm --- 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}; } diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema/SimpleType.pm --- 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; diff -r d8dc6cad3f55 -r cf3b6ef2be22 Lib/IMPL/DOM/Schema/ValidationError.pm --- 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}; } diff -r d8dc6cad3f55 -r cf3b6ef2be22 _test/Resources/types.xml --- 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 @@ ^\w+(\.\w+)*@$\w+(\.\w+)+ + diff -r d8dc6cad3f55 -r cf3b6ef2be22 _test/temp.pl --- 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