|
49
|
1 package IMPL::DOM::Schema::ComplexType;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
388
|
5 use IMPL::declare {
|
|
|
6 base => [
|
|
|
7 'IMPL::DOM::Schema::ComplexNode' => sub {
|
|
|
8 my %args = @_;
|
|
|
9 $args{nodeName} ||= 'ComplexType';
|
|
|
10 $args{minOccur} = 0;
|
|
|
11 $args{maxOccur} = 'unbounded';
|
|
|
12 $args{name} ||= 'ComplexType';
|
|
|
13 delete @args{qw(nativeType messageWrongType)};
|
|
|
14 %args
|
|
|
15 }
|
|
|
16 ],
|
|
|
17 props => [
|
|
|
18 nativeType => { get => 1, set => 1, direct => 1, dom => 1 },
|
|
|
19 messageWrongType => { get => 1, set => 1, direct => 1, dom => 1 }
|
|
|
20 ]
|
|
|
21 };
|
|
49
|
22
|
|
|
23 sub CTOR {
|
|
|
24 my ($this,%args) = @_;
|
|
|
25
|
|
|
26 $this->{$nativeType} = $args{nativeType};
|
|
238
|
27 $this->{$messageWrongType} = $args{messageWrongType} || "A complex node '%node.path%' is expected to be %schema.nativeType%";
|
|
103
|
28 }
|
|
|
29
|
|
|
30 sub Validate {
|
|
194
|
31 my ($this, $node,$ctx) = @_;
|
|
|
32
|
|
|
33 if ($this->{$nativeType}) {
|
|
|
34 return new IMPL::DOM::Schema::ValidationError(
|
|
236
|
35 node => $node,
|
|
388
|
36 schemaNode => $ctx->{schemaNode} || $this,
|
|
|
37 schemaType => $this,
|
|
236
|
38 message => $this->messageWrongType
|
|
194
|
39 ) unless $node->isa($this->{$nativeType});
|
|
|
40 }
|
|
388
|
41
|
|
194
|
42 return $this->SUPER::Validate($node,$ctx);
|
|
49
|
43 }
|
|
|
44
|
|
102
|
45 sub qname {
|
|
194
|
46 $_[0]->nodeName.'[type='.$_[0]->type.']';
|
|
102
|
47 }
|
|
|
48
|
|
49
|
49
|
|
|
50 1;
|
