1 |
package Whatpm::RDFXML; |
2 |
use strict; |
3 |
|
4 |
## NOTE: EntityReference nodes are not supported except that |
5 |
## unexpected entity reference are simply ignored. (In fact |
6 |
## all EntityRefernce nodes are ignored.) |
7 |
|
8 |
## TODO: Add a callback function invoked for every element |
9 |
## when XMLCC is implemented in WDCC. |
10 |
|
11 |
## ISSUE: <html:nest/> in RDF subtree? |
12 |
|
13 |
## ISSUE: PIs in RDF subtree should be validated? |
14 |
|
15 |
## TODO: Should we validate expanded URI created from QName? |
16 |
|
17 |
## TODO: elements in null namespace (not mentioned in the spec.) |
18 |
|
19 |
my $RDF_URI = q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>; |
20 |
|
21 |
use Char::Class::XML qw(InXML_NCNameStartChar10 InXMLNCNameChar10); |
22 |
require Whatpm::URIChecker; |
23 |
|
24 |
sub new ($) { |
25 |
my $self = bless {fact_level => 'm', grammer_level => 'm', |
26 |
info_level => 'i', next_id => 0}, shift; |
27 |
$self->{onerror} = sub { |
28 |
my %opt = @_; |
29 |
warn $opt{type}, "\n"; |
30 |
}; |
31 |
$self->{ontriple} = sub { |
32 |
my %opt = @_; |
33 |
my $dump_resource = sub { |
34 |
my $resource = shift; |
35 |
if (defined $resource->{uri}) { |
36 |
return '<' . $resource->{uri} . '>'; |
37 |
} elsif (defined $resource->{bnodeid}) { |
38 |
return '_:' . $resource->{bnodeid}; |
39 |
} elsif ($resource->{nodes}) { |
40 |
return '"' . join ('', map {$_->inner_html} @{$resource->{nodes}}) . |
41 |
'"^^<' . $resource->{datatype} . '>'; |
42 |
} elsif (defined $resource->{value}) { |
43 |
return '"' . $resource->{value} . '"' . |
44 |
(defined $resource->{datatype} |
45 |
? '^^<' . $resource->{datatype} . '>' |
46 |
: '@' . $resource->{language}); |
47 |
} else { |
48 |
return '??'; |
49 |
} |
50 |
}; |
51 |
print STDERR $dump_resource->($opt{subject}) . ' '; |
52 |
print STDERR $dump_resource->($opt{predicate}) . ' '; |
53 |
print STDERR $dump_resource->($opt{object}) . "\n"; |
54 |
if ($dump_resource->{id}) { |
55 |
print STDERR $dump_resource->($dump_resource->{id}) . ' '; |
56 |
print STDERR $dump_resource->({uri => $RDF_URI . 'subject'}) . ' '; |
57 |
print STDERR $dump_resource->($opt{subject}) . "\n"; |
58 |
print STDERR $dump_resource->($dump_resource->{id}) . ' '; |
59 |
print STDERR $dump_resource->({uri => $RDF_URI . 'predicate'}) . ' '; |
60 |
print STDERR $dump_resource->($opt{predicate}) . "\n"; |
61 |
print STDERR $dump_resource->($dump_resource->{id}) . ' '; |
62 |
print STDERR $dump_resource->({uri => $RDF_URI . 'object'}) . ' '; |
63 |
print STDERR $dump_resource->($opt{object}) . "\n"; |
64 |
print STDERR $dump_resource->($dump_resource->{id}) . ' '; |
65 |
print STDERR $dump_resource->({uri => $RDF_URI . 'type'}) . ' '; |
66 |
print STDERR $dump_resource->({uri => $RDF_URI . 'Statement'}) . "\n"; |
67 |
} |
68 |
}; |
69 |
return $self; |
70 |
} # new |
71 |
|
72 |
sub convert_document ($$) { |
73 |
my $self = shift; |
74 |
my $node = shift; # Document |
75 |
|
76 |
## ISSUE: An RDF/XML document, either |doc| or |nodeElement| |
77 |
## is allowed as a starting production. However, |nodeElement| |
78 |
## is not a Root Event. |
79 |
|
80 |
my $has_element; |
81 |
|
82 |
for my $cn (@{$node->child_nodes}) { |
83 |
if ($cn->node_type == $cn->ELEMENT_NODE) { |
84 |
unless ($has_element) { |
85 |
if ($cn->manakai_expanded_uri eq $RDF_URI . q<RDF>) { |
86 |
$self->convert_rdf_element ($cn, language => ''); |
87 |
} else { |
88 |
$self->convert_rdf_node_element ($cn, language => ''); |
89 |
} |
90 |
$has_element = 1; |
91 |
} else { |
92 |
$self->{onerror}->(type => 'second node element', |
93 |
level => $self->{grammer_level}, |
94 |
node => $cn); |
95 |
} |
96 |
} elsif ($cn->node_type == $cn->TEXT_NODE or |
97 |
$cn->node_type == $cn->CDATA_SECTION_NODE) { |
98 |
$self->{onerror}->(type => 'character not allowed', |
99 |
level => $self->{grammer_level}, |
100 |
node => $cn); |
101 |
} |
102 |
} |
103 |
} # convert_document |
104 |
|
105 |
my $check_rdf_namespace = sub { |
106 |
my $self = shift; |
107 |
my $node = shift; |
108 |
my $node_nsuri = $node->namespace_uri; |
109 |
return unless defined $node_nsuri; |
110 |
if (substr ($node_nsuri, 0, length $RDF_URI) eq $RDF_URI and |
111 |
length $RDF_URI < length $node_nsuri) { |
112 |
$self->{onerror}->(type => 'bad rdf namespace', |
113 |
level => $self->{fact_level}, # Section 5.1 |
114 |
node => $node); |
115 |
} |
116 |
}; # $check_rdf_namespace |
117 |
|
118 |
sub convert_rdf_element ($$%) { |
119 |
my ($self, $node, %opt) = @_; |
120 |
$opt{language} = '' unless defined $opt{language}; |
121 |
## ISSUE: Not explicitly defined in the spec. |
122 |
|
123 |
$check_rdf_namespace->($self, $node); |
124 |
|
125 |
# |RDF| |
126 |
|
127 |
for my $attr (@{$node->attributes}) { |
128 |
my $nsuri = $attr->namespace_uri; |
129 |
if (defined $nsuri and |
130 |
$nsuri eq q<http://www.w3.org/XML/1998/namespace> and |
131 |
$attr->manakai_local_name eq 'lang') { |
132 |
$opt{language} = $attr->value; |
133 |
next; |
134 |
} |
135 |
|
136 |
my $prefix = $attr->prefix; |
137 |
if (defined $prefix) { |
138 |
next if $prefix =~ /^[Xx][Mm][Ll]/; |
139 |
} else { |
140 |
next if $attr->manakai_local_name =~ /^[Xx][Mm][Ll]/; |
141 |
} |
142 |
|
143 |
$check_rdf_namespace->($self, $attr); |
144 |
$self->{onerror}->(type => 'attribute not allowed', |
145 |
level => $self->{grammer_level}, |
146 |
node => $attr); |
147 |
} |
148 |
|
149 |
# |nodeElementList| |
150 |
for my $cn (@{$node->child_nodes}) { |
151 |
if ($cn->node_type == $cn->ELEMENT_NODE) { |
152 |
$self->convert_node_element ($cn, language => $opt{language}); |
153 |
} elsif ($cn->node_type == $cn->TEXT_NODE or |
154 |
$cn->node_type == $cn->CDATA_SECTION_NODE) { |
155 |
if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) { |
156 |
$self->{onerror}->(type => 'character not allowed', |
157 |
level => $self->{grammer_level}, |
158 |
node => $cn); |
159 |
} |
160 |
} |
161 |
} |
162 |
} # convert_rdf_element |
163 |
|
164 |
my %coreSyntaxTerms = ( |
165 |
$RDF_URI . 'RDF' => 1, |
166 |
$RDF_URI . 'ID' => 1, |
167 |
$RDF_URI . 'about' => 1, |
168 |
$RDF_URI . 'parseType' => 1, |
169 |
$RDF_URI . 'resource' => 1, |
170 |
$RDF_URI . 'nodeID' => 1, |
171 |
$RDF_URI . 'datatype' => 1, |
172 |
); |
173 |
|
174 |
my %oldTerms = ( |
175 |
$RDF_URI . 'aboutEach' => 1, |
176 |
$RDF_URI . 'aboutEachPrefix' => 1, |
177 |
$RDF_URI . 'bagID' => 1, |
178 |
); |
179 |
|
180 |
require Message::DOM::DOMImplementation; |
181 |
my $resolve = sub { |
182 |
return Message::DOM::DOMImplementation->create_uri_reference ($_[0]) |
183 |
->get_absolute_reference ($_[1]->base_uri) |
184 |
->uri_reference; |
185 |
|
186 |
## TODO: Ummm... RDF/XML spec refers dated version of xml:base and RFC 2396... |
187 |
|
188 |
## TODO: Check latest xml:base and IRI spec... |
189 |
## (non IRI/URI chars should be percent-encoded before resolve?) |
190 |
}; # $resolve |
191 |
|
192 |
my $generate_bnodeid = sub { |
193 |
return 'g'.$_[0]->{next_id}++; |
194 |
}; # $generate_bnodeid |
195 |
|
196 |
my $get_bnodeid = sub { |
197 |
return 'b'.$_[0]; |
198 |
}; # $get_bnodeid |
199 |
|
200 |
my $uri_attr = sub { |
201 |
my ($self, $attr) = @_; |
202 |
|
203 |
my $abs_uri = $resolve->($attr->value, $attr); |
204 |
|
205 |
Whatpm::URIChecker->check_iri_reference ($abs_uri, sub { |
206 |
my %opt = @_; |
207 |
$self->{onerror}->(node => $attr, level => $opt{level}, |
208 |
type => 'URI::'.$opt{type}. |
209 |
(defined $opt{position} ? ':'.$opt{position} : '')); |
210 |
}); |
211 |
|
212 |
return $abs_uri; |
213 |
}; # $uri_attr |
214 |
|
215 |
my $id_attr = sub { |
216 |
my ($self, $attr) = @_; |
217 |
|
218 |
my $id = $attr->value; |
219 |
unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) { |
220 |
$self->{onerror}->(type => 'syntax error', ## TODO: type |
221 |
level => $self->{grammer_level}, |
222 |
node => $attr); |
223 |
} |
224 |
|
225 |
my $base_uri = $attr->base_uri; |
226 |
if ($self->{id}->{$base_uri}->{$id}) { |
227 |
$self->{onerror}->(type => 'duplicate rdf id', ## TODO: type |
228 |
level => $self->{small_must_level}, |
229 |
node => $attr); |
230 |
## TODO: RDF Validator? |
231 |
} else { |
232 |
$self->{id}->{$base_uri}->{$id} = 1; |
233 |
} |
234 |
|
235 |
return $resolve->('#' . $id, $attr); |
236 |
}; # $id_attr |
237 |
|
238 |
my $check_local_attr = sub { |
239 |
my ($self, $node, $attr, $attr_xuri) = @_; |
240 |
|
241 |
if ({ |
242 |
ID => 1, about => 1, resource => 1, parseType => 1, type => 1, |
243 |
}->{$attr_xuri}) { |
244 |
$self->{onerror}->(type => 'unqualified rdf attr', ## TODO: type |
245 |
level => $self->{should_level}, |
246 |
node => $attr); |
247 |
if ($node->has_attribute_ns ($RDF_URI, $attr_xuri)) { |
248 |
$self->{onerror}->(type => 'duplicate unqualified attr',## TODO: type |
249 |
level => $self->{fact_level}, |
250 |
node => $attr); |
251 |
## NOTE: <? rdfa:bout="" about=""> and such are not catched |
252 |
## by this check; but who cares? rdfa:bout="" is itself illegal. |
253 |
} |
254 |
$attr_xuri = $RDF_URI . $attr_xuri; |
255 |
} else { |
256 |
$self->{onerror}->(type => 'unqualified attr', ## TODO: type |
257 |
level => $self->{fact_level}, |
258 |
node => $attr); |
259 |
## TODO: RDF Validator? |
260 |
} |
261 |
|
262 |
return $attr_xuri; |
263 |
}; # $check_local_attr |
264 |
|
265 |
sub convert_node_element ($$;%) { |
266 |
my ($self, $node, %opt) = @_; |
267 |
$opt{language} = '' unless defined $opt{language}; |
268 |
## ISSUE: Not explicitly defined in the spec. |
269 |
|
270 |
$check_rdf_namespace->($self, $node); |
271 |
|
272 |
# |nodeElement| |
273 |
|
274 |
my $xuri = $node->manakai_expanded_uri; |
275 |
|
276 |
if ({ |
277 |
%coreSyntaxTerms, |
278 |
$RDF_URI . 'li' => 1, |
279 |
%oldTerms, |
280 |
}->{$xuri}) { |
281 |
$self->{onerror}->(type => 'element not allowed', |
282 |
level => $self->{grammer_level}, |
283 |
node => $node); |
284 |
|
285 |
## TODO: W3C RDF Validator: Continue validation, but triples that would |
286 |
## be generated from the subtree are ignored. |
287 |
} |
288 |
|
289 |
my $subject; |
290 |
my $type_attr; |
291 |
my @prop_attr; |
292 |
|
293 |
for my $attr (@{$node->attributes}) { |
294 |
my $nsuri = $attr->namespace_uri; |
295 |
if (defined $nsuri and |
296 |
$nsuri eq q<http://www.w3.org/XML/1998/namespace> and |
297 |
$attr->manakai_local_name eq 'lang') { |
298 |
$opt{language} = $attr->value; |
299 |
} |
300 |
|
301 |
my $prefix = $attr->prefix; |
302 |
if (defined $prefix) { |
303 |
next if $prefix =~ /^[Xx][Mm][Ll]/; |
304 |
} else { |
305 |
next if $attr->manakai_local_name =~ /^[Xx][Mm][Ll]/; |
306 |
} |
307 |
|
308 |
$check_rdf_namespace->($self, $attr); |
309 |
|
310 |
my $attr_xuri = $attr->manakai_expanded_uri; |
311 |
|
312 |
unless (defined $nsuri) { |
313 |
$attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri); |
314 |
} |
315 |
|
316 |
if ($attr_xuri eq $RDF_URI . 'ID') { |
317 |
unless (defined $subject) { |
318 |
$subject = {uri => $id_attr->($self, $attr)}; |
319 |
} else { |
320 |
$self->{onerror}->(type => 'attribute not allowed', |
321 |
level => $self->{grammer_level}, |
322 |
node => $attr); |
323 |
|
324 |
## TODO: Ignore triple as W3C RDF Validator does |
325 |
} |
326 |
} elsif ($attr_xuri eq $RDF_URI . 'nodeID') { |
327 |
unless (defined $subject) { |
328 |
my $id = $attr->value; |
329 |
unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) { |
330 |
$self->{onerror}->(type => 'syntax error', ## TODO: type |
331 |
level => $self->{grammer_level}, |
332 |
node => $self); |
333 |
} |
334 |
|
335 |
$subject = {bnodeid => $get_bnodeid->($id)}; |
336 |
} else { |
337 |
$self->{onerror}->(type => 'attribute not allowed', |
338 |
level => $self->{grammer_level}, |
339 |
node => $attr); |
340 |
|
341 |
## TODO: Ignore triple as W3C RDF Validator does |
342 |
} |
343 |
} elsif ($attr_xuri eq $RDF_URI . 'about') { |
344 |
unless (defined $subject) { |
345 |
$subject = {uri => $uri_attr->($self, $attr)}; |
346 |
} else { |
347 |
$self->{onerror}->(type => 'attribute not allowed', |
348 |
level => $self->{grammer_level}, |
349 |
node => $attr); |
350 |
|
351 |
## TODO: Ignore triple as W3C RDF Validator does |
352 |
} |
353 |
} elsif ($attr_xuri eq $RDF_URI . 'type') { |
354 |
$type_attr = $attr; |
355 |
} elsif ({ |
356 |
%coreSyntaxTerms, |
357 |
$RDF_URI . 'li' => 1, |
358 |
$RDF_URI . 'Description' => 1, |
359 |
%oldTerms, |
360 |
}->{$attr_xuri}) { |
361 |
$self->{onerror}->(type => 'attribute not allowed', |
362 |
level => $self->{grammer_level}, |
363 |
node => $attr); |
364 |
|
365 |
## TODO: W3C RDF Validator: Ignore triples |
366 |
} else { |
367 |
push @prop_attr, $attr; |
368 |
} |
369 |
} |
370 |
|
371 |
unless (defined $subject) { |
372 |
$subject = {bnodeid => $generate_bnodeid->($self)}; |
373 |
} |
374 |
|
375 |
if ($xuri ne $RDF_URI . 'Description') { |
376 |
$self->{ontriple}->(subject => $subject, |
377 |
predicate => {uri => $RDF_URI . 'type'}, |
378 |
object => {uri => $xuri}, |
379 |
node => $node); |
380 |
} |
381 |
|
382 |
if ($type_attr) { |
383 |
$self->{ontriple}->(subject => $subject, |
384 |
predicate => {uri => $RDF_URI . 'type'}, |
385 |
object => {uri => $resolve->($type_attr->value, |
386 |
$type_attr)}, |
387 |
node => $type_attr); |
388 |
} |
389 |
|
390 |
for my $attr (@prop_attr) { |
391 |
$self->{ontriple}->(subject => $subject, |
392 |
predicate => {uri => $attr->manakai_expanded_uri}, |
393 |
object => {value => $attr->value, |
394 |
language => $opt{language}}, |
395 |
node => $attr); |
396 |
## TODO: SHOULD in NFC |
397 |
} |
398 |
|
399 |
# |propertyEltList| |
400 |
|
401 |
my $li_counter = 1; |
402 |
for my $cn (@{$node->child_nodes}) { |
403 |
my $cn_type = $cn->node_type; |
404 |
if ($cn_type == $cn->ELEMENT_NODE) { |
405 |
$self->convert_property_element ($cn, li_counter => \$li_counter, |
406 |
subject => $subject, |
407 |
language => $opt{language}); |
408 |
} elsif ($cn_type == $cn->TEXT_NODE or |
409 |
$cn_type == $cn->CDATA_SECTION_NODE) { |
410 |
if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) { |
411 |
$self->{onerror}->(type => 'character not allowed', |
412 |
level => $self->{grammer_level}, |
413 |
node => $cn); |
414 |
} |
415 |
} |
416 |
} |
417 |
|
418 |
return $subject; |
419 |
} # convert_node_element |
420 |
|
421 |
my $get_id_resource = sub { |
422 |
my $self = shift; |
423 |
my $node = shift; |
424 |
|
425 |
return undef unless $node; |
426 |
|
427 |
return {uri => $id_attr->($self, $node)}; |
428 |
}; # $get_id_resource |
429 |
|
430 |
sub convert_property_element ($$%) { |
431 |
my ($self, $node, %opt) = @_; |
432 |
|
433 |
$check_rdf_namespace->($self, $node); |
434 |
|
435 |
# |propertyElt| |
436 |
|
437 |
my $xuri = $node->manakai_expanded_uri; |
438 |
if ($xuri eq $RDF_URI . 'li') { |
439 |
$xuri = $RDF_URI . '_' . ${$opt{li_counter}}++; |
440 |
} |
441 |
|
442 |
if ({ |
443 |
%coreSyntaxTerms, |
444 |
$RDF_URI . 'Description' => 1, |
445 |
%oldTerms, |
446 |
}->{$xuri}) { |
447 |
$self->{onerror}->(type => 'element not allowed', |
448 |
level => $self->{grammer_level}, |
449 |
node => $node); |
450 |
## TODO: RDF Validator? |
451 |
} |
452 |
|
453 |
my $rdf_id_attr; |
454 |
my $dt_attr; |
455 |
my $parse_attr; |
456 |
my $nodeid_attr; |
457 |
my $resource_attr; |
458 |
my @prop_attr; |
459 |
for my $attr (@{$node->attributes}) { |
460 |
my $nsuri = $attr->namespace_uri; |
461 |
if (defined $nsuri and |
462 |
$nsuri eq q<http://www.w3.org/XML/1998/namespace> and |
463 |
$attr->manakai_local_name eq 'lang') { |
464 |
$opt{language} = $attr->value; |
465 |
} |
466 |
|
467 |
my $prefix = $attr->prefix; |
468 |
if (defined $prefix) { |
469 |
next if $prefix =~ /^[Xx][Mm][Ll]/; |
470 |
} else { |
471 |
next if $attr->manakai_local_name =~ /^[Xx][Mm][Ll]/; |
472 |
} |
473 |
|
474 |
$check_rdf_namespace->($self, $attr); |
475 |
|
476 |
my $attr_xuri = $attr->manakai_expanded_uri; |
477 |
|
478 |
unless (defined $nsuri) { |
479 |
$attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri); |
480 |
} |
481 |
|
482 |
if ($attr_xuri eq $RDF_URI . 'ID') { |
483 |
$rdf_id_attr = $attr; |
484 |
} elsif ($attr_xuri eq $RDF_URI . 'datatype') { |
485 |
$dt_attr = $attr; |
486 |
} elsif ($attr_xuri eq $RDF_URI . 'parseType') { |
487 |
$parse_attr = $attr; |
488 |
} elsif ($attr_xuri eq $RDF_URI . 'resource') { |
489 |
$resource_attr = $attr; |
490 |
} elsif ($attr_xuri eq $RDF_URI . 'nodeID') { |
491 |
$nodeid_attr = $attr; |
492 |
} elsif ({ |
493 |
%coreSyntaxTerms, |
494 |
$RDF_URI . 'li' => 1, |
495 |
$RDF_URI . 'Description' => 1, |
496 |
%oldTerms, |
497 |
}->{$attr_xuri}) { |
498 |
$self->{onerror}->(type => 'attribute not allowed', |
499 |
level => $self->{grammer_level}, |
500 |
node => $attr); |
501 |
## TODO: RDF Validator? |
502 |
} else { |
503 |
push @prop_attr, $attr; |
504 |
} |
505 |
} |
506 |
|
507 |
my $parse = $parse_attr ? $parse_attr->value : ''; |
508 |
if ($parse eq 'Resource') { |
509 |
# |parseTypeResourcePropertyElt| |
510 |
|
511 |
for my $attr ($resource_attr, $nodeid_attr, $dt_attr) { |
512 |
next unless $attr; |
513 |
$self->{onerror}->(type => 'attribute not allowed', |
514 |
level => $self->{grammer_level}, |
515 |
node => $attr); |
516 |
## TODO: RDF Validator? |
517 |
} |
518 |
|
519 |
my $object = {bnodeid => $generate_bnodeid->($self)}; |
520 |
$self->{ontriple}->(subject => $opt{subject}, |
521 |
predicate => {uri => $xuri}, |
522 |
object => $object, |
523 |
node => $node, |
524 |
id => $get_id_resource->($self, $rdf_id_attr)); |
525 |
|
526 |
## As if nodeElement |
527 |
|
528 |
# |propertyEltList| |
529 |
|
530 |
my $li_counter = 1; |
531 |
for my $cn (@{$node->child_nodes}) { |
532 |
my $cn_type = $cn->node_type; |
533 |
if ($cn_type == $cn->ELEMENT_NODE) { |
534 |
$self->convert_property_element ($cn, li_counter => \$li_counter, |
535 |
subject => $object, |
536 |
language => $opt{language}); |
537 |
} elsif ($cn_type == $cn->TEXT_NODE or |
538 |
$cn_type == $cn->CDATA_SECTION_NODE) { |
539 |
if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) { |
540 |
$self->{onerror}->(type => 'character not allowed', |
541 |
level => $self->{grammer_level}, |
542 |
node => $cn); |
543 |
} |
544 |
} |
545 |
} |
546 |
} elsif ($parse eq 'Collection') { |
547 |
# |parseTypeCollectionPropertyElt| |
548 |
|
549 |
for my $attr ($resource_attr, $nodeid_attr, $dt_attr) { |
550 |
next unless $attr; |
551 |
$self->{onerror}->(type => 'attribute not allowed', |
552 |
level => $self->{grammer_level}, |
553 |
node => $attr); |
554 |
## TODO: RDF Validator? |
555 |
} |
556 |
|
557 |
# |nodeElementList| |
558 |
my @resource; |
559 |
for my $cn (@{$node->child_nodes}) { |
560 |
if ($cn->node_type == $cn->ELEMENT_NODE) { |
561 |
push @resource, [$self->convert_node_element ($cn), |
562 |
{bnodeid => $generate_bnodeid->($self)}, |
563 |
$cn]; |
564 |
} elsif ($cn->node_type == $cn->TEXT_NODE or |
565 |
$cn->node_type == $cn->CDATA_SECTION_NODE) { |
566 |
if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) { |
567 |
$self->{onerror}->(type => 'character not allowed', |
568 |
level => $self->{grammer_level}, |
569 |
node => $cn); |
570 |
} |
571 |
} |
572 |
} |
573 |
|
574 |
if (@resource) { |
575 |
$self->{ontriple}->(subject => $opt{subject}, |
576 |
predicate => {uri => $xuri}, |
577 |
object => $resource[0]->[1], |
578 |
node => $node); |
579 |
} else { |
580 |
$self->{ontriple}->(subject => $opt{subject}, |
581 |
predicate => {uri => $xuri}, |
582 |
object => {uri => $RDF_URI . 'nil'}, |
583 |
node => $node, |
584 |
id => $get_id_resource->($self, $rdf_id_attr)); |
585 |
} |
586 |
|
587 |
while (@resource) { |
588 |
my $resource = shift @resource; |
589 |
$self->{ontriple}->(subject => $resource->[1], |
590 |
predicate => {uri => $RDF_URI . 'first'}, |
591 |
object => $resource->[0], |
592 |
node => $resource->[2]); |
593 |
if (@resource) { |
594 |
$self->{ontriple}->(subject => $resource->[1], |
595 |
predicate => {uri => $RDF_URI . 'rest'}, |
596 |
object => $resource[0]->[1], |
597 |
node => $resource->[2]); |
598 |
} else { |
599 |
$self->{ontriple}->(subject => $resource->[1], |
600 |
predicate => {uri => $RDF_URI . 'rest'}, |
601 |
object => {uri => $RDF_URI . 'nil'}, |
602 |
node => $resource->[2]); |
603 |
} |
604 |
} |
605 |
} elsif ($parse_attr) { |
606 |
# |parseTypeLiteralPropertyElt| |
607 |
|
608 |
if ($parse ne 'Literal') { |
609 |
# |parseTypeOtherPropertyElt| ## TODO: What RDF Validator does? |
610 |
|
611 |
$self->{onerror}->(type => 'parse type other', |
612 |
level => $self->{info_level}, |
613 |
node => $parse_attr); |
614 |
} |
615 |
|
616 |
for my $attr ($resource_attr, $nodeid_attr, $dt_attr) { |
617 |
next unless $attr; |
618 |
$self->{onerror}->(type => 'attribute not allowed', |
619 |
level => $self->{grammer_level}, |
620 |
node => $attr); |
621 |
## TODO: RDF Validator? |
622 |
} |
623 |
|
624 |
my $value = [@{$node->child_nodes}]; |
625 |
## TODO: Callback for validation |
626 |
## TODO: Serialized form SHOULD be in NFC. |
627 |
|
628 |
$self->{ontriple}->(subject => $opt{subject}, |
629 |
predicate => {uri => $xuri}, |
630 |
object => {nodes => $value, |
631 |
datatype => $RDF_URI . 'XMLLiteral'}, |
632 |
node => $node, |
633 |
id => $get_id_resource->($self, $rdf_id_attr)); |
634 |
} else { |
635 |
my $mode = 'unknown'; |
636 |
|
637 |
if ($dt_attr) { |
638 |
$mode = 'literal'; # |literalPropertyElt| |
639 |
## TODO: What RDF Validator does for |< rdf:datatype><el/></>|? |
640 |
} |
641 |
## TODO: What RDF Validator does for |< prop-attr><non-empty/></>|? |
642 |
|
643 |
my $node_element; |
644 |
my $text = ''; |
645 |
for my $cn (@{$node->child_nodes}) { |
646 |
my $cn_type = $cn->node_type; |
647 |
if ($cn_type == $cn->ELEMENT_NODE) { |
648 |
unless ($node_element) { |
649 |
$node_element = $cn; |
650 |
if ({ |
651 |
resource => 1, unknown => 1, 'literal-or-resource' => 1, |
652 |
}->{$mode}) { |
653 |
$mode = 'resource'; |
654 |
} else { |
655 |
$self->{onerror}->(type => 'element not allowed', |
656 |
level => $self->{grammer_level}, |
657 |
node => $cn); |
658 |
## TODO: RDF Validator? |
659 |
} |
660 |
} else { |
661 |
## TODO: What RDF Validator does? |
662 |
$self->{onerror}->(type => 'second node element', |
663 |
level => $self->{grammer_level}, |
664 |
node => $cn); |
665 |
} |
666 |
} elsif ($cn_type == $cn->TEXT_NODE or |
667 |
$cn_type == $cn->CDATA_SECTION_NODE) { |
668 |
my $data = $cn->data; |
669 |
$text .= $data; |
670 |
if ($data =~ /[^\x09\x0A\x0D\x20]/) { |
671 |
if ({ |
672 |
literal => 1, unknown => 1, 'literal-or-resource' => 1, |
673 |
}->{$mode}) { |
674 |
$mode = 'literal'; |
675 |
} else { |
676 |
$self->{onerror}->(type => 'character not allowed', |
677 |
level => $self->{grammer_level}, |
678 |
node => $cn); |
679 |
## TODO: RDF Validator? |
680 |
} |
681 |
} else { |
682 |
if ($mode eq 'unknown') { |
683 |
$mode = 'literal-or-resource'; |
684 |
} else { |
685 |
# |
686 |
} |
687 |
} |
688 |
} |
689 |
} |
690 |
|
691 |
if ($mode eq 'resource') { |
692 |
# |resourcePropertyElt| |
693 |
|
694 |
for my $attr (@prop_attr, $resource_attr, $nodeid_attr, $dt_attr) { |
695 |
next unless $attr; |
696 |
$self->{onerror}->(type => 'attribute not allowed', |
697 |
level => $self->{grammer_level}, |
698 |
node => $attr); |
699 |
## TODO: RDF Validator? |
700 |
} |
701 |
|
702 |
my $object = $self->convert_node_element ($node_element, |
703 |
language => $opt{language}); |
704 |
|
705 |
$self->{ontriple}->(subject => $opt{subject}, |
706 |
predicate => {uri => $xuri}, |
707 |
object => $object, |
708 |
node => $node, |
709 |
id => $get_id_resource->($self, $rdf_id_attr)); |
710 |
} elsif ($mode eq 'literal' or $mode eq 'literal-or-resource') { |
711 |
# |literalPropertyElt| |
712 |
|
713 |
for my $attr (@prop_attr, $resource_attr, $nodeid_attr) { |
714 |
next unless $attr; |
715 |
$self->{onerror}->(type => 'attribute not allowed', |
716 |
level => $self->{grammer_level}, |
717 |
node => $attr); |
718 |
## TODO: RDF Validator? |
719 |
} |
720 |
|
721 |
## TODO: $text SHOULD be in NFC |
722 |
|
723 |
if ($dt_attr) { |
724 |
$self->{ontriple} |
725 |
->(subject => $opt{subject}, |
726 |
predicate => {uri => $xuri}, |
727 |
object => {value => $text, |
728 |
datatype => $uri_attr->$self, ($dt_attr->value)}, |
729 |
## ISSUE: No resolve() in the spec (but spec says that |
730 |
## xml:base is applied also to rdf:datatype). |
731 |
node => $node, |
732 |
id => $get_id_resource->($self, $rdf_id_attr)); |
733 |
} else { |
734 |
$self->{ontriple}->(subject => $opt{subject}, |
735 |
predicate => {uri => $xuri}, |
736 |
object => {value => $text, |
737 |
language => $opt{language}}, |
738 |
node => $node, |
739 |
id => $get_id_resource->($self, $rdf_id_attr)); |
740 |
} |
741 |
} else { |
742 |
## |emptyPropertyElt| |
743 |
|
744 |
for my $attr ($dt_attr) { |
745 |
next unless $attr; |
746 |
$self->{onerror}->(type => 'attribute not allowed', |
747 |
level => $self->{grammer_level}, |
748 |
node => $attr); |
749 |
## TODO: RDF Validator? |
750 |
} |
751 |
|
752 |
if (not $resource_attr and not $nodeid_attr and not @prop_attr) { |
753 |
$self->{ontriple}->(subject => $opt{subject}, |
754 |
predicate => {uri => $xuri}, |
755 |
object => {value => '', |
756 |
language => $opt{language}}, |
757 |
node => $node, |
758 |
id => $get_id_resource->($self, $rdf_id_attr)); |
759 |
} else { |
760 |
my $object; |
761 |
if ($resource_attr) { |
762 |
$object = {uri => $uri_attr->($self, $resource_attr)}; |
763 |
if (defined $nodeid_attr) { |
764 |
$self->{onerror}->(type => 'attribute not allowed', |
765 |
level => $self->{grammer_level}, |
766 |
node => $nodeid_attr); |
767 |
## TODO: RDF Validator? |
768 |
} |
769 |
} elsif ($nodeid_attr) { |
770 |
my $id = $nodeid_attr->value; |
771 |
unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) { |
772 |
$self->{onerror}->(type => 'syntax error', ## TODO: type |
773 |
level => $self->{grammer_level}, |
774 |
node => $self); |
775 |
} |
776 |
$object = {bnodeid => $get_bnodeid->($id)}; |
777 |
} else { |
778 |
$object = {bnodeid => $generate_bnodeid->($self)}; |
779 |
} |
780 |
|
781 |
for my $attr (@prop_attr) { |
782 |
my $attr_xuri = $attr->manakai_expanded_uri; |
783 |
if ($attr_xuri eq $RDF_URI . 'type') { |
784 |
$self->{ontriple}->(subject => $object, |
785 |
predicate => {uri => $attr_xuri}, |
786 |
object => $resolve->($attr->value, $attr), |
787 |
node => $attr); |
788 |
} else { |
789 |
## TODO: SHOULD be in NFC |
790 |
$self->{ontriple}->(subject => $object, |
791 |
predicate => {uri => $attr_xuri}, |
792 |
object => {value => $attr->value, |
793 |
language => $opt{language}}, |
794 |
node => $attr); |
795 |
} |
796 |
} |
797 |
|
798 |
$self->{ontriple}->(subject => $opt{subject}, |
799 |
predicate => {uri => $xuri}, |
800 |
object => $object, |
801 |
node => $node, |
802 |
id => $get_id_resource->($self, $rdf_id_attr)); |
803 |
} |
804 |
} |
805 |
} |
806 |
} # convert_property_element |
807 |
|
808 |
1; |
809 |
|