Mercurial > pub > Impl

annotate Lib/IMPL/DOM/Schema/NodeList.pm @ 31:d59526f6310e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 7f00786f8210
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
1 package IMPL::DOM::Schema::NodeList;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
2 use strict;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
3 use warnings;
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
4 use base qw(IMPL::DOM::Node);
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
5
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
7 require IMPL::DOM::Schema::ValidationError;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
8
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
9 our %CTOR = (
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
10 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
11 );
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
12
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
13 BEGIN {
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
14 public property messageUnexpected => prop_all;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
15 public property messageNodesRequired => prop_all;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
16 }
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
17
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
18 sub CTOR {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
19 my ($this,%args) = @_;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
20
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
21 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%');
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
22 $this->messageNodesRequired($args{messageNodesRequired} || 'A %Schema.name% is required in the node %Node.path%');
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
23 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
24
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
25 sub Validate {
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
26 my ($this,$node) = @_;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
27
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
28 my @nodes = map {
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
29 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 }
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
30 } @{$this->childNodes};
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
31
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
32 my $info = shift @nodes;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
33
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
34 foreach my $child ( @{$node->childNodes} ) {
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
35 #skip schema elements
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
36 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
37 # if possible of course :)
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
38 return new IMPL::DOM::Schema::ValidationError (
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
39 Message => $this->messageUnexpected,
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
40 Node => $child,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
41 Schema => $info->{Schema},
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
42 Source => $this
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
43 ) if $info->{Min} > $info->{Seen};
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
44
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
45 $info = shift @nodes;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
46 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
47
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
48 # return error if no more children allowed
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
49 return new IMPL::DOM::Schema::ValidationError (
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
50 Message => $this->messageUnexpected,
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
51 Node => $child,
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
52 Source => $this
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
53 ) unless $info;
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
54
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
55 # it's ok, we found schema element for child
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
56 # but it may be any node or switching node wich would not satisfy current child
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
57
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
58 # validate
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
59 while (my @errors = $info->{Schema}->Validate($child)) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
60 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
61 # in case of any or switch node, skip it if possible
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
62 next if $info = shift @nodes;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
63 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
64 return @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
65 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
66
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
67 $info->{Seen}++;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
68
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
69 # check count limits
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
70 return new IMPL::DOM::Schema::ValidationError (
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
71 Error => 1,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
72 Message => $this->messageUnexpected,
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
73 Node => $child,
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
74 Source => $this,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
75 ) if $info->{Max} and $info->{Seen} > $info->{Max};
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
76 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
77
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
78 # no more children left (but may be should :)
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
79 while ($info) {
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
80 return new IMPL::DOM::Schema::ValidationError (
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
81 Error => 1,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
82 Message => $this->messageNodesRequired,
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
83 Node => $node,
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
84 Source => $this,
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
85 Schema => $info->{Schema}
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
86 ) if $info->{Seen} < $info->{Min};
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
87
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
88 $info = shift @nodes;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
89 }
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 20
diff changeset
90 return;
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
91 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
92
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
93 1;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
94
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
95 __END__
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
96
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
97 =pod
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
98
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
99 =head1 DESCRIPTION
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
100
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
101 . .
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
102 C<IMPL::DOM::Schema::ComplexNode> C<IMPL::DOM::Schema::SimpleNode>.
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
103
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
104 =cut