Mercurial > pub > Impl

comparison Lib/IMPL/DOM/Schema/NodeList.pm @ 388:648dfaf642e0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
DOM refactoring, removed inflators from DOM Schema, DOM validation - in progress
author cin
date Tue, 11 Feb 2014 20:22:01 +0400
parents b8c724f6de36
children 5aff94ba842f
comparison
equal deleted inserted replaced
387:4cc6cc370fb2 388:648dfaf642e0
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 parent qw(IMPL::DOM::Node);
5 4
6 use IMPL::Class::Property;
7 use IMPL::DOM::Property qw(_dom);
8 require IMPL::DOM::Schema::ValidationError;
9 5
10 our %CTOR = ( 6 use IMPL::declare {
11 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' } 7 require => {
12 ); 8 ValidationError => 'IMPL::DOM::Schema::ValidationError',
13 9 AnyNode => '-IMPL::DOM::Schema::AnyNode'
14 BEGIN { 10 },
15 public _dom property messageUnexpected => prop_all; 11 base => [
16 public _dom property messageNodesRequired => prop_all; 12 'IMPL::DOM::Node' => sub { nodeName => 'NodeList' }
17 } 13 ],
14 props => [
15 messageUnexpected => { get => 1, set => 1, dom => 1 },
16 messageNodesRequired => { get => 1, set => 1, dom => 1}
17 ]
18 };
18 19
19 sub CTOR { 20 sub CTOR {
20 my ($this,%args) = @_; 21 my ($this,%args) = @_;
21 22
22 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%'); 23 $this->messageUnexpected($args{messageUnexpected} || 'A %node.nodeName% isn\'t allowed in %node.parentNode.path%');
25 26
26 sub Validate { 27 sub Validate {
27 my ($this,$node,$ctx) = @_; 28 my ($this,$node,$ctx) = @_;
28 29
29 my @nodes = map { 30 my @nodes = map {
30 {nodeName => $_->name, anyNode => $_->isa('IMPL::DOM::Schema::AnyNode') , Schema => $_, Max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, Min => $_->minOccur, Seen => 0 } 31 {nodeName => $_->name, anyNode => $_->isa(AnyNode) , schemaNode => $_, max => $_->maxOccur eq 'unbounded' ? undef : $_->maxOccur, min => $_->minOccur, seen => 0 }
31 } @{$this->childNodes}; 32 } @{$this->childNodes};
32 33
33 my $info = shift @nodes; 34 my $info = shift @nodes;
34 my $sourceSchema = $ctx->{Source} || $this->parentNode;
35 35
36 foreach my $child ( @{$node->childNodes} ) { 36 foreach my $child ( @{$node->childNodes} ) {
37 #skip schema elements 37 #skip schema elements
38 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) { 38 while ($info and not $info->{anyNode} and $info->{nodeName} ne $child->nodeName) {
39 # if possible of course :) 39 # if possible of course :)
40 return new IMPL::DOM::Schema::ValidationError ( 40 return ValidationError->new (
41 message => $this->messageUnexpected, 41 message => $this->messageUnexpected,
42 node => $child, 42 node => $child,
43 parent => $node, 43 parent => $node,
44 schema => $info->{Schema}, 44 schemaNode => $info->{schemaNode}
45 source => $sourceSchema
46 ) if $info->{Min} > $info->{Seen}; 45 ) if $info->{Min} > $info->{Seen};
47 46
48 $info = shift @nodes; 47 $info = shift @nodes;
49 } 48 }
50 49
51 # return error if no more children allowed 50 # return error if no more children allowed
52 return new IMPL::DOM::Schema::ValidationError ( 51 return ValidationError->new (
53 message => $this->messageUnexpected, 52 message => $this->messageUnexpected,
54 node => $child, 53 node => $child,
55 parent => $node, 54 parent => $node
56 source => $sourceSchema
57 ) unless $info; 55 ) unless $info;
58 56
59 # it's ok, we found schema element for child 57 # it's ok, we found schema element for child
60 # but it may be any node or switching node wich would not satisfy current child 58 # but it may be any node or switching node wich would not satisfy current child
61 59
62 # validate 60 # validate
63 while (my @errors = $info->{Schema}->Validate($child)) { 61 while (my @errors = $info->{schemaNode}->Validate($child)) {
64 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) { 62 if( $info->{anyNode} and $info->{Seen} >= $info->{Min} ) {
65 # in case of any or switch node, skip it if possible 63 # in case of any or switch node, skip it if possible
66 next if $info = shift @nodes; 64 next if $info = shift @nodes;
67 } 65 }
68 return @errors; 66 return @errors;