Mercurial > pub > Impl

annotate Lib/IMPL/DOM/Schema/NodeList.pm @ 19:1ca530e5c9c5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
author Sergey
date Fri, 11 Sep 2009 16:30:39 +0400
parents fffb153be599
children 267460284fb3
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
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
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 {
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
29 {nodeName => $_->nodeName, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Min => $_->minOccur eq 'unbounded' ? undef : $_->maxOccur, Max => $_->maxOccur, 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 :)
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
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
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
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
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
55 # it's ok, we found schema element for him
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
56 $info->{Seen}++;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
57
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
58 # check count limits
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
59 return new IMPL::DOM::Schema::VaidationError (
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
60 Error => 1,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
61 Message => $this->messageUnexpected,
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
62 Node => $child,
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
63 Source => $this,
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
64 ) if $info->{Max} and $info->{Seen} > $info->{Max};
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
65
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
66 # validate
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
67 if (my @errors = $info->{Schema}->Validate($child)) {
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
68 return @errors;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
69 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
70 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
71
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
72 # no more children left (but may be should :)
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
73 while ($info) {
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
74 return new IMPL::DOM::Schema::VaidationError (
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
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
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
78 Source => $this
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents: 8
diff changeset
79 ) if $info->{Seen} < $info->{Min};
8
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
80
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
81 $info = shift @nodes;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
82 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
83 }
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
84
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
85 1;
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
86
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
87 __END__
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
88
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
89 =pod
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
90
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
91 =head1 DESCRIPTION
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
92
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
93 . .
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
94 C<IMPL::DOM::Schema::ComplexNode> C<IMPL::DOM::Schema::SimpleNode>.
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
95
fffb153be599 DOM Schema
Sergey
parents:
diff changeset
96 =cut