Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Schema/NodeList.pm @ 22:da5bc24b3d3c
wmi tests
author | Sergey |
---|---|
date | Wed, 30 Sep 2009 17:41:32 +0400 |
parents | 267460284fb3 |
children | 7f00786f8210 |
rev | line source |
---|---|
8 | 1 package IMPL::DOM::Schema::NodeList; |
2 use strict; | |
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 | 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 | 12 |
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 |
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
21 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here'); |
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
22 $this->messageNodesRequired($args{messageNodesRequired} || 'A content of the node %Node.nodeName% is incomplete'); |
8 | 23 } |
24 | |
25 sub Validate { | |
26 my ($this,$node) = @_; | |
27 | |
28 my @nodes = map { | |
20 | 29 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Min => $_->minOccur eq 'unbounded' ? undef : $_->maxOccur, Max => $_->maxOccur, Seen => 0 } |
8 | 30 } @{$this->childNodes}; |
31 | |
32 my $info = shift @nodes; | |
33 | |
34 foreach my $child ( @{$node->childNodes} ) { | |
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 | 37 # if possible of course :) |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
38 return new IMPL::DOM::Schema::VaidationError ( |
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
39 Message => $this->messageUnexpected, |
8 | 40 Node => $child, |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
41 Schema => $info->{Schema}, |
8 | 42 Source => $this |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
43 ) if $info->{Min} > $info->{Seen}; |
8 | 44 |
45 $info = shift @nodes; | |
46 } | |
47 | |
48 # return error if no more children allowed | |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
49 return new IMPL::DOM::Schema::VaidationError ( |
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
50 Message => $this->messageUnexpected, |
8 | 51 Node => $child, |
52 Source => $this | |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
53 ) unless $info; |
8 | 54 |
55 # it's ok, we found schema element for him | |
56 $info->{Seen}++; | |
57 | |
58 # check count limits | |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
59 return new IMPL::DOM::Schema::VaidationError ( |
8 | 60 Error => 1, |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
61 Message => $this->messageUnexpected, |
8 | 62 Node => $child, |
63 Source => $this, | |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
64 ) if $info->{Max} and $info->{Seen} > $info->{Max}; |
8 | 65 |
66 # validate | |
67 if (my @errors = $info->{Schema}->Validate($child)) { | |
68 return @errors; | |
69 } | |
70 } | |
71 | |
72 # no more children left (but may be should :) | |
73 while ($info) { | |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
74 return new IMPL::DOM::Schema::VaidationError ( |
8 | 75 Error => 1, |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
76 Message => $this->messageNodesRequired, |
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
77 Node => $node, |
8 | 78 Source => $this |
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
8
diff
changeset
|
79 ) if $info->{Seen} < $info->{Min}; |
8 | 80 |
81 $info = shift @nodes; | |
82 } | |
83 } | |
84 | |
85 1; | |
86 | |
87 __END__ | |
88 | |
89 =pod | |
90 | |
91 =head1 DESCRIPTION | |
92 | |
93 . . | |
94 C<IMPL::DOM::Schema::ComplexNode> C<IMPL::DOM::Schema::SimpleNode>. | |
95 | |
96 =cut |