comparison Lib/IMPL/DOM/Schema/ComplexType.pm @ 103:c289ed9662ca

Schema beta 2 More strict validation, support for inflating a simple nodes and properties
author wizard
date Fri, 07 May 2010 18:17:40 +0400
parents cf3b6ef2be22
children a6e9759ff88a
comparison
equal deleted inserted replaced
102:cf3b6ef2be22 103:c289ed9662ca
6 use IMPL::Class::Property; 6 use IMPL::Class::Property;
7 use IMPL::Class::Property::Direct; 7 use IMPL::Class::Property::Direct;
8 8
9 BEGIN { 9 BEGIN {
10 public _direct property nativeType => prop_get; 10 public _direct property nativeType => prop_get;
11 public _direct property messageWrongType => prop_get;
11 } 12 }
12 13
13 our %CTOR = ( 14 our %CTOR = (
14 'IMPL::DOM::Schema::ComplexNode' => sub { 15 'IMPL::DOM::Schema::ComplexNode' => sub {
15 my %args = @_; 16 my %args = @_;
23 24
24 sub CTOR { 25 sub CTOR {
25 my ($this,%args) = @_; 26 my ($this,%args) = @_;
26 27
27 $this->{$nativeType} = $args{nativeType}; 28 $this->{$nativeType} = $args{nativeType};
29 $this->{$messageWrongType} = $args{messageWrongType} || "A complex node '%Node.path%' is expected to be %Schema.nativeType%";
30 }
31
32 sub Validate {
33 my ($this, $node) = @_;
34
35 if ($this->{$nativeType}) {
36 return new IMPL::DOM::Schema::ValidationError(
37 Node => $node,
38 Source => $this,
39 Schema => $this,
40 Message => $this->messageWrongType
41 ) unless $node->isa($this->{$nativeType});
42 }
43 return $this->SUPER::Validate($node);
28 } 44 }
29 45
30 sub qname { 46 sub qname {
31 $_[0]->nodeName.'[name='.$_[0]->type.']'; 47 $_[0]->nodeName.'[type='.$_[0]->type.']';
32 } 48 }
33 49
34 50
35 1; 51 1;