/[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 - (hide 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 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: elements in null namespace (not mentioned in the spec.)
18    
19 wakaba 1.1 my $RDF_URI = q<http://www.w3.org/1999/02/22-rdf-syntax-ns#>;
20    
21 wakaba 1.8 use Char::Class::XML qw(InXML_NCNameStartChar10 InXMLNCNameChar10);
22 wakaba 1.5 require Whatpm::URIChecker;
23    
24 wakaba 1.1 sub new ($) {
25 wakaba 1.5 my $self = bless {fact_level => 'm', grammer_level => 'm',
26     info_level => 'i', next_id => 0}, shift;
27 wakaba 1.1 $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 wakaba 1.3 if (defined $resource->{uri}) {
36 wakaba 1.1 return '<' . $resource->{uri} . '>';
37 wakaba 1.3 } elsif (defined $resource->{bnodeid}) {
38 wakaba 1.1 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 wakaba 1.3 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 wakaba 1.1 };
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 wakaba 1.7 $self->convert_rdf_element ($cn, language => '');
87 wakaba 1.1 } else {
88 wakaba 1.7 $self->convert_rdf_node_element ($cn, language => '');
89 wakaba 1.1 }
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 wakaba 1.7 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 wakaba 1.1
123     $check_rdf_namespace->($self, $node);
124    
125     # |RDF|
126    
127     for my $attr (@{$node->attributes}) {
128 wakaba 1.7 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 wakaba 1.1 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 wakaba 1.7 $self->convert_node_element ($cn, language => $opt{language});
153 wakaba 1.1 } 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 wakaba 1.4 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 wakaba 1.5 ## TODO: Ummm... RDF/XML spec refers dated version of xml:base and RFC 2396...
187    
188 wakaba 1.4 ## 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 wakaba 1.5 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 wakaba 1.6 }; # $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 wakaba 1.7
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 wakaba 1.6
235     return $resolve->('#' . $id, $attr);
236 wakaba 1.7 }; # $id_attr
237 wakaba 1.5
238 wakaba 1.7 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 wakaba 1.5
265 wakaba 1.7 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 wakaba 1.1
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 wakaba 1.4 my $type_attr;
291 wakaba 1.1 my @prop_attr;
292    
293     for my $attr (@{$node->attributes}) {
294 wakaba 1.7 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 wakaba 1.1 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 wakaba 1.7
312     unless (defined $nsuri) {
313     $attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri);
314     }
315    
316 wakaba 1.2 if ($attr_xuri eq $RDF_URI . 'ID') {
317 wakaba 1.1 unless (defined $subject) {
318 wakaba 1.6 $subject = {uri => $id_attr->($self, $attr)};
319 wakaba 1.1 } else {
320 wakaba 1.5 $self->{onerror}->(type => 'attribute not allowed',
321     level => $self->{grammer_level},
322     node => $attr);
323    
324 wakaba 1.1 ## TODO: Ignore triple as W3C RDF Validator does
325     }
326     } elsif ($attr_xuri eq $RDF_URI . 'nodeID') {
327     unless (defined $subject) {
328 wakaba 1.5 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 wakaba 1.1 } else {
337 wakaba 1.5 $self->{onerror}->(type => 'attribute not allowed',
338     level => $self->{grammer_level},
339     node => $attr);
340    
341 wakaba 1.1 ## TODO: Ignore triple as W3C RDF Validator does
342     }
343     } elsif ($attr_xuri eq $RDF_URI . 'about') {
344     unless (defined $subject) {
345 wakaba 1.5 $subject = {uri => $uri_attr->($self, $attr)};
346 wakaba 1.1 } else {
347 wakaba 1.5 $self->{onerror}->(type => 'attribute not allowed',
348     level => $self->{grammer_level},
349     node => $attr);
350    
351 wakaba 1.1 ## TODO: Ignore triple as W3C RDF Validator does
352     }
353     } elsif ($attr_xuri eq $RDF_URI . 'type') {
354 wakaba 1.4 $type_attr = $attr;
355 wakaba 1.1 } 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 wakaba 1.4 $subject = {bnodeid => $generate_bnodeid->($self)};
373 wakaba 1.1 }
374    
375     if ($xuri ne $RDF_URI . 'Description') {
376     $self->{ontriple}->(subject => $subject,
377     predicate => {uri => $RDF_URI . 'type'},
378 wakaba 1.2 object => {uri => $xuri},
379     node => $node);
380 wakaba 1.1 }
381    
382 wakaba 1.4 if ($type_attr) {
383 wakaba 1.1 $self->{ontriple}->(subject => $subject,
384     predicate => {uri => $RDF_URI . 'type'},
385 wakaba 1.4 object => {uri => $resolve->($type_attr->value,
386     $type_attr)},
387     node => $type_attr);
388 wakaba 1.1 }
389    
390     for my $attr (@prop_attr) {
391     $self->{ontriple}->(subject => $subject,
392     predicate => {uri => $attr->manakai_expanded_uri},
393 wakaba 1.7 object => {value => $attr->value,
394     language => $opt{language}},
395 wakaba 1.2 node => $attr);
396 wakaba 1.1 ## 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 wakaba 1.7 subject => $subject,
407     language => $opt{language});
408 wakaba 1.1 } 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 wakaba 1.4 my $get_id_resource = sub {
422 wakaba 1.5 my $self = shift;
423     my $node = shift;
424 wakaba 1.6
425 wakaba 1.5 return undef unless $node;
426 wakaba 1.6
427     return {uri => $id_attr->($self, $node)};
428 wakaba 1.4 }; # $get_id_resource
429    
430 wakaba 1.1 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 wakaba 1.6 my $rdf_id_attr;
454 wakaba 1.1 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 wakaba 1.7 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 wakaba 1.1 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 wakaba 1.7
478     unless (defined $nsuri) {
479     $attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri);
480     }
481    
482 wakaba 1.1 if ($attr_xuri eq $RDF_URI . 'ID') {
483 wakaba 1.6 $rdf_id_attr = $attr;
484 wakaba 1.1 } 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 wakaba 1.2 next unless $attr;
513 wakaba 1.1 $self->{onerror}->(type => 'attribute not allowed',
514     level => $self->{grammer_level},
515     node => $attr);
516     ## TODO: RDF Validator?
517     }
518    
519 wakaba 1.4 my $object = {bnodeid => $generate_bnodeid->($self)};
520 wakaba 1.1 $self->{ontriple}->(subject => $opt{subject},
521     predicate => {uri => $xuri},
522 wakaba 1.2 object => $object,
523 wakaba 1.3 node => $node,
524 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
525 wakaba 1.1
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 wakaba 1.7 subject => $object,
536     language => $opt{language});
537 wakaba 1.1 } 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 wakaba 1.2 next unless $attr;
551 wakaba 1.1 $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 wakaba 1.4 {bnodeid => $generate_bnodeid->($self)},
563 wakaba 1.2 $cn];
564 wakaba 1.1 } 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 wakaba 1.2 object => $resource[0]->[1],
578     node => $node);
579 wakaba 1.1 } else {
580     $self->{ontriple}->(subject => $opt{subject},
581     predicate => {uri => $xuri},
582 wakaba 1.2 object => {uri => $RDF_URI . 'nil'},
583 wakaba 1.3 node => $node,
584 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
585 wakaba 1.1 }
586 wakaba 1.3
587 wakaba 1.1 while (@resource) {
588     my $resource = shift @resource;
589     $self->{ontriple}->(subject => $resource->[1],
590     predicate => {uri => $RDF_URI . 'first'},
591 wakaba 1.2 object => $resource->[0],
592     node => $resource->[2]);
593 wakaba 1.1 if (@resource) {
594     $self->{ontriple}->(subject => $resource->[1],
595     predicate => {uri => $RDF_URI . 'rest'},
596 wakaba 1.2 object => $resource[0]->[1],
597     node => $resource->[2]);
598 wakaba 1.1 } else {
599     $self->{ontriple}->(subject => $resource->[1],
600     predicate => {uri => $RDF_URI . 'rest'},
601 wakaba 1.2 object => {uri => $RDF_URI . 'nil'},
602     node => $resource->[2]);
603 wakaba 1.1 }
604     }
605     } elsif ($parse_attr) {
606     # |parseTypeLiteralPropertyElt|
607 wakaba 1.5
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 wakaba 1.1
616     for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {
617 wakaba 1.2 next unless $attr;
618 wakaba 1.1 $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 wakaba 1.2 datatype => $RDF_URI . 'XMLLiteral'},
632 wakaba 1.3 node => $node,
633 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
634 wakaba 1.1 } 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 wakaba 1.2 next unless $attr;
696 wakaba 1.1 $self->{onerror}->(type => 'attribute not allowed',
697     level => $self->{grammer_level},
698     node => $attr);
699     ## TODO: RDF Validator?
700     }
701    
702 wakaba 1.7 my $object = $self->convert_node_element ($node_element,
703     language => $opt{language});
704 wakaba 1.1
705     $self->{ontriple}->(subject => $opt{subject},
706     predicate => {uri => $xuri},
707 wakaba 1.2 object => $object,
708 wakaba 1.3 node => $node,
709 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
710 wakaba 1.1 } elsif ($mode eq 'literal' or $mode eq 'literal-or-resource') {
711     # |literalPropertyElt|
712    
713     for my $attr (@prop_attr, $resource_attr, $nodeid_attr) {
714 wakaba 1.2 next unless $attr;
715 wakaba 1.1 $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 wakaba 1.5 $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 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
733 wakaba 1.1 } else {
734     $self->{ontriple}->(subject => $opt{subject},
735     predicate => {uri => $xuri},
736     object => {value => $text,
737 wakaba 1.7 language => $opt{language}},
738 wakaba 1.3 node => $node,
739 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
740 wakaba 1.1 }
741     } else {
742     ## |emptyPropertyElt|
743    
744     for my $attr ($dt_attr) {
745 wakaba 1.2 next unless $attr;
746 wakaba 1.1 $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 wakaba 1.7 language => $opt{language}},
757 wakaba 1.3 node => $node,
758 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
759 wakaba 1.1 } else {
760     my $object;
761     if ($resource_attr) {
762 wakaba 1.5 $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 wakaba 1.1 } elsif ($nodeid_attr) {
770 wakaba 1.5 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 wakaba 1.1 } else {
778 wakaba 1.4 $object = {bnodeid => $generate_bnodeid->($self)};
779 wakaba 1.1 }
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 wakaba 1.4 object => $resolve->($attr->value, $attr),
787 wakaba 1.2 node => $attr);
788 wakaba 1.1 } else {
789     ## TODO: SHOULD be in NFC
790     $self->{ontriple}->(subject => $object,
791     predicate => {uri => $attr_xuri},
792     object => {value => $attr->value,
793 wakaba 1.7 language => $opt{language}},
794 wakaba 1.2 node => $attr);
795 wakaba 1.1 }
796     }
797    
798     $self->{ontriple}->(subject => $opt{subject},
799     predicate => {uri => $xuri},
800 wakaba 1.2 object => $object,
801 wakaba 1.3 node => $node,
802 wakaba 1.6 id => $get_id_resource->($self, $rdf_id_attr));
803 wakaba 1.1 }
804     }
805     }
806     } # convert_property_element
807    
808     1;
809    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24