Mercurial > pub > Impl

comparison 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
comparison
equal deleted inserted replaced
18:818c74b038ae 19:1ca530e5c9c5
1 package IMPL::DOM::Schema::NodeList; 1 package IMPL::DOM::Schema::NodeList;
2 use strict; 2 use strict;
3 use warnings; 3 use warnings;
4 use base qw(IMPL::DOM::Schema::Item); 4 use base qw(IMPL::DOM::Node);
5
5 use IMPL::Class::Property; 6 use IMPL::Class::Property;
7 require IMPL::DOM::Schema::ValidationError;
8
9 our %CTOR = (
10 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
11 );
6 12
7 BEGIN { 13 BEGIN {
8 public property MessageUnexpected => prop_all; 14 public property messageUnexpected => prop_all;
9 public property MessageNodesRequired => prop_all; 15 public property messageNodesRequired => prop_all;
16 }
17
18 sub CTOR {
19 my ($this,%args) = @_;
20
21 $this->messageUnexpected($args{messageUnexpected} || 'A %Node.nodeName% isn\'t allowed here');
22 $this->messageNodesRequired($args{messageNodesRequired} || 'A content of the node %Node.nodeName% is incomplete');
10 } 23 }
11 24
12 sub Validate { 25 sub Validate {
13 my ($this,$node) = @_; 26 my ($this,$node) = @_;
14 27
15 my @nodes = map { 28 my @nodes = map {
16 {nodeName => $_->nodeName, Schema => $_, Min => $_->minOccur, Max => $_->maxOccur, Seen => 0 } 29 {nodeName => $_->nodeName, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Min => $_->minOccur eq 'unbounded' ? undef : $_->maxOccur, Max => $_->maxOccur, Seen => 0 }
17 } @{$this->childNodes}; 30 } @{$this->childNodes};
18 31
19 my $info = shift @nodes; 32 my $info = shift @nodes;
20 33
21 foreach my $child ( @{$node->childNodes} ) { 34 foreach my $child ( @{$node->childNodes} ) {
22 #skip schema elements 35 #skip schema elements
23 while ($info and $info->{nodeName} ne $child->nodeName) { 36 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
24 # if possible of course :) 37 # if possible of course :)
25 return { 38 return new IMPL::DOM::Schema::VaidationError (
26 Error => 1, 39 Message => $this->messageUnexpected,
27 Message => $this->MessageUnexpected,
28 Node => $child, 40 Node => $child,
41 Schema => $info->{Schema},
29 Source => $this 42 Source => $this
30 } if $info->{Min} > $info->{Seen}; 43 ) if $info->{Min} > $info->{Seen};
31 44
32 $info = shift @nodes; 45 $info = shift @nodes;
33 } 46 }
34 47
35 # return error if no more children allowed 48 # return error if no more children allowed
36 return { 49 return new IMPL::DOM::Schema::VaidationError (
37 Error => 1, 50 Message => $this->messageUnexpected,
38 Message => $this->MessageUnexpected,
39 Node => $child, 51 Node => $child,
40 Source => $this 52 Source => $this
41 } unless $info; 53 ) unless $info;
42 54
43 # it's ok, we found schema element for him 55 # it's ok, we found schema element for him
44 $info->{Seen}++; 56 $info->{Seen}++;
45 57
46 # check count limits 58 # check count limits
47 return { 59 return new IMPL::DOM::Schema::VaidationError (
48 Error => 1, 60 Error => 1,
49 Message => $this->MessageUnexpected, 61 Message => $this->messageUnexpected,
50 Node => $child, 62 Node => $child,
51 Source => $this, 63 Source => $this,
52 } if $info->{Seen} > $info->{Max}; 64 ) if $info->{Max} and $info->{Seen} > $info->{Max};
53 65
54 # validate 66 # validate
55 if (my @errors = $info->{Schema}->Validate($child)) { 67 if (my @errors = $info->{Schema}->Validate($child)) {
56 return @errors; 68 return @errors;
57 } 69 }
58 } 70 }
59 71
60 # no more children left (but may be should :) 72 # no more children left (but may be should :)
61 while ($info) { 73 while ($info) {
62 return { 74 return new IMPL::DOM::Schema::VaidationError (
63 Error => 1, 75 Error => 1,
64 Message => $this->MessageNodesRequired, 76 Message => $this->messageNodesRequired,
77 Node => $node,
65 Source => $this 78 Source => $this
66 } if $info->{Seen} < $info->{Min}; 79 ) if $info->{Seen} < $info->{Min};
67 80
68 $info = shift @nodes; 81 $info = shift @nodes;
69 } 82 }
70 } 83 }
71 84