annotate _test/Test/DOM/Schema.pm @ 24:7f00786f8210

Первая рабочая реазизация схемы и навигаторов
author Sergey
date Mon, 05 Oct 2009 00:48:49 +0400
parents 1ca530e5c9c5
children 6d33f75c6e1f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
1 package Test::DOM::Schema;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
2 use strict;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
3 use warnings;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
4
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
5 use base qw(IMPL::Test::Unit);
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
6 use IMPL::Test qw(test failed shared);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
7 use IMPL::Class::Property;
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
8
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
9 __PACKAGE__->PassThroughArgs;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
10
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
11 require IMPL::DOM::Schema;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
12
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
13 BEGIN {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
14 shared public property SampleSchema => prop_all;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
15 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
16
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
17 test GetMetaSchema => sub {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
18 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
19 };
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
20
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
21 test AutoverifyMetaSchema => sub {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
22 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
23
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
24 if (my @errors = $metaSchema->Validate($metaSchema)) {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
25 failed "Self verification failed", map $_ ? $_->Message : 'unknown', @errors;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
26 }
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
27 };
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
28
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
29 test VerifyCorrectSchema => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
30 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
31 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
32
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
33 my $schema = new IMPL::DOM::Schema;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
34 $schema->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
35 IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
36 IMPL::DOM::Schema::NodeSet->new()->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
37 new IMPL::DOM::Schema::SimpleNode( name => 'firstName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
38 new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
39 new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
40 IMPL::DOM::Schema::NodeSet->new()->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
41 new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
42 new IMPL::DOM::Schema::SimpleNode( name => 'line', minOccur => 0 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
43 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
44 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
45 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
46 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
47 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
48
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
49 $this->SampleSchema($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
50
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
51 my @errors = $metaSchema->Validate($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
52 failed "Failed to validate a wellformed schema", map $_->Message, @errors if @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
53 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
54
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
55 test VerifyWrongSchema => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
56 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
57
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
58 my $schema = new IMPL::DOM::Schema;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
59 $schema->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
60 IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
61 new IMPL::DOM::Schema::ComplexType( type => 'someType' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
62 new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
63 new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
64 new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
65 new IMPL::DOM::Schema::SimpleNode( name => 'line' )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
66 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
67 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
68 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
69
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
70 my @errors = $metaSchema->Validate($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
71 failed "A not wellformed schema validated correctly" unless @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
72 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
73
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
74 test ValidateCorrectData => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
75 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
76
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
77 my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
78 IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
79 IMPL::DOM::Node->new(nodeName => 'lastName', nodeValue => 'Smith'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
80 IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
81 IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
82 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
83 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
84
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
85 if (my @errors = $this->SampleSchema->Validate($data)) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
86 failed "Failed to validate a correct data", map $_->Message , @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
87 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
88 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
89
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
90 test ValidateWrongData => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
91 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
92
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
93 my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
94 IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
95 IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
96 IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
97 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
98 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
99
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
100 failed "A wrong data validated corretly" unless $this->SampleSchema->Validate($data);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
101 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
102
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
103
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
104 1;