| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package PRANG::Graph::Meta::Element; |
|
3
|
|
|
|
|
|
|
$PRANG::Graph::Meta::Element::VERSION = '0.20'; |
|
4
|
1
|
|
|
1
|
|
2161
|
use Moose::Role; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
6
|
|
|
5
|
1
|
|
|
1
|
|
4821
|
use PRANG::Util qw(types_of); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
6
|
|
|
6
|
1
|
|
|
1
|
|
257
|
use MooseX::Params::Validate; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
5
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
has 'xmlns' => |
|
9
|
|
|
|
|
|
|
is => "rw", |
|
10
|
|
|
|
|
|
|
isa => "Str", |
|
11
|
|
|
|
|
|
|
predicate => "has_xmlns", |
|
12
|
|
|
|
|
|
|
; |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
has 'xmlns_attr' => |
|
15
|
|
|
|
|
|
|
is => "rw", |
|
16
|
|
|
|
|
|
|
isa => "Str", |
|
17
|
|
|
|
|
|
|
predicate => "has_xmlns_attr", |
|
18
|
|
|
|
|
|
|
; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
has 'xml_nodeName' => |
|
21
|
|
|
|
|
|
|
is => "rw", |
|
22
|
|
|
|
|
|
|
isa => "Str|HashRef", |
|
23
|
|
|
|
|
|
|
predicate => "has_xml_nodeName", |
|
24
|
|
|
|
|
|
|
; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
has 'xml_nodeName_prefix' => |
|
27
|
|
|
|
|
|
|
is => "rw", |
|
28
|
|
|
|
|
|
|
isa => "HashRef[Str]", |
|
29
|
|
|
|
|
|
|
predicate => "has_xml_nodeName_prefix", |
|
30
|
|
|
|
|
|
|
; |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
has 'xml_nodeName_attr' => |
|
33
|
|
|
|
|
|
|
is => "rw", |
|
34
|
|
|
|
|
|
|
isa => "Str", |
|
35
|
|
|
|
|
|
|
predicate => "has_xml_nodeName_attr", |
|
36
|
|
|
|
|
|
|
; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
has 'xml_required' => |
|
39
|
|
|
|
|
|
|
is => "rw", |
|
40
|
|
|
|
|
|
|
isa => "Bool", |
|
41
|
|
|
|
|
|
|
predicate => "has_xml_required", |
|
42
|
|
|
|
|
|
|
; |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has 'xml_min' => |
|
45
|
|
|
|
|
|
|
is => "rw", |
|
46
|
|
|
|
|
|
|
isa => "Int", |
|
47
|
|
|
|
|
|
|
predicate => "has_xml_min", |
|
48
|
|
|
|
|
|
|
; |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
has 'xml_max' => |
|
51
|
|
|
|
|
|
|
is => "rw", |
|
52
|
|
|
|
|
|
|
isa => "Int", |
|
53
|
|
|
|
|
|
|
predicate => "has_xml_max", |
|
54
|
|
|
|
|
|
|
; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# FIXME: see commitlog, core Moose should get support for this again |
|
57
|
|
|
|
|
|
|
# (perhaps) |
|
58
|
|
|
|
|
|
|
#has '+isa' => |
|
59
|
|
|
|
|
|
|
# required => 1, |
|
60
|
|
|
|
|
|
|
# ; |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has 'graph_node' => |
|
63
|
|
|
|
|
|
|
is => "rw", |
|
64
|
|
|
|
|
|
|
isa => "PRANG::Graph::Node", |
|
65
|
|
|
|
|
|
|
lazy => 1, |
|
66
|
|
|
|
|
|
|
required => 1, |
|
67
|
|
|
|
|
|
|
default => sub { |
|
68
|
|
|
|
|
|
|
my $self = shift; |
|
69
|
|
|
|
|
|
|
$self->build_graph_node; |
|
70
|
|
|
|
|
|
|
}, |
|
71
|
|
|
|
|
|
|
; |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
has "_item_tc" => |
|
74
|
|
|
|
|
|
|
is => "rw", |
|
75
|
|
|
|
|
|
|
isa => "Moose::Meta::TypeConstraint", |
|
76
|
|
|
|
|
|
|
; |
|
77
|
|
|
|
|
|
|
|
|
78
|
1
|
|
|
|
|
1963
|
use constant HIGHER_ORDER_TYPE => |
|
79
|
1
|
|
|
1
|
|
552
|
"Moose::Meta::TypeConstraint::Parameterized"; |
|
|
1
|
|
|
|
|
2
|
|
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _error { |
|
82
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
83
|
0
|
|
|
|
|
|
my ( $message ) = pos_validated_list( |
|
84
|
|
|
|
|
|
|
\@_, |
|
85
|
|
|
|
|
|
|
{ isa => 'Str' }, |
|
86
|
|
|
|
|
|
|
); |
|
87
|
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
|
my $class = $self->associated_class; |
|
89
|
0
|
|
|
|
|
|
my $context = " (Element: "; |
|
90
|
0
|
0
|
|
|
|
|
if ($class) { |
|
91
|
0
|
|
|
|
|
|
$context .= $class->name; |
|
92
|
|
|
|
|
|
|
} |
|
93
|
|
|
|
|
|
|
else { |
|
94
|
0
|
|
|
|
|
|
$context .= "(unassociated)"; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
0
|
|
|
|
|
|
$context .= "/".$self->name.") "; |
|
97
|
0
|
|
|
|
|
|
$message.$context; |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub error { |
|
101
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
102
|
0
|
|
|
|
|
|
my ( $message ) = pos_validated_list( |
|
103
|
|
|
|
|
|
|
\@_, |
|
104
|
|
|
|
|
|
|
{ isa => 'Str' }, |
|
105
|
|
|
|
|
|
|
); |
|
106
|
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
confess $self->_error($message); |
|
108
|
|
|
|
|
|
|
} |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub warn_of { |
|
111
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
112
|
0
|
|
|
|
|
|
my ( $message ) = pos_validated_list( |
|
113
|
|
|
|
|
|
|
\@_, |
|
114
|
|
|
|
|
|
|
{ isa => 'Str' }, |
|
115
|
|
|
|
|
|
|
); |
|
116
|
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
warn $self->_error($message)."\n"; |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub build_graph_node { |
|
121
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
122
|
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
my ($expect_one, $expect_many); |
|
124
|
|
|
|
|
|
|
|
|
125
|
0
|
0
|
0
|
|
|
|
if ( $self->has_xml_required ) { |
|
|
|
0
|
0
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
$expect_one = $self->xml_required; |
|
127
|
|
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
elsif ( |
|
129
|
|
|
|
|
|
|
$self->has_predicate |
|
130
|
|
|
|
|
|
|
or |
|
131
|
|
|
|
|
|
|
$self->has_xml_min and !$self->xml_min |
|
132
|
|
|
|
|
|
|
) |
|
133
|
0
|
|
|
|
|
|
{ $expect_one = 0; |
|
134
|
|
|
|
|
|
|
} |
|
135
|
|
|
|
|
|
|
else { |
|
136
|
0
|
|
|
|
|
|
$expect_one = 1; |
|
137
|
|
|
|
|
|
|
} |
|
138
|
|
|
|
|
|
|
|
|
139
|
0
|
0
|
|
|
|
|
my $t_c = $self->type_constraint |
|
140
|
|
|
|
|
|
|
or $self->error( |
|
141
|
|
|
|
|
|
|
"No type constraint on attribute; did you specify 'isa'?", |
|
142
|
|
|
|
|
|
|
); |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# check to see whether ArrayRef was specified |
|
145
|
0
|
0
|
0
|
|
|
|
if ( $t_c->is_a_type_of("ArrayRef") ) { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
my $is_paramd; |
|
147
|
0
|
|
|
|
|
|
until ( $t_c->equals("ArrayRef") ) { |
|
148
|
0
|
0
|
|
|
|
|
if ( $t_c->isa(HIGHER_ORDER_TYPE) ) { |
|
149
|
0
|
|
|
|
|
|
$is_paramd = 1; |
|
150
|
0
|
|
|
|
|
|
last; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
else { |
|
153
|
0
|
|
|
|
|
|
$t_c = $t_c->parent; |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
} |
|
156
|
0
|
0
|
|
|
|
|
if (not $is_paramd) { |
|
157
|
0
|
|
|
|
|
|
$self->error("ArrayRef, but not Parameterized"); |
|
158
|
|
|
|
|
|
|
} |
|
159
|
0
|
|
|
|
|
|
$expect_many = 1; |
|
160
|
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
$t_c = $t_c->type_parameter; |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
elsif ( |
|
164
|
|
|
|
|
|
|
$self->has_xml_max and $self->xml_max > 1 |
|
165
|
|
|
|
|
|
|
or |
|
166
|
|
|
|
|
|
|
$self->has_xml_min and $self->xml_min > 1 |
|
167
|
|
|
|
|
|
|
) |
|
168
|
|
|
|
|
|
|
{ |
|
169
|
0
|
|
|
|
|
|
$self->error( |
|
170
|
|
|
|
|
|
|
"min/max specified as >1, but type constraint is not an ArrayRef", |
|
171
|
|
|
|
|
|
|
); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
$self->_item_tc($t_c); |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# ok. now let's walk the type constraint tree, and look for |
|
177
|
|
|
|
|
|
|
# types |
|
178
|
0
|
|
|
|
|
|
my ($expect_bool, $expect_simple, @expect_type, @expect_role); |
|
179
|
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
my @st = $t_c; |
|
181
|
0
|
|
|
|
|
|
my %t_c; |
|
182
|
0
|
|
|
|
|
|
while ( my $x = shift @st ) { |
|
183
|
0
|
|
|
|
|
|
$t_c{$x} = $x; |
|
184
|
0
|
0
|
|
|
|
|
if ( $x->isa("Moose::Meta::TypeConstraint::Class") ) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
push @expect_type, $x->class; |
|
186
|
|
|
|
|
|
|
} |
|
187
|
|
|
|
|
|
|
elsif ( $x->isa("Moose::Meta::TypeConstraint::Union") ) { |
|
188
|
0
|
|
|
|
|
|
push @st, @{ $x->type_constraints }; |
|
|
0
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
elsif ( $x->isa("Moose::Meta::TypeConstraint::Enum") ) { |
|
191
|
0
|
|
|
|
|
|
push @st, $x->parent; |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
elsif ( $x->isa("Moose::Meta::TypeConstraint::Role") ) { |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# likely to be a wildcard. |
|
196
|
0
|
|
|
|
|
|
push @expect_role, $x->role; |
|
197
|
|
|
|
|
|
|
} |
|
198
|
|
|
|
|
|
|
elsif ( ref $x eq "Moose::Meta::TypeConstraint" ) { |
|
199
|
0
|
0
|
|
|
|
|
if ( $x->equals("Bool") ) { |
|
|
|
0
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
|
$expect_bool = 1; |
|
201
|
|
|
|
|
|
|
} |
|
202
|
|
|
|
|
|
|
elsif ( $x->equals("Value") ) { |
|
203
|
0
|
|
|
|
|
|
$expect_simple = 1; |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
else { |
|
206
|
0
|
|
|
|
|
|
push @st, $x->parent; |
|
207
|
|
|
|
|
|
|
} |
|
208
|
|
|
|
|
|
|
} |
|
209
|
|
|
|
|
|
|
else { |
|
210
|
0
|
|
|
|
|
|
$self->error( |
|
211
|
|
|
|
|
|
|
"Sorry, I don't know how to map a " |
|
212
|
|
|
|
|
|
|
.ref($x) |
|
213
|
|
|
|
|
|
|
); |
|
214
|
|
|
|
|
|
|
} |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
my $node; |
|
218
|
0
|
0
|
|
|
|
|
my $nodeName = $self->has_xml_nodeName |
|
219
|
|
|
|
|
|
|
? |
|
220
|
|
|
|
|
|
|
$self->xml_nodeName |
|
221
|
|
|
|
|
|
|
: $self->name; |
|
222
|
0
|
0
|
|
|
|
|
my $nodeName_prefix = $self->has_xml_nodeName_prefix |
|
223
|
|
|
|
|
|
|
? |
|
224
|
|
|
|
|
|
|
$self->xml_nodeName_prefix |
|
225
|
|
|
|
|
|
|
: {}; |
|
226
|
0
|
|
|
|
|
|
my $nodeName_r_prefix = { reverse %$nodeName_prefix }; |
|
227
|
|
|
|
|
|
|
|
|
228
|
0
|
|
0
|
|
|
|
my $expect_concrete = ($expect_bool||0) + |
|
|
|
|
0
|
|
|
|
|
|
229
|
|
|
|
|
|
|
($expect_simple||0) + @expect_type; |
|
230
|
|
|
|
|
|
|
|
|
231
|
0
|
0
|
|
|
|
|
if ( $expect_concrete > 1 ) { |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# multiple or ambiguous types are specified; we *need* |
|
234
|
|
|
|
|
|
|
# to know |
|
235
|
0
|
0
|
|
|
|
|
if ( !ref $nodeName ) { |
|
236
|
0
|
|
|
|
|
|
$self->error( |
|
237
|
|
|
|
|
|
|
"type union specified, but no nodename map given" |
|
238
|
|
|
|
|
|
|
); |
|
239
|
|
|
|
|
|
|
} |
|
240
|
0
|
|
|
|
|
|
while ( my ($nodeName, $type) = each %$nodeName ) { |
|
241
|
0
|
0
|
|
|
|
|
if ( not exists $t_c{$type} ) { |
|
242
|
0
|
|
|
|
|
|
$self->error( |
|
243
|
|
|
|
|
|
|
"nodeName to type map specifies $nodeName => '$type', but $type is not" |
|
244
|
|
|
|
|
|
|
." an acceptable type", |
|
245
|
|
|
|
|
|
|
); |
|
246
|
|
|
|
|
|
|
} |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
my $prefix_xx; |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# plug-in type classes. |
|
253
|
0
|
0
|
|
|
|
|
if (@expect_role) { |
|
254
|
0
|
|
|
|
|
|
my @users = map { $_->name } types_of(@expect_role); |
|
|
0
|
|
|
|
|
|
|
|
255
|
0
|
0
|
0
|
|
|
|
if ( $self->has_xml_nodeName and !ref $self->xml_nodeName ) { |
|
256
|
0
|
|
|
|
|
|
$self->error( |
|
257
|
|
|
|
|
|
|
"Str value for xml_nodeName incompatible with specifying a role type " |
|
258
|
|
|
|
|
|
|
."constraint" |
|
259
|
|
|
|
|
|
|
); |
|
260
|
|
|
|
|
|
|
} |
|
261
|
0
|
0
|
|
|
|
|
$nodeName = {} if !ref $nodeName; |
|
262
|
0
|
|
|
|
|
|
for my $user (@users) { |
|
263
|
0
|
0
|
|
|
|
|
if ( $user->does("PRANG::Graph") ) { |
|
264
|
0
|
|
|
|
|
|
my $plugin_nodeName = $user->root_element; |
|
265
|
0
|
|
|
|
|
|
my $xmlns; |
|
266
|
0
|
0
|
0
|
|
|
|
if ( $xmlns = eval { $user->xmlns }//"" ) { |
|
|
0
|
|
|
|
|
|
|
|
267
|
0
|
0
|
|
|
|
|
if ( not exists $nodeName_r_prefix->{$xmlns} ) { |
|
268
|
0
|
|
0
|
|
|
|
$prefix_xx ||= "a"; |
|
269
|
|
|
|
|
|
|
$prefix_xx++ |
|
270
|
0
|
|
|
|
|
|
while exists $nodeName_prefix->{$prefix_xx}; |
|
271
|
0
|
|
|
|
|
|
$nodeName_prefix->{$prefix_xx} = $xmlns; |
|
272
|
0
|
|
|
|
|
|
$nodeName_r_prefix->{$xmlns} = $prefix_xx; |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
$plugin_nodeName = |
|
275
|
0
|
|
|
|
|
|
"$nodeName_r_prefix->{$xmlns}:$plugin_nodeName"; |
|
276
|
|
|
|
|
|
|
} |
|
277
|
0
|
0
|
|
|
|
|
if ( exists $nodeName->{$plugin_nodeName} ) { |
|
278
|
0
|
0
|
|
|
|
|
$self->error( |
|
279
|
|
|
|
|
|
|
"Both '$user' and '$nodeName->{$plugin_nodeName}' plug-in type specify nodename $plugin_nodeName" |
|
280
|
|
|
|
|
|
|
.( |
|
281
|
|
|
|
|
|
|
$xmlns ? " (xmlns $xmlns)" : "" |
|
282
|
|
|
|
|
|
|
) |
|
283
|
|
|
|
|
|
|
.", conflict", |
|
284
|
|
|
|
|
|
|
); |
|
285
|
|
|
|
|
|
|
} |
|
286
|
0
|
|
|
|
|
|
$nodeName->{$plugin_nodeName} = $user; |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
else { |
|
289
|
0
|
|
|
|
|
|
$self->error( |
|
290
|
|
|
|
|
|
|
"Can't use one or more of role(s) @expect_role; " |
|
291
|
|
|
|
|
|
|
.$user->name |
|
292
|
|
|
|
|
|
|
." needs to consume role PRANG::Graph (hint: did you forget to \"with 'PRANG::Graph';\"?)", |
|
293
|
|
|
|
|
|
|
); |
|
294
|
|
|
|
|
|
|
} |
|
295
|
0
|
|
|
|
|
|
push @expect_type, $user; |
|
296
|
0
|
|
|
|
|
|
$expect_concrete++; |
|
297
|
|
|
|
|
|
|
} |
|
298
|
0
|
|
|
|
|
|
$self->xml_nodeName({%$nodeName}); |
|
299
|
0
|
0
|
0
|
|
|
|
if ( !$self->has_xml_nodeName_prefix |
|
300
|
|
|
|
|
|
|
and keys %$nodeName_prefix ) |
|
301
|
0
|
|
|
|
|
|
{ $self->xml_nodeName_prefix($nodeName_prefix); |
|
302
|
|
|
|
|
|
|
} |
|
303
|
|
|
|
|
|
|
} |
|
304
|
0
|
0
|
|
|
|
|
if (!$expect_concrete) { |
|
305
|
0
|
|
|
|
|
|
$self->error( |
|
306
|
|
|
|
|
|
|
"no type(s) specified (or, role evaluated to nothing)", |
|
307
|
|
|
|
|
|
|
) |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
0
|
0
|
|
|
|
|
if ( !ref $nodeName ) { |
|
311
|
0
|
0
|
|
|
|
|
my $expected = $expect_bool ? "Bool" : |
|
|
|
0
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
$expect_simple ? "Str" : $expect_type[0]; |
|
313
|
0
|
|
|
|
|
|
$nodeName = { $nodeName => $expected }; |
|
314
|
0
|
|
|
|
|
|
$self->xml_nodeName($nodeName); |
|
315
|
|
|
|
|
|
|
} |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# we will be using 'delete' with nodeName, so copy it |
|
318
|
0
|
|
|
|
|
|
$nodeName = {%$nodeName}; |
|
319
|
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# figure out the XML namespace of this node and set it on the |
|
321
|
|
|
|
|
|
|
# attribute |
|
322
|
0
|
|
|
|
|
|
my %xmlns_opts; |
|
323
|
0
|
0
|
|
|
|
|
if ( $self->has_xmlns ) { |
|
324
|
0
|
|
|
|
|
|
$xmlns_opts{xmlns} = $self->xmlns; |
|
325
|
|
|
|
|
|
|
} |
|
326
|
|
|
|
|
|
|
else { |
|
327
|
0
|
|
0
|
|
|
|
my $xmlns = eval { $self->associated_class->name->xmlns } // ""; |
|
|
0
|
|
|
|
|
|
|
|
328
|
0
|
0
|
|
|
|
|
$xmlns_opts{xmlns} = $xmlns |
|
329
|
|
|
|
|
|
|
if $xmlns; # FIXME - should *always* set it! |
|
330
|
|
|
|
|
|
|
} |
|
331
|
0
|
0
|
|
|
|
|
if ( $self->has_xmlns_attr ) { |
|
332
|
0
|
|
|
|
|
|
$xmlns_opts{xmlns_attr} = $self->xmlns_attr; |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
my $prefix_xmlns = sub { |
|
335
|
0
|
|
|
0
|
|
|
my $name = shift; |
|
336
|
0
|
0
|
0
|
|
|
|
if ( $nodeName_prefix and $name =~ /^(\w+):(\w+)/ ) { |
|
337
|
0
|
|
|
|
|
|
my %this_xmlns_opts = %xmlns_opts; |
|
338
|
|
|
|
|
|
|
my $xmlns = $nodeName_prefix->{$1} |
|
339
|
|
|
|
|
|
|
or die "unknown prefix '$1' used on attribute " |
|
340
|
|
|
|
|
|
|
.$self->name." of " |
|
341
|
0
|
0
|
|
|
|
|
.eval{$self->associated_class->name}; |
|
|
0
|
|
|
|
|
|
|
|
342
|
0
|
|
|
|
|
|
$this_xmlns_opts{xmlns} = $xmlns; |
|
343
|
0
|
|
|
|
|
|
($2, \%this_xmlns_opts); |
|
344
|
|
|
|
|
|
|
} |
|
345
|
|
|
|
|
|
|
else { |
|
346
|
0
|
|
|
|
|
|
($name, \%xmlns_opts); |
|
347
|
|
|
|
|
|
|
} |
|
348
|
0
|
|
|
|
|
|
}; |
|
349
|
|
|
|
|
|
|
|
|
350
|
0
|
|
|
|
|
|
my @expect; |
|
351
|
0
|
|
|
|
|
|
for my $class (@expect_type) { |
|
352
|
0
|
|
|
|
|
|
my (@names) = grep { $nodeName->{$_} eq $class } |
|
|
0
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
keys %$nodeName; |
|
354
|
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# auto-load the classes now... save problems later |
|
356
|
0
|
0
|
|
|
|
|
if ( !eval{ $class->meta->can("marshall_in_element") } ) { |
|
|
0
|
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
my $ok = eval "use $class; 1"; |
|
358
|
0
|
0
|
|
|
|
|
if ( !$ok ) { |
|
359
|
0
|
|
|
|
|
|
die |
|
360
|
|
|
|
|
|
|
"problem auto-including class '$class'; (hint: did you expect '$class' to be a subtype, but forget to define it before it was used or not use BEGIN { } appropriately?); exception is: $@"; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
} |
|
363
|
0
|
0
|
|
|
|
|
if ( !eval{ $class->meta->can("marshall_in_element") } ) { |
|
|
0
|
|
|
|
|
|
|
|
364
|
0
|
|
|
|
|
|
die |
|
365
|
|
|
|
|
|
|
"'$class' can't marshall in; did you 'use PRANG::Graph'?"; |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
0
|
0
|
|
|
|
|
if ( !@names ) { |
|
369
|
|
|
|
|
|
|
die "type '$class' specified as allowed on '" |
|
370
|
|
|
|
|
|
|
.$self->name |
|
371
|
|
|
|
|
|
|
."' element of " |
|
372
|
|
|
|
|
|
|
.$self->associated_class->name |
|
373
|
|
|
|
|
|
|
.", but which node names indicate that type? You've defined: " |
|
374
|
|
|
|
|
|
|
.( |
|
375
|
|
|
|
|
|
|
$self->has_xml_nodeName |
|
376
|
|
|
|
|
|
|
? ( ref $self->xml_nodeName |
|
377
|
|
|
|
|
|
|
? join( |
|
378
|
|
|
|
|
|
|
"; ", |
|
379
|
0
|
|
|
|
|
|
map { "$_ => ".$self->xml_nodeName->{$_} } |
|
380
|
0
|
0
|
|
|
|
|
sort keys %{$self->xml_nodeName} |
|
|
0
|
0
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
) |
|
382
|
|
|
|
|
|
|
: ("(all '".$self->xml_nodeName."')") |
|
383
|
|
|
|
|
|
|
) |
|
384
|
|
|
|
|
|
|
: "(nothing)" |
|
385
|
|
|
|
|
|
|
); |
|
386
|
|
|
|
|
|
|
} |
|
387
|
|
|
|
|
|
|
|
|
388
|
0
|
|
|
|
|
|
for my $name (@names) { |
|
389
|
0
|
|
|
|
|
|
my ($nn, $xmlns_args) = |
|
390
|
|
|
|
|
|
|
$prefix_xmlns->($name); |
|
391
|
0
|
|
|
|
|
|
push @expect, PRANG::Graph::Element->new( |
|
392
|
|
|
|
|
|
|
%$xmlns_args, |
|
393
|
|
|
|
|
|
|
attrName => $self->name, |
|
394
|
|
|
|
|
|
|
nodeClass => $class, |
|
395
|
|
|
|
|
|
|
nodeName => $nn, |
|
396
|
|
|
|
|
|
|
); |
|
397
|
0
|
|
|
|
|
|
delete $nodeName->{$name}; |
|
398
|
|
|
|
|
|
|
} |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
|
|
401
|
0
|
0
|
|
|
|
|
if ($expect_bool) { |
|
402
|
|
|
|
|
|
|
my (@names) = grep { |
|
403
|
0
|
|
|
|
|
|
!$t_c{$nodeName->{$_}}->is_a_type_of("Object") |
|
|
0
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
} keys %$nodeName; |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# 'Bool' elements are a shorthand for the element |
|
407
|
|
|
|
|
|
|
# 'maybe' being there. |
|
408
|
0
|
|
|
|
|
|
for my $name (@names) { |
|
409
|
0
|
|
|
|
|
|
my ($nn, $xmlns_args) = $prefix_xmlns->($name); |
|
410
|
0
|
|
|
|
|
|
push @expect, PRANG::Graph::Element->new( |
|
411
|
|
|
|
|
|
|
%$xmlns_args, |
|
412
|
|
|
|
|
|
|
attrName => $self->name, |
|
413
|
|
|
|
|
|
|
attIsArray => $expect_many, |
|
414
|
|
|
|
|
|
|
nodeName => $nn, |
|
415
|
|
|
|
|
|
|
); |
|
416
|
0
|
|
|
|
|
|
delete $nodeName->{$name}; |
|
417
|
|
|
|
|
|
|
} |
|
418
|
|
|
|
|
|
|
} |
|
419
|
0
|
0
|
|
|
|
|
if ($expect_simple) { |
|
420
|
|
|
|
|
|
|
my (@names) = grep { |
|
421
|
0
|
|
|
|
|
|
my $t_c = $t_c{$nodeName->{$_}}; |
|
|
0
|
|
|
|
|
|
|
|
422
|
0
|
0
|
|
|
|
|
die "dang, " |
|
423
|
|
|
|
|
|
|
.$self->name." of " |
|
424
|
|
|
|
|
|
|
.$self->associated_class->name |
|
425
|
|
|
|
|
|
|
.", no type constraint called $nodeName->{$_} (element $_)" |
|
426
|
|
|
|
|
|
|
if !$t_c; |
|
427
|
0
|
|
|
|
|
|
!$t_c->is_a_type_of("Object") |
|
428
|
|
|
|
|
|
|
} keys %$nodeName; |
|
429
|
0
|
|
|
|
|
|
for my $name (@names) { |
|
430
|
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
# 'Str', 'Int', etc element attributes: this |
|
432
|
|
|
|
|
|
|
# means an XML data type: <attr>value</attr> |
|
433
|
0
|
0
|
|
|
|
|
if ( !length($name) ) { |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# this is for 'mixed' data |
|
436
|
0
|
|
|
|
|
|
push @expect, PRANG::Graph::Text->new( |
|
437
|
|
|
|
|
|
|
attrName => $self->name, |
|
438
|
|
|
|
|
|
|
); |
|
439
|
|
|
|
|
|
|
} |
|
440
|
|
|
|
|
|
|
else { |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# regular XML data style |
|
443
|
0
|
|
|
|
|
|
my ($nn, $xmlns_args) = |
|
444
|
|
|
|
|
|
|
$prefix_xmlns->($name); |
|
445
|
0
|
|
|
|
|
|
push @expect, PRANG::Graph::Element->new( |
|
446
|
|
|
|
|
|
|
%$xmlns_args, |
|
447
|
|
|
|
|
|
|
attrName => $self->name, |
|
448
|
|
|
|
|
|
|
nodeName => $nn, |
|
449
|
|
|
|
|
|
|
contents => PRANG::Graph::Text->new, |
|
450
|
|
|
|
|
|
|
); |
|
451
|
|
|
|
|
|
|
} |
|
452
|
0
|
|
|
|
|
|
delete $nodeName->{$name}; |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
} |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# determine if we need explicit attributes to record the |
|
457
|
|
|
|
|
|
|
# nodename and/or XML namespace. |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# first rule. If multiple prefix:nodeName entries map to the |
|
460
|
|
|
|
|
|
|
# same type, then we would have an ambiguous type map, and |
|
461
|
|
|
|
|
|
|
# therefore need at least one of name_attr and xmlns_attr |
|
462
|
0
|
|
|
|
|
|
my $have_ambiguous; |
|
463
|
0
|
|
|
|
|
|
my (%seen_types, %seen_xmlns, %seen_localname); |
|
464
|
0
|
|
|
|
|
|
my $fixed_xmlns = $self->xmlns; |
|
465
|
0
|
|
|
|
|
|
my $use_prefixes = $self->has_xml_nodeName_prefix; |
|
466
|
0
|
0
|
0
|
|
|
|
if ( $fixed_xmlns and $use_prefixes ) { |
|
467
|
0
|
|
|
|
|
|
$self->error( |
|
468
|
|
|
|
|
|
|
"specify only one of 'xmlns' / 'xml_nodeName_prefix' (note: latter may be implied by use of roles)" |
|
469
|
|
|
|
|
|
|
); |
|
470
|
|
|
|
|
|
|
} |
|
471
|
0
|
|
|
|
|
|
while ( my ($element_fullname, $class) = |
|
472
|
0
|
|
|
|
|
|
each %{$self->xml_nodeName}) |
|
473
|
0
|
|
|
|
|
|
{ my ($xmlns, $localname); |
|
474
|
0
|
0
|
|
|
|
|
if ($use_prefixes) { |
|
475
|
0
|
|
|
|
|
|
(my $prefix, $localname) = |
|
476
|
|
|
|
|
|
|
($element_fullname =~ /^(?:(\w+):)?(\w+|\*)/); |
|
477
|
0
|
|
0
|
|
|
|
$prefix //= ""; |
|
478
|
0
|
|
0
|
|
|
|
$xmlns = $nodeName_prefix->{$prefix}//""; |
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
else { |
|
481
|
0
|
|
|
|
|
|
$localname = $element_fullname; |
|
482
|
0
|
|
0
|
|
|
|
$xmlns = $fixed_xmlns//""; |
|
483
|
|
|
|
|
|
|
} |
|
484
|
|
|
|
|
|
|
|
|
485
|
0
|
|
0
|
|
|
|
$localname //= ""; |
|
486
|
0
|
|
|
|
|
|
$seen_localname{$localname}++; |
|
487
|
0
|
|
|
|
|
|
$seen_xmlns{$xmlns}++; |
|
488
|
|
|
|
|
|
|
|
|
489
|
0
|
0
|
|
|
|
|
$have_ambiguous++ if $localname eq "*"; |
|
490
|
0
|
0
|
|
|
|
|
$have_ambiguous++ if $xmlns eq "*"; |
|
491
|
|
|
|
|
|
|
|
|
492
|
0
|
|
|
|
|
|
my $ent = [ $xmlns, $localname ]; |
|
493
|
0
|
0
|
|
|
|
|
if ( my $aref = $seen_types{$class} ) { |
|
494
|
0
|
|
|
|
|
|
$have_ambiguous++; |
|
495
|
0
|
|
|
|
|
|
push @$aref, $ent; |
|
496
|
|
|
|
|
|
|
} |
|
497
|
|
|
|
|
|
|
else { |
|
498
|
0
|
|
|
|
|
|
$seen_types{$class} = [$ent]; |
|
499
|
|
|
|
|
|
|
} |
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# if all nodes have the same localname, we can use just |
|
503
|
|
|
|
|
|
|
# xmlns_attr. if all nodes have the same xmlns, we can use |
|
504
|
|
|
|
|
|
|
# just name_attr |
|
505
|
0
|
|
|
|
|
|
my @name_attr; |
|
506
|
0
|
0
|
0
|
|
|
|
if ($have_ambiguous) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
507
|
0
|
0
|
0
|
|
|
|
if ( keys %seen_localname > 1 or $seen_localname{"*"} ) { |
|
508
|
0
|
0
|
|
|
|
|
if ( !$self->has_xml_nodeName_attr ) { |
|
509
|
0
|
|
|
|
|
|
$self->error( |
|
510
|
|
|
|
|
|
|
"xml_nodeName map ambiguities or wildcarding imply need for " |
|
511
|
|
|
|
|
|
|
."xml_nodeName_attr, but none given", |
|
512
|
|
|
|
|
|
|
); |
|
513
|
|
|
|
|
|
|
} |
|
514
|
|
|
|
|
|
|
else { |
|
515
|
0
|
|
|
|
|
|
my $attr = $self->xml_nodeName_attr; |
|
516
|
0
|
|
|
|
|
|
push @name_attr, name_attr => $attr; |
|
517
|
0
|
|
|
|
|
|
for my $x (@expect) { |
|
518
|
0
|
|
|
|
|
|
$x->nodeName_attr($attr); |
|
519
|
|
|
|
|
|
|
} |
|
520
|
|
|
|
|
|
|
} |
|
521
|
|
|
|
|
|
|
} |
|
522
|
|
|
|
|
|
|
else { |
|
523
|
0
|
|
0
|
|
|
|
push @name_attr, |
|
524
|
|
|
|
|
|
|
xml_nodeName => (keys %seen_localname)[0]//""; |
|
525
|
|
|
|
|
|
|
} |
|
526
|
|
|
|
|
|
|
|
|
527
|
0
|
0
|
0
|
|
|
|
if ( keys %seen_xmlns > 1 or $seen_xmlns{"*"} ) { |
|
528
|
0
|
0
|
|
|
|
|
if ( !$self->has_xmlns_attr ) { |
|
529
|
0
|
|
|
|
|
|
$self->error( |
|
530
|
|
|
|
|
|
|
"xml_nodeName map ambiguities or wildcarding imply need for " |
|
531
|
|
|
|
|
|
|
."xmlns_attr, but none given", |
|
532
|
|
|
|
|
|
|
); |
|
533
|
|
|
|
|
|
|
} |
|
534
|
|
|
|
|
|
|
else { |
|
535
|
0
|
|
|
|
|
|
my $attr = $self->xmlns_attr; |
|
536
|
0
|
|
|
|
|
|
push @name_attr, xmlns_attr => $attr; |
|
537
|
0
|
|
|
|
|
|
for my $x (@expect) { |
|
538
|
0
|
|
|
|
|
|
$x->xmlns_attr($attr); |
|
539
|
|
|
|
|
|
|
} |
|
540
|
|
|
|
|
|
|
} |
|
541
|
|
|
|
|
|
|
} |
|
542
|
|
|
|
|
|
|
else { |
|
543
|
0
|
|
0
|
|
|
|
push @name_attr, xmlns => (keys %seen_xmlns)[0]//""; |
|
544
|
|
|
|
|
|
|
} |
|
545
|
|
|
|
|
|
|
} |
|
546
|
|
|
|
|
|
|
elsif ( $self->has_xmlns_attr or $self->has_xml_nodeName_attr ) { |
|
547
|
0
|
|
|
|
|
|
$self->error( |
|
548
|
|
|
|
|
|
|
"unnecessary use of xmlns_attr / xml_nodeName_attr"); |
|
549
|
|
|
|
|
|
|
} |
|
550
|
|
|
|
|
|
|
elsif ( $self->has_xml_nodeName ) { |
|
551
|
0
|
|
|
|
|
|
push @name_attr, type_map => {%{$self->xml_nodeName}}; |
|
|
0
|
|
|
|
|
|
|
|
552
|
0
|
0
|
|
|
|
|
if ( $self->has_xml_nodeName_prefix ) { |
|
553
|
|
|
|
|
|
|
push @name_attr, type_map_prefix => |
|
554
|
0
|
|
|
|
|
|
{%{$self->xml_nodeName_prefix}}; |
|
|
0
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
} |
|
556
|
|
|
|
|
|
|
} |
|
557
|
|
|
|
|
|
|
|
|
558
|
0
|
0
|
|
|
|
|
if ( @expect > 1 ) { |
|
559
|
0
|
|
|
|
|
|
$node = PRANG::Graph::Choice->new( |
|
560
|
|
|
|
|
|
|
choices => \@expect, |
|
561
|
|
|
|
|
|
|
attrName => $self->name, |
|
562
|
|
|
|
|
|
|
@name_attr, |
|
563
|
|
|
|
|
|
|
); |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
else { |
|
566
|
0
|
|
|
|
|
|
$node = $expect[0]; |
|
567
|
0
|
0
|
|
|
|
|
if ( $self->has_xml_nodeName_attr ) { |
|
568
|
0
|
|
|
|
|
|
$node->nodeName_attr($self->xml_nodeName_attr); |
|
569
|
|
|
|
|
|
|
} |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
|
|
572
|
0
|
0
|
|
|
|
|
if ($expect_bool) { |
|
573
|
0
|
|
|
|
|
|
$expect_one = 0; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
0
|
0
|
0
|
|
|
|
if ( $expect_one |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
576
|
|
|
|
|
|
|
and !$expect_simple |
|
577
|
|
|
|
|
|
|
and |
|
578
|
|
|
|
|
|
|
!$self->is_required and !$self->has_default |
|
579
|
|
|
|
|
|
|
) |
|
580
|
|
|
|
|
|
|
{ |
|
581
|
0
|
|
|
|
|
|
$self->warn_of( |
|
582
|
|
|
|
|
|
|
"expected element is not required, this can cause errors on marshall out" |
|
583
|
|
|
|
|
|
|
); |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# this is probably a bit harsh. |
|
586
|
|
|
|
|
|
|
#$self->meta->find_attribute_by_name("required")->set_value( |
|
587
|
|
|
|
|
|
|
# $self, 1, |
|
588
|
|
|
|
|
|
|
# ); |
|
589
|
|
|
|
|
|
|
} |
|
590
|
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
# deal with limits |
|
592
|
0
|
0
|
0
|
|
|
|
if ( !$expect_one or $expect_many) { |
|
593
|
0
|
|
|
|
|
|
my @min_max; |
|
594
|
0
|
0
|
0
|
|
|
|
if ( $expect_one and !$self->has_xml_min ) { |
|
595
|
0
|
|
|
|
|
|
$self->xml_min(1); |
|
596
|
|
|
|
|
|
|
} |
|
597
|
0
|
0
|
|
|
|
|
if ( $self->has_xml_min ) { |
|
598
|
0
|
|
|
|
|
|
push @min_max, min => $self->xml_min; |
|
599
|
|
|
|
|
|
|
} |
|
600
|
0
|
0
|
0
|
|
|
|
if ( !$expect_many and !$self->has_xml_max ) { |
|
601
|
0
|
|
|
|
|
|
$self->xml_max(1); |
|
602
|
|
|
|
|
|
|
} |
|
603
|
0
|
0
|
|
|
|
|
if ( $self->has_xml_max ) { |
|
604
|
0
|
|
|
|
|
|
push @min_max, max => $self->xml_max; |
|
605
|
|
|
|
|
|
|
} |
|
606
|
0
|
0
|
|
|
|
|
die "no node! fail! processing " |
|
607
|
|
|
|
|
|
|
.$self->associated_class->name |
|
608
|
|
|
|
|
|
|
.", element " |
|
609
|
|
|
|
|
|
|
.$self->name |
|
610
|
|
|
|
|
|
|
unless $node; |
|
611
|
0
|
|
|
|
|
|
$node = PRANG::Graph::Quantity->new( |
|
612
|
|
|
|
|
|
|
@min_max, |
|
613
|
|
|
|
|
|
|
attrName => $self->name, |
|
614
|
|
|
|
|
|
|
child => $node, |
|
615
|
|
|
|
|
|
|
); |
|
616
|
|
|
|
|
|
|
} |
|
617
|
|
|
|
|
|
|
else { |
|
618
|
0
|
|
|
|
|
|
$self->xml_min(1); |
|
619
|
0
|
|
|
|
|
|
$self->xml_max(1); |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
0
|
|
|
|
|
|
return $node; |
|
623
|
|
|
|
|
|
|
} |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
package Moose::Meta::Attribute::Custom::Trait::PRANG::Element; |
|
626
|
|
|
|
|
|
|
$Moose::Meta::Attribute::Custom::Trait::PRANG::Element::VERSION = '0.20'; |
|
627
|
|
|
|
|
|
|
sub register_implementation { |
|
628
|
0
|
|
|
0
|
|
|
"PRANG::Graph::Meta::Element"; |
|
629
|
|
|
|
|
|
|
} |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
1; |
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
=head1 NAME |
|
634
|
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
PRANG::Graph::Meta::Element - metaclass metarole for XML elements |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
use PRANG::Graph; |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
has_element 'somechild' => |
|
642
|
|
|
|
|
|
|
is => "rw", |
|
643
|
|
|
|
|
|
|
isa => "Some::Type", |
|
644
|
|
|
|
|
|
|
xml_required => 0, |
|
645
|
|
|
|
|
|
|
; |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# equivalent alternative - plays well with others! |
|
648
|
|
|
|
|
|
|
has 'somechild' => |
|
649
|
|
|
|
|
|
|
is => "rw", |
|
650
|
|
|
|
|
|
|
traits => [qw/PRANG::Element/], |
|
651
|
|
|
|
|
|
|
isa => "Some::Type", |
|
652
|
|
|
|
|
|
|
xml_required => 0, |
|
653
|
|
|
|
|
|
|
; |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
The PRANG concept is that attributes in your classes are marked to |
|
658
|
|
|
|
|
|
|
correspond with attributes and elements in your XML. This class is |
|
659
|
|
|
|
|
|
|
for marking your class' attributes as XML I<elements>. For marking |
|
660
|
|
|
|
|
|
|
them as XML I<attributes>, see L<PRANG::Graph::Meta::Attr>. |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Non-trivial elements - and this means elements which contain more than |
|
663
|
|
|
|
|
|
|
a single TextNode element within - are mapped to Moose classes. The |
|
664
|
|
|
|
|
|
|
child elements that are allowed within that class correspond to the |
|
665
|
|
|
|
|
|
|
attributes marked with the C<PRANG::Element> trait, either via |
|
666
|
|
|
|
|
|
|
C<has_element> or the Moose C<traits> keyword. |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Where it makes sense, as much as possible is set up from the regular |
|
669
|
|
|
|
|
|
|
Moose definition of the attribute. This includes the XML node name, |
|
670
|
|
|
|
|
|
|
the type constraint, and also the predicate. |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
If you like, you can also set the C<xmlns> and C<xml_nodeName> |
|
673
|
|
|
|
|
|
|
attribute property, to override the default behaviour, which is to |
|
674
|
|
|
|
|
|
|
assume that the XML element name matches the Moose attribute name, and |
|
675
|
|
|
|
|
|
|
that the XML namespace of the element is that of the enclosing class |
|
676
|
|
|
|
|
|
|
(ie, C<$class-E<gt>xmlns>), if defined. |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
The B<order> of declaring element attributes is important. They |
|
679
|
|
|
|
|
|
|
implicitly define a "sequence". To specify a "choice", you must use a |
|
680
|
|
|
|
|
|
|
union sub-type - see below. Care must be taken with bundling element |
|
681
|
|
|
|
|
|
|
attributes into roles as ordering when composing is not defined. |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
The B<predicate> property of the attribute is also important. If you |
|
684
|
|
|
|
|
|
|
do not define C<predicate>, then the attribute is considered |
|
685
|
|
|
|
|
|
|
I<required>. This can be overridden by specifying C<xml_required> (it |
|
686
|
|
|
|
|
|
|
must be defined to be effective). |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
The B<isa> property (B<type constraint>) you set via 'isa' is |
|
689
|
|
|
|
|
|
|
I<required>. The behaviour for major types is described below. The |
|
690
|
|
|
|
|
|
|
module knows about sub-typing, and so if you specify a sub-type of one |
|
691
|
|
|
|
|
|
|
of these types, then the behaviour will be as for the type on this |
|
692
|
|
|
|
|
|
|
list. Only a limited subset of higher-order/parametric/structured |
|
693
|
|
|
|
|
|
|
types are permitted as described. |
|
694
|
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=over 4 |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=item B<Bool sub-type> |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
If the attribute is a Bool sub-type (er, or just "Bool", then the |
|
700
|
|
|
|
|
|
|
element will marshall to the empty element if true, or no element if |
|
701
|
|
|
|
|
|
|
false. The requirement that C<predicate> be defined is relaxed for |
|
702
|
|
|
|
|
|
|
C<Bool> sub-types. |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
ie, C<Bool> will serialise to: |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
<object> |
|
707
|
|
|
|
|
|
|
<somechild /> |
|
708
|
|
|
|
|
|
|
</object> |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
For true and |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
<object> |
|
713
|
|
|
|
|
|
|
</object> |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
For false. |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item B<Scalar sub-type> |
|
718
|
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
If it is a Scalar subtype (eg, an enum, a Str or an Int), then the |
|
720
|
|
|
|
|
|
|
value of the Moose attribute is marshalled to the value of the element |
|
721
|
|
|
|
|
|
|
as a TextNode; eg |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
<somechild>somevalue</somechild> |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=item B<Object sub-type> |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
If the attribute is an Object subtype (ie, a Class), then the element |
|
728
|
|
|
|
|
|
|
is serialised according to the definition of the Class defined. |
|
729
|
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
eg, with; |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
{ |
|
733
|
|
|
|
|
|
|
package CD; |
|
734
|
|
|
|
|
|
|
use Moose; use PRANG::Graph; |
|
735
|
|
|
|
|
|
|
has_element 'author' => qw( is rw isa Person ); |
|
736
|
|
|
|
|
|
|
has_attr 'name' => qw( is rw isa Str ); |
|
737
|
|
|
|
|
|
|
} |
|
738
|
|
|
|
|
|
|
{ |
|
739
|
|
|
|
|
|
|
package Person; |
|
740
|
|
|
|
|
|
|
use Moose; use PRANG::Graph; |
|
741
|
|
|
|
|
|
|
has_attr 'group' => qw( is rw isa Bool ); |
|
742
|
|
|
|
|
|
|
has_attr 'name' => qw( is rw isa Str ); |
|
743
|
|
|
|
|
|
|
has_element 'deceased' => qw( is rw isa Bool ); |
|
744
|
|
|
|
|
|
|
} |
|
745
|
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Then the object; |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
CD->new( |
|
749
|
|
|
|
|
|
|
name => "2Pacalypse Now", |
|
750
|
|
|
|
|
|
|
author => Person->new( |
|
751
|
|
|
|
|
|
|
group => 0, |
|
752
|
|
|
|
|
|
|
name => "Tupac Shakur", |
|
753
|
|
|
|
|
|
|
deceased => 1, |
|
754
|
|
|
|
|
|
|
) |
|
755
|
|
|
|
|
|
|
); |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Would serialise to (assuming that there is a L<PRANG::Graph> document |
|
758
|
|
|
|
|
|
|
type with C<cd> as a root element): |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
<cd name="2Pacalypse Now"> |
|
761
|
|
|
|
|
|
|
<author group="0" name="Tupac Shakur> |
|
762
|
|
|
|
|
|
|
<deceased /> |
|
763
|
|
|
|
|
|
|
</author> |
|
764
|
|
|
|
|
|
|
</cd> |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
=item B<ArrayRef sub-type> |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
An C<ArrayRef> sub-type indicates that the element may occur multiple |
|
769
|
|
|
|
|
|
|
times at this point. Bounds may be specified directly - the |
|
770
|
|
|
|
|
|
|
C<xml_min> and C<xml_max> attribute properties. |
|
771
|
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Higher-order types are supported; in fact, to not specify the type of |
|
773
|
|
|
|
|
|
|
the elements of the array is a big no-no. |
|
774
|
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
If C<xml_nodeName> is specified, it refers to the items; no array |
|
776
|
|
|
|
|
|
|
container node is expected. |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
For example; |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
has_attr 'name' => |
|
781
|
|
|
|
|
|
|
is => "rw", |
|
782
|
|
|
|
|
|
|
isa => "Str", |
|
783
|
|
|
|
|
|
|
; |
|
784
|
|
|
|
|
|
|
has_attr 'releases' => |
|
785
|
|
|
|
|
|
|
is => "rw", |
|
786
|
|
|
|
|
|
|
isa => "ArrayRef[CD]", |
|
787
|
|
|
|
|
|
|
xml_min => 0, |
|
788
|
|
|
|
|
|
|
xml_nodeName => "cd", |
|
789
|
|
|
|
|
|
|
; |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
Assuming that this property appeared in the definition for 'artist', |
|
792
|
|
|
|
|
|
|
and that CD C<has_attr 'title'...>, it would let you parse: |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
<artist> |
|
795
|
|
|
|
|
|
|
<name>The Headless Chickens</name> |
|
796
|
|
|
|
|
|
|
<cd title="Stunt Clown">...<cd> |
|
797
|
|
|
|
|
|
|
<cd title="Body Blow">...<cd> |
|
798
|
|
|
|
|
|
|
<cd title="Greedy">...<cd> |
|
799
|
|
|
|
|
|
|
</artist> |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
You cannot (currently) Union an ArrayRef type with other simple types. |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item B<Union types> |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Union types are special; they indicate that any one of the types |
|
806
|
|
|
|
|
|
|
indicated may be expected next. By default, the name of the element |
|
807
|
|
|
|
|
|
|
is still the name of the Moose attribute, and if the case is that a |
|
808
|
|
|
|
|
|
|
particular element may just be repeated any number of times, this is |
|
809
|
|
|
|
|
|
|
fine. |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
However, this can be inconvenient in the typical case where the |
|
812
|
|
|
|
|
|
|
alternation is between a set of elements which are allowed in the |
|
813
|
|
|
|
|
|
|
particular context, each corresponding to a particular Moose type. |
|
814
|
|
|
|
|
|
|
Another one is the case of mixed XML, where there may be text, then |
|
815
|
|
|
|
|
|
|
XML fragments, more text, more XML, etc. |
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
There are two relevant questions to answer. When marshalling OUT, we |
|
818
|
|
|
|
|
|
|
want to know what element name to use for the attribute in the slot. |
|
819
|
|
|
|
|
|
|
When marshalling IN, we need to know what element names are allowable, |
|
820
|
|
|
|
|
|
|
and potentially which sub-type to expect for a particular element |
|
821
|
|
|
|
|
|
|
name. |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
After applying much DWIMery, the following scenarios arise; |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=over |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item B<1:1 mapping from Type to Element name> |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
This is often the case for message containers that allow any number of |
|
830
|
|
|
|
|
|
|
a collection of classes inside. For this case, a map must be provided |
|
831
|
|
|
|
|
|
|
to the C<xml_nodeName> function, which allows marshalling in and out |
|
832
|
|
|
|
|
|
|
to proceed. |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
has_element 'message' => |
|
835
|
|
|
|
|
|
|
is => "rw", |
|
836
|
|
|
|
|
|
|
isa => "my::unionType", |
|
837
|
|
|
|
|
|
|
xml_nodeName => { |
|
838
|
|
|
|
|
|
|
"nodename" => "TypeA", |
|
839
|
|
|
|
|
|
|
"somenode" => "TypeB", |
|
840
|
|
|
|
|
|
|
}; |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
It is an error if types are repeated in the map. The empty string can |
|
843
|
|
|
|
|
|
|
be used as a node name for text nodes, otherwise they are not allowed. |
|
844
|
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
This case is made of win because no extra attributes are required to |
|
846
|
|
|
|
|
|
|
help the marshaller; the type of the data is enough. |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
An example of this in practice; |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
subtype "My::XML::Language::choice0" |
|
851
|
|
|
|
|
|
|
=> as join("|", map { "My::XML::Language::$_" } |
|
852
|
|
|
|
|
|
|
qw( CD Store Person ) ); |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
has_element 'things' => |
|
855
|
|
|
|
|
|
|
is => "rw", |
|
856
|
|
|
|
|
|
|
isa => "ArrayRef[My::XML::Language::choice0]", |
|
857
|
|
|
|
|
|
|
xml_nodeName => +{ map {( lc($_) => $_ )} qw(CD Store Person) }, |
|
858
|
|
|
|
|
|
|
; |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
This would allow the enclosing class to have a 'things' property, |
|
861
|
|
|
|
|
|
|
which contains all of the elements at that point, which can be C<cd>, |
|
862
|
|
|
|
|
|
|
C<store> or C<person> elements. |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
In this case, it may be preferrable to pass a role name as the element |
|
865
|
|
|
|
|
|
|
type, and let this module evaluate construct the C<xml_nodeName> map |
|
866
|
|
|
|
|
|
|
itself. |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
=item B<more types than element names> |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
This happens when some of the types have different XML namespaces; the |
|
871
|
|
|
|
|
|
|
type of the node is indicated by the namespace prefix. |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
In this case, you must supply a namespace map, too. |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
has_element 'message' => |
|
876
|
|
|
|
|
|
|
is => "rw", |
|
877
|
|
|
|
|
|
|
isa => "my::unionType", |
|
878
|
|
|
|
|
|
|
xml_nodeName => { |
|
879
|
|
|
|
|
|
|
"trumpery:nodename" => "TypeA", |
|
880
|
|
|
|
|
|
|
"rubble:nodename" => "TypeB", |
|
881
|
|
|
|
|
|
|
"claptrap:nodename" => "TypeC", |
|
882
|
|
|
|
|
|
|
}, |
|
883
|
|
|
|
|
|
|
xml_nodeName_prefix => { |
|
884
|
|
|
|
|
|
|
"trumpery" => "uri:type:A", |
|
885
|
|
|
|
|
|
|
"rubble" => "uri:type:B", |
|
886
|
|
|
|
|
|
|
"claptrap" => "uri:type:C", |
|
887
|
|
|
|
|
|
|
}, |
|
888
|
|
|
|
|
|
|
; |
|
889
|
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
B<FIXME:> this is currently unimplemented. |
|
891
|
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=item B<more element names than types> |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
This can happen for two reasons: one is that the schema that this |
|
895
|
|
|
|
|
|
|
element definition comes from is re-using types. Another is that you |
|
896
|
|
|
|
|
|
|
are just accepting XML without validation (eg, XMLSchema's |
|
897
|
|
|
|
|
|
|
C<processContents="skip"> property). In this case, there needs to be |
|
898
|
|
|
|
|
|
|
another attribute which records the names of the node. |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
has_element 'message' => |
|
901
|
|
|
|
|
|
|
is => "rw", |
|
902
|
|
|
|
|
|
|
isa => "my::unionType", |
|
903
|
|
|
|
|
|
|
xml_nodeName => { |
|
904
|
|
|
|
|
|
|
"nodename" => "TypeA", |
|
905
|
|
|
|
|
|
|
"somenode" => "TypeB", |
|
906
|
|
|
|
|
|
|
"someother" => "TypeB", |
|
907
|
|
|
|
|
|
|
}, |
|
908
|
|
|
|
|
|
|
xml_nodeName_attr => "message_name", |
|
909
|
|
|
|
|
|
|
; |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
If any node name is allowed, then you can simply pass in C<*> as an |
|
912
|
|
|
|
|
|
|
C<xml_nodeName> value. |
|
913
|
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=item B<more namespaces than types> |
|
915
|
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
The principle use of this is L<PRANG::XMLSchema::Whatever>, which |
|
917
|
|
|
|
|
|
|
converts arbitrarily namespaced XML into objects. In this case, |
|
918
|
|
|
|
|
|
|
another attribute is needed, to record the XML namespaces of the |
|
919
|
|
|
|
|
|
|
elements. |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
has 'nodenames' => |
|
922
|
|
|
|
|
|
|
is => "rw", |
|
923
|
|
|
|
|
|
|
isa => "ArrayRef[Maybe[Str]]", |
|
924
|
|
|
|
|
|
|
; |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
has 'nodenames_xmlns' => |
|
927
|
|
|
|
|
|
|
is => "rw", |
|
928
|
|
|
|
|
|
|
isa => "ArrayRef[Maybe[Str]]", |
|
929
|
|
|
|
|
|
|
; |
|
930
|
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
has_element 'contents' => |
|
932
|
|
|
|
|
|
|
is => "rw", |
|
933
|
|
|
|
|
|
|
isa => "ArrayRef[PRANG::XMLSchema::Whatever|Str]", |
|
934
|
|
|
|
|
|
|
xml_nodeName => { "" => "Str", "*" => "PRANG::XMLSchema::Whatever" }, |
|
935
|
|
|
|
|
|
|
xml_nodeName_attr => "nodenames", |
|
936
|
|
|
|
|
|
|
xmlns => "*", |
|
937
|
|
|
|
|
|
|
xmlns_attr => "nodenames_xmlns", |
|
938
|
|
|
|
|
|
|
; |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
B<FIXME:> this is currently unimplemented. |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=item B<unknown/extensible element names and types> |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
These are indicated by specifying a role. At the time that the |
|
945
|
|
|
|
|
|
|
L<PRANG::Graph::Node> is built for the attribute, the currently |
|
946
|
|
|
|
|
|
|
available implementors of these roles are checked, which must all |
|
947
|
|
|
|
|
|
|
implement L<PRANG::Graph>. |
|
948
|
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
They Treated as if there is an C<xml_nodeName> entry for the class, |
|
950
|
|
|
|
|
|
|
from the C<root_element> value for the class to the type. This allows |
|
951
|
|
|
|
|
|
|
writing extensible schemas. |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=back |
|
954
|
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=back |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
L<PRANG::Graph::Meta::Attr>, L<PRANG::Graph::Meta::Element>, |
|
960
|
|
|
|
|
|
|
L<PRANG::Graph::Node> |
|
961
|
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head1 AUTHOR AND LICENCE |
|
963
|
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
Development commissioned by NZ Registry Services, and carried out by |
|
965
|
|
|
|
|
|
|
Catalyst IT - L<http://www.catalyst.net.nz/> |
|
966
|
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
Copyright 2009, 2010, NZ Registry Services. This module is licensed |
|
968
|
|
|
|
|
|
|
under the Artistic License v2.0, which permits relicensing under other |
|
969
|
|
|
|
|
|
|
Free Software licenses. |
|
970
|
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
=cut |