Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Schema/NodeSet.pm @ 20:267460284fb3
DOM Schema
| author | Sergey |
|---|---|
| date | Tue, 22 Sep 2009 17:17:38 +0400 |
| parents | 1ca530e5c9c5 |
| children | 7f00786f8210 |
| rev | line source |
|---|---|
| 7 | 1 package IMPL::DOM::Schema::NodeSet; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
5 use base qw(IMPL::DOM::Node); |
| 7 | 6 use IMPL::Class::Property; |
| 7 | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
8 our %CTOR = ( |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
9 'IMPL::DOM::Node' => sub { nodeName => 'NodeSet' } |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
10 ); |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
11 |
| 7 | 12 BEGIN { |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
13 public property messageUnexpected => prop_all; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
14 public property messageMax => prop_all; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
15 public property messageMin => prop_all; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
16 } |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
17 |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
18 sub CTOR { |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
19 my ($this,%args) = @_; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
20 |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
21 $this->messageMax( $args{messageMax} || 'Too many %Node.nodeName% nodes'); |
| 20 | 22 $this->messageMin( $args{messageMin} || '%Schema.name% nodes expected'); |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
23 $this->messageUnexpected( $args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here'); |
| 7 | 24 } |
| 25 | |
| 26 sub Validate { | |
| 27 my ($this,$node) = @_; | |
| 28 | |
| 29 my @errors; | |
| 30 | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
31 my %nodes; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
32 my $anyNode; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
33 foreach (@{$this->childNodes}) { |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
34 if ($_->isa('IMPL::DOM::Schema::AnyNode')) { |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
35 $anyNode = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 }; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
36 } else { |
| 20 | 37 $nodes{$_->name} = {Schema => $_, Min => $_->minOccur, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur , Seen => 0 }; |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
38 } |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
39 } |
| 7 | 40 |
| 41 foreach my $child ( @{$node->childNodes} ) { | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
42 if (my $info = $nodes{$child->nodeName} || $anyNode) { |
| 7 | 43 $info->{Seen}++; |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
44 push @errors,new IMPL::DOM::Schema::VaidationError ( |
| 7 | 45 Source => $this, |
| 46 Node => $child, | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
47 Schema => $info->{Schema}, |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
48 Message => $this->messageMax |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
49 ) if ($info->{Max} and $info->{Seen} > $info->{Max}); |
| 7 | 50 |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
51 if (my @localErrors = $info->{Schema}->Validate($child)) { |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
52 push @errors,@localErrors; |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
53 } |
| 7 | 54 } else { |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
55 push @errors, new IMPL::DOM::Schema::VaidationError ( |
| 7 | 56 Source => $this, |
| 57 Node => $child, | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
58 Schema => $info->{Schema}, |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
59 Message => $this->messageUnexpected |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
60 ) |
| 7 | 61 } |
| 62 } | |
| 63 | |
| 64 foreach my $info (values %nodes) { | |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
65 push @errors, new IMPL::DOM::Schema::VaidationError ( |
| 7 | 66 Source => $this, |
|
19
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
67 Schema => $info->{Schema}, |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
68 Node => $node, |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
69 Message => $this->messageMin |
|
1ca530e5c9c5
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
7
diff
changeset
|
70 ) if $info->{Min} > $info->{Seen}; |
| 7 | 71 } |
| 72 | |
| 73 return @errors; | |
| 74 } | |
| 75 | |
| 76 1; | |
| 77 | |
| 78 __END__ | |
| 79 | |
| 80 =pod | |
| 81 | |
| 82 =head1 DESCRIPTION | |
| 83 | |
| 84 . . | |
| 85 C<IMPL::DOM::Schema::ComplexNode> C<IMPL::DOM::Schema::SimpleNode>. | |
| 86 | |
| 87 , | |
| 88 , | |
| 89 . | |
| 90 | |
| 91 =cut |
