# 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
+