/[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.5 - (hide annotations) (download)
Fri Mar 21 10:58:30 2008 UTC (16 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +107 -22 lines
++ whatpm/Whatpm/ChangeLog	21 Mar 2008 10:58:23 -0000
	* RDFXML.pm: TODO items noted.  Validation of ID
	and URI attributes is implemented.  Warn if unknown
	value is used in rdf:parseType="" attribute.

	* URIChecker.pm (check_rdf_uri_reference): New function.

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

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    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24