1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
package XML::Validator::Schema::SimpleTypeNode;
use base 'XML::Validator::Schema::Node';
use strict;
use warnings;
use XML::Validator::Schema::Util qw(_attr _err);
use Carp qw(confess);
=head1 NAME
XML::Validator::Schema::SimpleTypeNode - temporary node
=head1 DESCRIPTION
Temporary node in the schema parse tree to represent a simpleType.
=cut
# Hash mapping facet names to allowable values
our %FACET_VALUE = (length => "nonNegativeInteger",
minLength => "nonNegativeInteger",
maxLength => "nonNegativeInteger",
totalDigits => "positiveInteger",
fractionDigits => "nonNegativeInteger");
sub parse {
my ($pkg, $data) = @_;
my $self = $pkg->new();
my $name = _attr($data, 'name');
$self->name($name) if $name;
$self->{restrictions} = {};
return $self;
}
sub parse_restriction {
my ($self, $data) = @_;
my $base = _attr($data, 'base');
_err("Found restriction without required 'base' attribute.")
unless $base;
$self->{base} = $base;
}
sub parse_facet {
my ($self, $data) = @_;
my $facet = $data->{LocalName};
my $value = _attr($data, 'value');
_err("Found facet <$facet> without required 'value' attribute.")
unless defined $value;
$self->check_facet_value($facet, $value, $FACET_VALUE{$facet}) if defined $FACET_VALUE{$facet};
push @{$self->{restrictions}{$facet} ||= []}, $value;
}
sub compile {
my ($self) = shift;
if ( $self->{mother}->{is_union} ) {
my $mum=$self->{mother};
$self->{name} = $mum->{name} .
$mum->{next_instance};
$self->{mother}->{next_instance} ++;
}
# If my only child is a union, everything is already compiled
if ( $self->{got_union} ) {
# all compilation done at lower level
# it looks sort of inappropriate to return a string when
# everything is expecting a SimpleType in here. But my view is that
# a union isn't really a simpletype and it isn't appropriate to
# handle a union directly in SimpleType. This alerts ElementNode
# to the fact that it has to do a little extra work.
return 'union';
}
# compile a new type
my $base = $self->root->{type_library}->find(name => $self->{base});
my $type = $base->derive();
# smoke 'em if you got 'em
$type->{name} = $self->{name} if $self->{name};
# add restrictions
foreach my $facet (keys %{$self->{restrictions}}) {
foreach my $value (@{$self->{restrictions}{$facet}}) {
if ($facet eq 'pattern') {
$type->restrict($facet, qr/^$value$/);
} else {
$type->restrict($facet, $value);
}
}
}
# register in the library if this is a named type
$self->root->{type_library}->add(name => $self->{name},
obj => $type)
if $self->{name};
if ( $self->{mother}->{is_union} ) {
# update great-gran with this simple type member
# However this node is a SimpleTypeNode, and to make simple
# re-use of 'check' possible in ElementNode, what we should
# be pushing is an ElementNode
my $gg = $self->{mother}->{mother}->{mother};
# Make a new elementnode to stuff into members
my $mbr = XML::Validator::Schema::ElementNode->new();
$mbr->{type} = $type;
# make this simpletype the daughter of the new member element:
$mbr->add_daughter($self);
push(@{$gg->{members}},$mbr);
}
return $type;
}
sub check_facet_value {
my ($self, $facet, $value, $type_name) = @_;
my ($ok, $msg) = $self->root->{type_library}->find(name => $type_name)->check($value);
_err("Facet <$facet> value $value is not a $type_name")
unless $ok;
}
sub check_constraints {
my ($self) = @_;
my $r = $self->{restrictions};
# Schema Component Constraint: fractionDigits-totalDigits
if (exists $r->{fractionDigits} && exists $r->{totalDigits}) {
_err("Facet <fractionDigits> value $r->{fractionDigits}[0] is greater than facet <totalDigits> value $r->{totalDigits}[0]")
if ($r->{fractionDigits}[0] > $r->{totalDigits}[0]);
}
# Schema Component Constraint: length-minLength-maxLength
_err("Facet <length> is defined in addition to facets <minLength> or <maxLength>")
if (exists $r->{length} && (exists $r->{minLength} || exists $r->{maxLength}));
# Schema Component Constraint: minLength-less-than-equal-to-maxLength
if (exists $r->{minLength} && exists $r->{maxLength}) {
_err("Facet <minLength> value $r->{minLength}[0] is greater than than facet <maxLength> value $r->{maxLength}[0]")
if ($r->{minLength}[0] > $r->{maxLength}[0]);
}
}
1;
|
