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