|
49
|
1 package IMPL::DOM::Schema::Property;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use base qw(IMPL::DOM::Schema::SimpleNode);
|
|
|
6 require IMPL::DOM::Schema;
|
|
|
7 require IMPL::DOM::Node;
|
|
|
8 use IMPL::Class::Property;
|
|
|
9
|
|
|
10 __PACKAGE__->PassThroughArgs;
|
|
|
11
|
|
|
12 BEGIN {
|
|
|
13 public property RequiredMessage => prop_all;
|
|
|
14 }
|
|
|
15
|
|
|
16 our %CTOR = (
|
|
|
17 'IMPL::DOM::Schema::SimpleNode' => sub {
|
|
|
18 my %args = @_;
|
|
|
19
|
|
|
20 $args{maxOccur} = 1;
|
|
|
21 $args{minOccur} = delete $args{optional} ? 0 : 1;
|
|
|
22 $args{nodeName} ||= 'Property';
|
|
|
23
|
|
|
24 return %args;
|
|
|
25 }
|
|
|
26 );
|
|
|
27
|
|
|
28 sub CTOR {
|
|
|
29 my ($this,%args) = @_;
|
|
|
30
|
|
|
31 $this->RequiredMessage($args{RequiredMessage} || 'A property %Schema.name% is required in the %Node.qname%');
|
|
|
32 }
|
|
|
33
|
|
|
34 sub Validate {
|
|
|
35 my ($this,$node) = @_;
|
|
|
36
|
|
103
|
37 my $prop = $this->name;
|
|
|
38
|
|
|
39 # buld a pseudo node for the property value
|
|
|
40 my $nodeProp = new IMPL::DOM::Node(nodeName => '::property', nodeValue => eval { $node->$prop() } || $node->nodeProperty($prop));
|
|
49
|
41
|
|
103
|
42 if ($nodeProp->nodeValue) {
|
|
|
43 # we have a value so validate it
|
|
|
44 return $this->SUPER::Validate($nodeProp);
|
|
|
45 } elsif($this->minOccur) {
|
|
|
46 # we don't have a value but it's a mandatory property
|
|
|
47 return new IMPL::DOM::Schema::ValidationError(
|
|
|
48 Message => $this->RequiredMessage,
|
|
|
49 Node => $node,
|
|
|
50 Schema => $this
|
|
|
51 );
|
|
49
|
52 }
|
|
103
|
53
|
|
49
|
54 }
|
|
|
55
|
|
|
56 1;
|
