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
151
152
153
154
155
156
157
158
159
160
161
|
package XML::Validator::Schema::RootNode;
use strict;
use warnings;
use base 'XML::Validator::Schema::ElementNode';
use XML::Validator::Schema::Util qw(_err);
use Carp qw(croak);
=head1 NAME
XML::Validator::Schema::RootNode - the root node in a schema document
=head1 DESCRIPTION
This is an internal module used by XML::Validator::Schema to represent
the root node in an XML Schema document. Holds references to the
libraries for the schema document and is responsible for hooking up
named types to their uses in the node tree at the end of parsing.
=cut
sub new {
my $pkg = shift;
my $self = $pkg->SUPER::new(@_);
# start up with empty libraries
$self->{type_library} = XML::Validator::Schema::TypeLibrary->new;
$self->{element_library} = XML::Validator::Schema::ElementLibrary->new;
$self->{attribute_library} = XML::Validator::Schema::AttributeLibrary->new;
return $self;
}
# finish typing and references
sub compile {
my $self = shift;
my $element_library = $self->{element_library};
# put global elements into the library (could move this to ::ElementNode)
foreach my $d ($self->daughters) {
if (ref($d) eq 'XML::Validator::Schema::ElementNode') {
$element_library->add(name => $d->{name},
obj => $d);
}
}
# complete all element refs first, forming a complete tree
foreach my $element ($self->descendants) {
$self->complete_ref($element);
}
# completa all element types, including their attributes
foreach my $element ($self->descendants) {
$self->complete_type($element);
}
}
sub complete_ref {
my ($self, $ref) = @_;
# handle any unresolved attribute types
if ($ref->{attr}) {
$self->complete_attr_ref($_)
for (grep { $_->{unresolved_ref} } (@{$ref->{attr}}));
}
# all done unless unresolved
return unless $ref->{unresolved_ref};
my $name = $ref->{name};
my ($element) = $self->{element_library}->find(name => $ref->{name});
_err("Found unresolved reference to element '$name'")
unless $element;
# replace the current element
$ref->replace_with($element->copy_at_and_under);
return;
}
sub complete_type {
my ($self, $element) = @_;
my $library = $self->{type_library};
# handle any unresolved attribute types
if ($element->{attr}) {
$self->complete_attr_type($_)
for (grep { $_->{unresolved_type} } (@{$element->{attr}}));
}
# all done unless unresolved
return unless $element->{unresolved_type};
# get type data
my $type_name = $element->{type_name};
my $type = $library->find(name => $type_name);
# isn't there?
_err("Element '<$element->{name}>' has unrecognized type '$type_name'.")
unless $type;
if ($type->isa('XML::Validator::Schema::ComplexTypeNode')) {
# can't have daughters for this to work
_err("Element '<$element->{name}>' is using a named complexType and has sub-elements of its own. That's not supported.")
if $element->daughters;
# replace the current element with one based on the complex node
my $new_node = $type->copy_at_and_under;
$new_node->name($element->{name});
$new_node->{attr} = [ @{ $new_node->{attr} || [] },
@{ $element->{attr} || [] } ];
$element->replace_with($new_node);
} elsif ($type->isa('XML::Validator::Schema::SimpleType')) {
$element->{type} = $type;
} else {
croak("Library returned '$type'!");
}
# fixed it
delete $element->{unresolved_type};
}
sub complete_attr_type {
my ($self, $attr) = @_;
my $type = $self->{type_library}->find(name => $attr->{type_name});
_err("Attribute '<$attr->{name}>' has unrecognized ".
"type '$attr->{type_name}'.")
unless $type;
$attr->{type} = $type;
delete $attr->{unresolved_type};
}
sub complete_attr_ref {
my ($self, $ref) = @_;
my $attr = $self->{attribute_library}->find(name => $ref->{name});
_err("Attribute reference '$ref->{name}' not found.")
unless $attr;
# clone, keep use
my $use = $ref->{required};
%$ref = %$attr;
$ref->{required} = $use;
return;
}
1;
|
