# HG changeset patch # User Sergey # Date 1252672239 -14400 # Node ID 1ca530e5c9c5e2fb652ffba8a7f9f2648be1f3bf # Parent 818c74b038ae539755ad55f336d56e59527d2cac DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema.pm --- a/Lib/IMPL/DOM/Schema.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema.pm Fri Sep 11 16:30:39 2009 +0400 @@ -2,6 +2,15 @@ use strict; use warnings; +require IMPL::DOM::Schema::ComplexNode; +require IMPL::DOM::Schema::ComplexType; +require IMPL::DOM::Schema::SimpleNode; +require IMPL::DOM::Schema::SimpleType; +require IMPL::DOM::Schema::Node; +require IMPL::DOM::Schema::AnyNode; +require IMPL::DOM::Schema::NodeList; +require IMPL::DOM::Schema::NodeSet; + use base qw(IMPL::DOM::Document); use IMPL::Class::Property; use IMPL::Class::Property::Direct; @@ -12,7 +21,7 @@ private _direct property _TypesMap => prop_all; } -sub ResoveType { +sub resolveType { $_[0]->{$_TypesMap}->{$_[1]}; } @@ -22,8 +31,19 @@ $this->{$_TypesMap} = { map { $_->type, $_ } grep {$_->isa('IMPL::DOM::Schema::Type')} @{$this->childNodes} }; } +sub Validate { + my ($this,$node) = @_; + + #return IMPL::DOM::Schema::NodeSet->new()->appendRange(@{$this->childNodes})->Validate($node); +} + +my $schema; + sub MetaSchema { - my $schema = new IMPL::DOM::Schema(nodeName => 'schema'); + + return $schema if $schema; + + $schema = new IMPL::DOM::Schema(nodeName => 'schema'); $schema->appendRange( IMPL::DOM::Schema::ComplexNode->new(nodeName => 'schema')->appendRange( @@ -34,44 +54,44 @@ IMPL::DOM::Schema::Node->new(nodeName => 'SimpleType', type => 'SimpleType', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Node', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Include', minOccur => 0, maxOccur=>'unbounded') - ) + ), ), - IMPL::DOM::Schema::ComplexType->new(type => 'NodeSet', native => 'IMPL::DOM::Schema::NodeSet')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'NodeSet', nativeType => 'IMPL::DOM::Schema::NodeSet')->appendRange( IMPL::DOM::Schema::NodeSet->new()->appendRange( IMPL::DOM::Schema::Node->new(nodeName => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::Node->new(nodeName => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Node', minOccur => 0, maxOccur=>'unbounded'), ) ), - IMPL::DOM::Schema::ComplexType->new(type => 'NodeList', native => 'IMPL::DOM::Schema::NodeList')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'NodeList', nativeType => 'IMPL::DOM::Schema::NodeList')->appendRange( IMPL::DOM::Schema::NodeSet->new()->appendRange( IMPL::DOM::Schema::Node->new(nodeName => 'ComplexNode', type => 'ComplexNode', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::Node->new(nodeName => 'SimpleNode', type => 'SimpleNode', minOccur => 0, maxOccur=>'unbounded'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Node', minOccur => 0, maxOccur=>'unbounded'), ) ), - IMPL::DOM::Schema::ComplexType->new(type => 'ComplexType', native => 'IMPL::DOM::Schema::ComplexType')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'ComplexType', nativeType => 'IMPL::DOM::Schema::ComplexType')->appendRange( IMPL::DOM::Schema::NodeList->new()->appendRange( IMPL::DOM::Schema::Node->new(nodeName => 'NodeSet', minOccur => 0, type => 'NodeSet'), IMPL::DOM::Schema::Node->new(nodeName => 'NodeList', minOccur => 0, type => 'NodeSet'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Node', minOccur => 0, maxOccur => 'unbounded') ) ), - IMPL::DOM::Schema::ComplexType->new(type => 'ComplexNode', native => 'IMPL::DOM::Schema::ComplexNode')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'ComplexNode', nativeType => 'IMPL::DOM::Schema::ComplexNode')->appendRange( IMPL::DOM::Schema::NodeList->new()->appendRange( IMPL::DOM::Schema::Node->new(nodeName => 'NodeSet', minOccur => 0, type => 'NodeSet'), IMPL::DOM::Schema::Node->new(nodeName => 'NodeList', minOccur => 0, type => 'NodeSet'), IMPL::DOM::Schema::SimpleNode->new(nodeName => 'Node', minOccur => 0, maxOccur => 'unbounded') ) ), - IMPL::DOM::Schema::ComplexType->new(type => 'SimpleType', native => 'IMPL::DOM::Schema::SimpleType')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'SimpleType', nativeType => 'IMPL::DOM::Schema::SimpleType')->appendRange( IMPL::DOM::Schema::NodeSet->new()->appendRange( - IMPL::DOM::Schema::AnyNode(maxOccur => 'unbounded', minOccur => 0) + IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0) ) ), - IMPL::DOM::Schema::ComplexType->new(type => 'SimpleNode', native => 'IMPL::DOM::Schema::SimpleNode')->appendRange( + IMPL::DOM::Schema::ComplexType->new(type => 'SimpleNode', nativeType => 'IMPL::DOM::Schema::SimpleNode')->appendRange( IMPL::DOM::Schema::NodeSet->new()->appendRange( - IMPL::DOM::Schema::AnyNode(maxOccur => 'unbounded', minOccur => 0) + IMPL::DOM::Schema::AnyNode->new(maxOccur => 'unbounded', minOccur => 0) ) ) ); diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/AnyNode.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Schema/AnyNode.pm Fri Sep 11 16:30:39 2009 +0400 @@ -0,0 +1,25 @@ +package IMPL::DOM::Schema::AnyNode; +use strict; +use warnings; + +use base qw(IMPL::DOM::Schema::Node); + +our %CTOR = ( + 'IMPL::DOM::Schema::Node' => sub { nodeName => 'AnyNode'} +); + +1; + +__END__ + +=pod + +=head1 DESCRIPTION + + , + . , + , + , + . + +=cut \ No newline at end of file diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/ComplexNode.pm --- a/Lib/IMPL/DOM/Schema/ComplexNode.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema/ComplexNode.pm Fri Sep 11 16:30:39 2009 +0400 @@ -25,15 +25,7 @@ sub Validate { my ($this,$node) = @_; - if (my $type = $this->nodeType) { - my $schemaType = $this->Schema->ResolveType($type); - return $schemaType->Validate($node); - } else { - my @errors; - push @errors, $_->Validate foreach @{$this->childNodes}; - - return @errors; - } + map $_->Validate($node), @{$this->childNodes}; } 1; diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/ComplexType.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Schema/ComplexType.pm Fri Sep 11 16:30:39 2009 +0400 @@ -0,0 +1,30 @@ +package IMPL::DOM::Schema::ComplexType; +use strict; +use warnings; + +use base qw(IMPL::DOM::Schema::ComplexNode); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property nativeType => prop_get; +} + +our %CTOR = ( + 'IMPL::DOM::Schema::ComplexNode' => sub { + my %args = @_; + $args{nodeName} = 'ComplexNode'; + $args{minOccur} = 0; + $args{maxOccur} = 'unbounded'; + %args + } +); + +sub CTOR { + my ($this,%args) = @_; + + $this->{$nativeType} = $args{nativeType}; +} + + +1; diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/Node.pm --- a/Lib/IMPL/DOM/Schema/Node.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema/Node.pm Fri Sep 11 16:30:39 2009 +0400 @@ -8,9 +8,9 @@ use IMPL::Class::Property::Direct; BEGIN { - public _dom property minOccur => prop_all; - public _dom property maxOccur => prop_all; - public _dom property type => prop_all + public property minOccur => prop_all; + public property maxOccur => prop_all; + public property type => prop_all } __PACKAGE__->PassThroughArgs; @@ -18,11 +18,19 @@ sub CTOR { my ($this,%args) = @_; - $this->minOccur($args{minOcuur}); - $this->maxOccur($args{maxOccur}); + $this->minOccur(defined $args{minOcuur} ? $args{minOcuur} : 1); + $this->maxOccur(defined $args{maxOccur} ? $args{maxOccur} : 1); $this->type($args{type}); } +sub Validate { + my ($this,$node) = @_; + + if (my $schemaType = $this->type ? $this->rootNode->resolveType($this->type) : undef ) { + return $schemaType->Validate($node); + } +} + 1; __END__ diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/NodeList.pm --- a/Lib/IMPL/DOM/Schema/NodeList.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema/NodeList.pm Fri Sep 11 16:30:39 2009 +0400 @@ -1,55 +1,67 @@ package IMPL::DOM::Schema::NodeList; use strict; use warnings; -use base qw(IMPL::DOM::Schema::Item); +use base qw(IMPL::DOM::Node); + use IMPL::Class::Property; +require IMPL::DOM::Schema::ValidationError; + +our %CTOR = ( + 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' } +); BEGIN { - public property MessageUnexpected => prop_all; - public property MessageNodesRequired => prop_all; + public property messageUnexpected => prop_all; + public property messageNodesRequired => prop_all; +} + +sub CTOR { + my ($this,%args) = @_; + + $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here'); + $this->messageNodesRequired($args{messageNodesRequired} || 'A content of the node %Node.nodeName% is incomplete'); } sub Validate { my ($this,$node) = @_; my @nodes = map { - {nodeName => $_->nodeName, Schema => $_, Min => $_->minOccur, Max => $_->maxOccur, Seen => 0 } + {nodeName => $_->nodeName, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Min => $_->minOccur eq 'unbounded' ? undef : $_->maxOccur, Max => $_->maxOccur, Seen => 0 } } @{$this->childNodes}; my $info = shift @nodes; foreach my $child ( @{$node->childNodes} ) { #skip schema elements - while ($info and $info->{nodeName} ne $child->nodeName) { + while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { # if possible of course :) - return { - Error => 1, - Message => $this->MessageUnexpected, + return new IMPL::DOM::Schema::VaidationError ( + Message => $this->messageUnexpected, Node => $child, + Schema => $info->{Schema}, Source => $this - } if $info->{Min} > $info->{Seen}; + ) if $info->{Min} > $info->{Seen}; $info = shift @nodes; } # return error if no more children allowed - return { - Error => 1, - Message => $this->MessageUnexpected, + return new IMPL::DOM::Schema::VaidationError ( + Message => $this->messageUnexpected, Node => $child, Source => $this - } unless $info; + ) unless $info; # it's ok, we found schema element for him $info->{Seen}++; # check count limits - return { + return new IMPL::DOM::Schema::VaidationError ( Error => 1, - Message => $this->MessageUnexpected, + Message => $this->messageUnexpected, Node => $child, Source => $this, - } if $info->{Seen} > $info->{Max}; + ) if $info->{Max} and $info->{Seen} > $info->{Max}; # validate if (my @errors = $info->{Schema}->Validate($child)) { @@ -59,11 +71,12 @@ # no more children left (but may be should :) while ($info) { - return { + return new IMPL::DOM::Schema::VaidationError ( Error => 1, - Message => $this->MessageNodesRequired, + Message => $this->messageNodesRequired, + Node => $node, Source => $this - } if $info->{Seen} < $info->{Min}; + ) if $info->{Seen} < $info->{Min}; $info = shift @nodes; } diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/NodeSet.pm --- a/Lib/IMPL/DOM/Schema/NodeSet.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema/NodeSet.pm Fri Sep 11 16:30:39 2009 +0400 @@ -2,13 +2,25 @@ use strict; use warnings; -use base qw(IMPL::DOM::Schema::Item); +use base qw(IMPL::DOM::Node); use IMPL::Class::Property; +our %CTOR = ( + 'IMPL::DOM::Node' => sub { nodeName => 'NodeSet' } +); + BEGIN { - public property UnexpectedMessage => prop_all; - public property MaxMessage => prop_all; - public property MinMessage => prop_all; + public property messageUnexpected => prop_all; + public property messageMax => prop_all; + public property messageMin => prop_all; +} + +sub CTOR { + my ($this,%args) = @_; + + $this->messageMax( $args{messageMax} || 'Too many %Node.nodeName% nodes'); + $this->messageMin( $args{messageMin} || '%Schema.nodeName% nodes expected'); + $this->messageUnexpected( $args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here'); } sub Validate { @@ -16,38 +28,46 @@ my @errors; - my %nodes = map { - $_->nodeName , - {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur, Seen => 0 } - } @{$this->childNodes}; + my %nodes; + my $anyNode; + foreach (@{$this->childNodes}) { + if ($_->isa('IMPL::DOM::Schema::AnyNode')) { + $anyNode = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 }; + } else { + $nodes{$_->nodeName} = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 }; + } + } foreach my $child ( @{$node->childNodes} ) { - if (my $info = $nodes{$child->nodeName}) { + if (my $info = $nodes{$child->nodeName} || $anyNode) { $info->{Seen}++; - push @errors,{ - Error => 1, + push @errors,new IMPL::DOM::Schema::VaidationError ( Source => $this, Node => $child, - Message => $this->MaxMessage - } if ($info->{Seen} > $info->{Max}); + Schema => $info->{Schema}, + Message => $this->messageMax + ) if ($info->{Max} and $info->{Seen} > $info->{Max}); - push @errors,$info->{Schema}->Validate($child); + if (my @localErrors = $info->{Schema}->Validate($child)) { + push @errors,@localErrors; + } } else { - push @errors, { - Error => 1, + push @errors, new IMPL::DOM::Schema::VaidationError ( Source => $this, Node => $child, - Message => $this->UnexpectedMessage - } + Schema => $info->{Schema}, + Message => $this->messageUnexpected + ) } } foreach my $info (values %nodes) { - push @errors, { - Error => 1, + push @errors, new IMPL::DOM::Schema::VaidationError ( Source => $this, - Message => $this->MinMessage - } if $info->{Min} > $info->{Seen}; + Schema => $info->{Schema}, + Node => $node, + Message => $this->messageMin + ) if $info->{Min} > $info->{Seen}; } return @errors; diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/SimpleNode.pm --- a/Lib/IMPL/DOM/Schema/SimpleNode.pm Thu Sep 10 17:42:47 2009 +0400 +++ b/Lib/IMPL/DOM/Schema/SimpleNode.pm Fri Sep 11 16:30:39 2009 +0400 @@ -2,7 +2,7 @@ use strict; use warnings; -use base qw(IMPL::DOM::Schema::Item); +use base qw(IMPL::DOM::Schema::Node); __PACKAGE__->PassThroughArgs; diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/SimpleType.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Schema/SimpleType.pm Fri Sep 11 16:30:39 2009 +0400 @@ -0,0 +1,30 @@ +package IMPL::DOM::Schema::SimpleType; +use strict; +use warnings; + +use base qw(IMPL::DOM::Schema::SimpleNode); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property nativeType => prop_get; +} + +our %CTOR = ( + 'IMPL::DOM::Schema::SimpleNode' => sub { + my %args = @_; + $args{nodeName} = 'ComplexNode'; + $args{minOccur} = 0; + $args{maxOccur} = 'unbounded'; + %args + } +); + +sub CTOR { + my ($this,%args) = @_; + + $this->{$nativeType} = $args{nativeType}; +} + + +1; diff -r 818c74b038ae -r 1ca530e5c9c5 Lib/IMPL/DOM/Schema/ValidationError.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/DOM/Schema/ValidationError.pm Fri Sep 11 16:30:39 2009 +0400 @@ -0,0 +1,26 @@ +package IMPL::DOM::Schema::VaidationError; +use strict; +use warnings; + +use base qw(IMPL::Object); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; +use IMPL::Resources::Format qw(FormatMessage); + +BEGIN { + public _direct property Node => prop_get; + public _direct property Schema => prop_get; + public _direct property Source => prop_get; + public _direct property Message => prop_get; +} + +sub CTOR { + my ($this,%args) = @_; + + $this->{$Node} = $args{Node} or die new IMPL::InvalidArgumentException("Node is a required parameter"); + $this->{$Schema} = $args{Schema} if $args{Schema}; + $this->{$Source} = $args{Source} if $args{Source}; + $this->{$Message} = FormatMessage(delete $args{Message}, \%args) if $args{Message}; +} + +1; diff -r 818c74b038ae -r 1ca530e5c9c5 _test/DOM.t --- a/_test/DOM.t Thu Sep 10 17:42:47 2009 +0400 +++ b/_test/DOM.t Fri Sep 11 16:30:39 2009 +0400 @@ -9,6 +9,7 @@ my $plan = new IMPL::Test::Plan qw( Test::DOM::Node Test::DOM::Navigator + Test::DOM::Schema ); $plan->AddListener(new IMPL::Test::TAPListener); diff -r 818c74b038ae -r 1ca530e5c9c5 _test/Test/DOM/Schema.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/DOM/Schema.pm Fri Sep 11 16:30:39 2009 +0400 @@ -0,0 +1,24 @@ +package Test::DOM::Schema; +use strict; +use warnings; + +use base qw(IMPL::Test::Unit); +use IMPL::Test qw(test failed); + +__PACKAGE__->PassThroughArgs; + +require IMPL::DOM::Schema; + +test GetMetaSchema => sub { + my $metaSchema = IMPL::DOM::Schema->MetaSchema(); +}; + +test AutoverifyMetaSchema => sub { + my $metaSchema = IMPL::DOM::Schema->MetaSchema(); + + if (my @errors = $metaSchema->Validate($metaSchema)) { + failed "Self verification failed", map $_ ? $_->Message : 'unknown', @errors; + } +}; + +1; diff -r 818c74b038ae -r 1ca530e5c9c5 impl.kpf --- a/impl.kpf Thu Sep 10 17:42:47 2009 +0400 +++ b/impl.kpf Fri Sep 11 16:30:39 2009 +0400 @@ -144,6 +144,32 @@ default + + + + + + 9011 + + + Lib/IMPL/DOM/Schema.pm + + Perl + + + + application/x-www-form-urlencoded + GET + 1 + 0 + 0 + + + enabled + + + default +