/[suikacvs]/markup/html/whatpm/Whatpm/RDFXML.pm
Suika

Contents of /markup/html/whatpm/Whatpm/RDFXML.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations) (download)
Sat Mar 22 05:45:36 2008 UTC (16 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.7: +1 -1 lines
++ whatpm/t/ChangeLog	22 Mar 2008 05:45:31 -0000
	* content-model-2.dat: Test data on |@profile| and |@version| are
	added.

2008-03-22  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ChangeLog	22 Mar 2008 05:43:37 -0000
	* RDFXML.pm: Typo fixed.

2008-03-22  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/ContentChecker/ChangeLog	22 Mar 2008 05:45:17 -0000
	* HTML.pm: Typo fixed.  html/@version implemented (as do-nothing
	checker). head/@profile implemented.  meta/@scheme implemented (as
	do-nothing checker).

2008-03-22  Wakaba  <wakaba@suika.fam.cx>

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24