|
49
|
1 package IMPL::DOM::Schema::ComplexType;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
165
|
5 use parent qw(IMPL::DOM::Schema::ComplexNode);
|
|
49
|
6 use IMPL::Class::Property;
|
|
|
7 use IMPL::Class::Property::Direct;
|
|
152
|
8 use IMPL::DOM::Property qw(_dom);
|
|
49
|
9
|
|
|
10 BEGIN {
|
|
152
|
11 public _dom _direct property nativeType => prop_get;
|
|
|
12 public _dom _direct property messageWrongType => prop_get;
|
|
49
|
13 }
|
|
|
14
|
|
|
15 our %CTOR = (
|
|
|
16 'IMPL::DOM::Schema::ComplexNode' => sub {
|
|
|
17 my %args = @_;
|
|
|
18 $args{nodeName} ||= 'ComplexType';
|
|
|
19 $args{minOccur} = 0;
|
|
|
20 $args{maxOccur} = 'unbounded';
|
|
|
21 $args{name} ||= 'ComplexType';
|
|
124
|
22 delete @args{qw(nativeType messageWrongType)};
|
|
49
|
23 %args
|
|
|
24 }
|
|
|
25 );
|
|
|
26
|
|
|
27 sub CTOR {
|
|
|
28 my ($this,%args) = @_;
|
|
|
29
|
|
|
30 $this->{$nativeType} = $args{nativeType};
|
|
103
|
31 $this->{$messageWrongType} = $args{messageWrongType} || "A complex node '%Node.path%' is expected to be %Schema.nativeType%";
|
|
|
32 }
|
|
|
33
|
|
|
34 sub Validate {
|
|
194
|
35 my ($this, $node,$ctx) = @_;
|
|
|
36
|
|
|
37 if ($this->{$nativeType}) {
|
|
|
38 return new IMPL::DOM::Schema::ValidationError(
|
|
|
39 Node => $node,
|
|
|
40 Source => $ctx->{Source} || $this,
|
|
|
41 Schema => $this,
|
|
|
42 Message => $this->messageWrongType
|
|
|
43 ) unless $node->isa($this->{$nativeType});
|
|
|
44 }
|
|
|
45 return $this->SUPER::Validate($node,$ctx);
|
|
49
|
46 }
|
|
|
47
|
|
102
|
48 sub qname {
|
|
194
|
49 $_[0]->nodeName.'[type='.$_[0]->type.']';
|
|
102
|
50 }
|
|
|
51
|
|
49
|
52
|
|
|
53 1;
|
