Mercurial > pub > Impl
annotate Lib/IMPL/DOM/Schema/NodeSet.pm @ 28:6d33f75c6e1f
ORM in works
author | Sergey |
---|---|
date | Mon, 19 Oct 2009 04:13:54 +0400 |
parents | 7f00786f8210 |
children | 16ada169ca75 |
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'); |
24 | 23 $this->messageUnexpected( $args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed in %Node.parentNode.path%'); |
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}++; |
24 | 44 push @errors,new IMPL::DOM::Schema::ValidationError ( |
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 { |
24 | 55 push @errors, new IMPL::DOM::Schema::ValidationError ( |
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) { | |
24 | 65 push @errors, new IMPL::DOM::Schema::ValidationError ( |
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 |