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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wakaba, Fri Mar 21 08:58:35 2008 UTC revision 1.9 by wakaba, Fri Aug 15 14:13:42 2008 UTC
# Line 12  use strict; Line 12  use strict;
12    
13  ## ISSUE: PIs in RDF subtree should be validated?  ## 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#>;  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 ($) {  sub new ($) {
25    my $self = bless {fact_level => 'm', grammer_level => 'm'}, shift;    my $self = bless {
26        level => {
27          rdf_fact => 'm',
28          rdf_grammer => 'm',
29          rdf_lc_must => 'm',
30          info => 'i',
31        },
32        next_id => 0,
33      }, shift;
34    $self->{onerror} = sub {    $self->{onerror} = sub {
35      my %opt = @_;      my %opt = @_;
36      warn $opt{type}, "\n";      warn $opt{type}, "\n";
# Line 24  sub new ($) { Line 39  sub new ($) {
39      my %opt = @_;      my %opt = @_;
40      my $dump_resource = sub {      my $dump_resource = sub {
41        my $resource = shift;        my $resource = shift;
42        if ($resource->{uri}) {        if (defined $resource->{uri}) {
43          return '<' . $resource->{uri} . '>';          return '<' . $resource->{uri} . '>';
44        } elsif ($resource->{bnodeid}) {        } elsif (defined $resource->{bnodeid}) {
45          return '_:' . $resource->{bnodeid};          return '_:' . $resource->{bnodeid};
46        } elsif ($resource->{nodes}) {        } elsif ($resource->{nodes}) {
47          return '"' . join ('', map {$_->inner_html} @{$resource->{nodes}}) .          return '"' . join ('', map {$_->inner_html} @{$resource->{nodes}}) .
# Line 43  sub new ($) { Line 58  sub new ($) {
58      print STDERR $dump_resource->($opt{subject}) . ' ';      print STDERR $dump_resource->($opt{subject}) . ' ';
59      print STDERR $dump_resource->($opt{predicate}) . ' ';      print STDERR $dump_resource->($opt{predicate}) . ' ';
60      print STDERR $dump_resource->($opt{object}) . "\n";      print STDERR $dump_resource->($opt{object}) . "\n";
61        if ($dump_resource->{id}) {
62          print STDERR $dump_resource->($dump_resource->{id}) . ' ';
63          print STDERR $dump_resource->({uri => $RDF_URI . 'subject'}) . ' ';
64          print STDERR $dump_resource->($opt{subject}) . "\n";
65          print STDERR $dump_resource->($dump_resource->{id}) . ' ';
66          print STDERR $dump_resource->({uri => $RDF_URI . 'predicate'}) . ' ';
67          print STDERR $dump_resource->($opt{predicate}) . "\n";
68          print STDERR $dump_resource->($dump_resource->{id}) . ' ';
69          print STDERR $dump_resource->({uri => $RDF_URI . 'object'}) . ' ';
70          print STDERR $dump_resource->($opt{object}) . "\n";
71          print STDERR $dump_resource->($dump_resource->{id}) . ' ';
72          print STDERR $dump_resource->({uri => $RDF_URI . 'type'}) . ' ';
73          print STDERR $dump_resource->({uri => $RDF_URI . 'Statement'}) . "\n";
74        }
75    };    };
76    return $self;    return $self;
77  } # new  } # new
# Line 61  sub convert_document ($$) { Line 90  sub convert_document ($$) {
90      if ($cn->node_type == $cn->ELEMENT_NODE) {      if ($cn->node_type == $cn->ELEMENT_NODE) {
91        unless ($has_element) {        unless ($has_element) {
92          if ($cn->manakai_expanded_uri eq $RDF_URI . q<RDF>) {          if ($cn->manakai_expanded_uri eq $RDF_URI . q<RDF>) {
93            $self->convert_rdf_element ($cn);            $self->convert_rdf_element ($cn, language => '');
94          } else {          } else {
95            $self->convert_rdf_node_element ($cn);            $self->convert_rdf_node_element ($cn, language => '');
96          }          }
97          $has_element = 1;          $has_element = 1;
98        } else {        } else {
99          $self->{onerror}->(type => 'second node element',          $self->{onerror}->(type => 'second node element',
100                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
101                             node => $cn);                             node => $cn);
102        }        }
103      } elsif ($cn->node_type == $cn->TEXT_NODE or      } elsif ($cn->node_type == $cn->TEXT_NODE or
104               $cn->node_type == $cn->CDATA_SECTION_NODE) {               $cn->node_type == $cn->CDATA_SECTION_NODE) {
105        $self->{onerror}->(type => 'character not allowed',        $self->{onerror}->(type => 'character not allowed',
106                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
107                           node => $cn);                           node => $cn);
108      }      }
109    }    }
# Line 88  my $check_rdf_namespace = sub { Line 117  my $check_rdf_namespace = sub {
117    if (substr ($node_nsuri, 0, length $RDF_URI) eq $RDF_URI and    if (substr ($node_nsuri, 0, length $RDF_URI) eq $RDF_URI and
118        length $RDF_URI < length $node_nsuri) {        length $RDF_URI < length $node_nsuri) {
119      $self->{onerror}->(type => 'bad rdf namespace',      $self->{onerror}->(type => 'bad rdf namespace',
120                         level => $self->{fact_level}, # Section 5.1                         level => $self->{level}->{rdf_fact}, # Section 5.1
121                         node => $node);                         node => $node);
122    }    }
123  }; # $check_rdf_namespace  }; # $check_rdf_namespace
124    
125  sub convert_rdf_element ($$) {  sub convert_rdf_element ($$%) {
126    my ($self, $node) = @_;    my ($self, $node, %opt) = @_;
127      $opt{language} = '' unless defined $opt{language};
128          ## ISSUE: Not explicitly defined in the spec.
129    
130    $check_rdf_namespace->($self, $node);    $check_rdf_namespace->($self, $node);
131    
132    # |RDF|    # |RDF|
133    
134    for my $attr (@{$node->attributes}) {    for my $attr (@{$node->attributes}) {
135        my $nsuri = $attr->namespace_uri;
136        if (defined $nsuri and
137            $nsuri eq q<http://www.w3.org/XML/1998/namespace> and
138            $attr->manakai_local_name eq 'lang') {
139          $opt{language} = $attr->value;
140          next;
141        }
142    
143      my $prefix = $attr->prefix;      my $prefix = $attr->prefix;
144      if (defined $prefix) {      if (defined $prefix) {
145        next if $prefix =~ /^[Xx][Mm][Ll]/;        next if $prefix =~ /^[Xx][Mm][Ll]/;
# Line 110  sub convert_rdf_element ($$) { Line 149  sub convert_rdf_element ($$) {
149    
150      $check_rdf_namespace->($self, $attr);      $check_rdf_namespace->($self, $attr);
151      $self->{onerror}->(type => 'attribute not allowed',      $self->{onerror}->(type => 'attribute not allowed',
152                         level => $self->{grammer_level},                         level => $self->{level}->{rdf_grammer},
153                         node => $attr);                         node => $attr);
154    }    }
155    
156    # |nodeElementList|    # |nodeElementList|
157    for my $cn (@{$node->child_nodes}) {    for my $cn (@{$node->child_nodes}) {
158      if ($cn->node_type == $cn->ELEMENT_NODE) {      if ($cn->node_type == $cn->ELEMENT_NODE) {
159        $self->convert_node_element ($cn);        $self->convert_node_element ($cn, language => $opt{language});
160      } elsif ($cn->node_type == $cn->TEXT_NODE or      } elsif ($cn->node_type == $cn->TEXT_NODE or
161               $cn->node_type == $cn->CDATA_SECTION_NODE) {               $cn->node_type == $cn->CDATA_SECTION_NODE) {
162        if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {        if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {
163          $self->{onerror}->(type => 'character not allowed',          $self->{onerror}->(type => 'character not allowed',
164                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
165                             node => $cn);                             node => $cn);
166        }        }
167      }      }
# Line 145  my %oldTerms = ( Line 184  my %oldTerms = (
184    $RDF_URI . 'bagID' => 1,    $RDF_URI . 'bagID' => 1,
185  );  );
186    
187  sub convert_node_element ($$) {  require Message::DOM::DOMImplementation;
188    my ($self, $node) = @_;  my $resolve = sub {
189      return Message::DOM::DOMImplementation->create_uri_reference ($_[0])
190          ->get_absolute_reference ($_[1]->base_uri)
191          ->uri_reference;
192    
193      ## TODO: Ummm... RDF/XML spec refers dated version of xml:base and RFC 2396...
194    
195      ## TODO: Check latest xml:base and IRI spec...
196      ## (non IRI/URI chars should be percent-encoded before resolve?)
197    }; # $resolve
198    
199    my $generate_bnodeid = sub {
200      return 'g'.$_[0]->{next_id}++;
201    }; # $generate_bnodeid
202    
203    my $get_bnodeid = sub {
204      return 'b'.$_[0];
205    }; # $get_bnodeid
206    
207    my $uri_attr = sub {
208      my ($self, $attr) = @_;
209    
210      my $abs_uri = $resolve->($attr->value, $attr);
211    
212      Whatpm::URIChecker->check_iri_reference ($abs_uri, sub {
213        $self->{onerror}->(@_, node => $attr);
214      });
215    
216      return $abs_uri;
217    }; # $uri_attr
218    
219    my $id_attr = sub {
220      my ($self, $attr) = @_;
221      
222      my $id = $attr->value;
223      unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) {
224        $self->{onerror}->(type => 'XML 1.0 NCName:syntax error',
225                           level => $self->{level}->{rdf_grammer},
226                           node => $attr);
227      }
228    
229      my $base_uri = $attr->base_uri;
230      if ($self->{id}->{$base_uri}->{$id}) {
231        $self->{onerror}->(type => 'duplicate rdf id',
232                           level => $self->{level}->{rdf_lc_must},
233                           node => $attr);
234        ## TODO: RDF Validator?
235      } else {
236        $self->{id}->{$base_uri}->{$id} = 1;
237      }
238      
239      return $resolve->('#' . $id, $attr);
240    }; # $id_attr
241    
242    my $check_local_attr = sub {
243      my ($self, $node, $attr, $attr_xuri) = @_;
244      
245      if ({
246           ID => 1, about => 1, resource => 1, parseType => 1, type => 1,
247          }->{$attr_xuri}) {
248        $self->{onerror}->(type => 'unqualified rdf attr',
249                           level => $self->{level}->{should},
250                           node => $attr);
251        if ($node->has_attribute_ns ($RDF_URI, $attr_xuri)) {
252          $self->{onerror}->(type => 'duplicate unqualified attr',
253                             level => $self->{level}->{rdf_fact},
254                             node => $attr);
255          ## NOTE: <? rdfa:bout="" about=""> and such are not catched
256          ## by this check; but who cares?  rdfa:bout="" is itself illegal.
257        }
258        $attr_xuri = $RDF_URI . $attr_xuri;
259      } else {
260        $self->{onerror}->(type => 'unqualified attr',
261                           level => $self->{level}->{rdf_fact},
262                           node => $attr);
263        ## TODO: RDF Validator?
264      }
265      
266      return $attr_xuri;
267    }; # $check_local_attr
268    
269    sub convert_node_element ($$;%) {
270      my ($self, $node, %opt) = @_;
271      $opt{language} = '' unless defined $opt{language};
272          ## ISSUE: Not explicitly defined in the spec.
273    
274    $check_rdf_namespace->($self, $node);    $check_rdf_namespace->($self, $node);
275    
# Line 160  sub convert_node_element ($$) { Line 283  sub convert_node_element ($$) {
283      %oldTerms,      %oldTerms,
284    }->{$xuri}) {    }->{$xuri}) {
285      $self->{onerror}->(type => 'element not allowed',      $self->{onerror}->(type => 'element not allowed',
286                         level => $self->{grammer_level},                         level => $self->{level}->{rdf_grammer},
287                         node => $node);                         node => $node);
288    
289      ## TODO: W3C RDF Validator: Continue validation, but triples that would      ## TODO: W3C RDF Validator: Continue validation, but triples that would
# Line 168  sub convert_node_element ($$) { Line 291  sub convert_node_element ($$) {
291    }    }
292    
293    my $subject;    my $subject;
294    my $rdf_type_attr;    my $type_attr;
295    my @prop_attr;    my @prop_attr;
296    
297    for my $attr (@{$node->attributes}) {    for my $attr (@{$node->attributes}) {
298        my $nsuri = $attr->namespace_uri;
299        if (defined $nsuri and
300            $nsuri eq q<http://www.w3.org/XML/1998/namespace> and
301            $attr->manakai_local_name eq 'lang') {
302          $opt{language} = $attr->value;
303        }
304    
305      my $prefix = $attr->prefix;      my $prefix = $attr->prefix;
306      if (defined $prefix) {      if (defined $prefix) {
307        next if $prefix =~ /^[Xx][Mm][Ll]/;        next if $prefix =~ /^[Xx][Mm][Ll]/;
# Line 182  sub convert_node_element ($$) { Line 312  sub convert_node_element ($$) {
312      $check_rdf_namespace->($self, $attr);      $check_rdf_namespace->($self, $attr);
313    
314      my $attr_xuri = $attr->manakai_expanded_uri;      my $attr_xuri = $attr->manakai_expanded_uri;
315    
316        unless (defined $nsuri) {
317          $attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri);
318        }
319    
320      if ($attr_xuri eq $RDF_URI . 'ID') {      if ($attr_xuri eq $RDF_URI . 'ID') {
321        unless (defined $subject) {        unless (defined $subject) {
322          $subject = {uri => '#' . $attr->value}; ## TODO: resolve()          $subject = {uri => $id_attr->($self, $attr)};
323        } else {        } else {
324            $self->{onerror}->(type => 'attribute not allowed',
325                               level => $self->{level}->{rdf_grammer},
326                               node => $attr);
327    
328          ## TODO: Ignore triple as W3C RDF Validator does          ## TODO: Ignore triple as W3C RDF Validator does
329        }        }
330      } elsif ($attr_xuri eq $RDF_URI . 'nodeID') {      } elsif ($attr_xuri eq $RDF_URI . 'nodeID') {
331        unless (defined $subject) {        unless (defined $subject) {
332          $subject = {bnodeid => '## TODO: bnode: ' . $attr->value};          my $id = $attr->value;
333            unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) {
334              $self->{onerror}->(type => 'XML 1.0 NCName:syntax error',
335                                 level => $self->{level}->{rdf_grammer},
336                                 node => $self);
337            }
338    
339            $subject = {bnodeid => $get_bnodeid->($id)};
340        } else {        } else {
341            $self->{onerror}->(type => 'attribute not allowed',
342                               level => $self->{level}->{rdf_grammer},
343                               node => $attr);
344    
345          ## TODO: Ignore triple as W3C RDF Validator does          ## TODO: Ignore triple as W3C RDF Validator does
346        }        }
347      } elsif ($attr_xuri eq $RDF_URI . 'about') {      } elsif ($attr_xuri eq $RDF_URI . 'about') {
348        unless (defined $subject) {        unless (defined $subject) {
349          $subject = {uri => $attr->value}; ## TODO: resolve          $subject = {uri => $uri_attr->($self, $attr)};
350        } else {        } else {
351            $self->{onerror}->(type => 'attribute not allowed',
352                               level => $self->{level}->{rdf_grammer},
353                               node => $attr);
354    
355          ## TODO: Ignore triple as W3C RDF Validator does          ## TODO: Ignore triple as W3C RDF Validator does
356        }        }
357      } elsif ($attr_xuri eq $RDF_URI . 'type') {      } elsif ($attr_xuri eq $RDF_URI . 'type') {
358        $rdf_type_attr = $attr;        $type_attr = $attr;
359      } elsif ({      } elsif ({
360        %coreSyntaxTerms,        %coreSyntaxTerms,
361        $RDF_URI . 'li' => 1,        $RDF_URI . 'li' => 1,
# Line 209  sub convert_node_element ($$) { Line 363  sub convert_node_element ($$) {
363        %oldTerms,        %oldTerms,
364      }->{$attr_xuri}) {      }->{$attr_xuri}) {
365        $self->{onerror}->(type => 'attribute not allowed',        $self->{onerror}->(type => 'attribute not allowed',
366                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
367                           node => $attr);                           node => $attr);
368    
369        ## TODO: W3C RDF Validator: Ignore triples        ## TODO: W3C RDF Validator: Ignore triples
# Line 219  sub convert_node_element ($$) { Line 373  sub convert_node_element ($$) {
373    }    }
374        
375    unless (defined $subject) {    unless (defined $subject) {
376      $subject = {bnodeid => '## TODO: new bnodeid'};      $subject = {bnodeid => $generate_bnodeid->($self)};
377    }    }
378    
379    if ($xuri ne $RDF_URI . 'Description') {    if ($xuri ne $RDF_URI . 'Description') {
# Line 229  sub convert_node_element ($$) { Line 383  sub convert_node_element ($$) {
383                          node => $node);                          node => $node);
384    }    }
385    
386    if ($rdf_type_attr) {    if ($type_attr) {
387      $self->{ontriple}->(subject => $subject,      $self->{ontriple}->(subject => $subject,
388                          predicate => {uri => $RDF_URI . 'type'},                          predicate => {uri => $RDF_URI . 'type'},
389                          object => {uri => $rdf_type_attr->value}, ## TODO: resolve                          object => {uri => $resolve->($type_attr->value,
390                          node => $rdf_type_attr);                                                       $type_attr)},
391                            node => $type_attr);
392    }    }
393    
394    for my $attr (@prop_attr) {    for my $attr (@prop_attr) {
395      $self->{ontriple}->(subject => $subject,      $self->{ontriple}->(subject => $subject,
396                          predicate => {uri => $attr->manakai_expanded_uri},                          predicate => {uri => $attr->manakai_expanded_uri},
397                          object => {value => $attr->value}, ## TODO: language                          object => {value => $attr->value,
398                                       language => $opt{language}},
399                          node => $attr);                          node => $attr);
400      ## TODO: SHOULD in NFC      ## TODO: SHOULD in NFC
401    }    }
# Line 251  sub convert_node_element ($$) { Line 407  sub convert_node_element ($$) {
407      my $cn_type = $cn->node_type;      my $cn_type = $cn->node_type;
408      if ($cn_type == $cn->ELEMENT_NODE) {      if ($cn_type == $cn->ELEMENT_NODE) {
409        $self->convert_property_element ($cn, li_counter => \$li_counter,        $self->convert_property_element ($cn, li_counter => \$li_counter,
410                                         subject => $subject);                                         subject => $subject,
411                                           language => $opt{language});
412      } elsif ($cn_type == $cn->TEXT_NODE or      } elsif ($cn_type == $cn->TEXT_NODE or
413               $cn_type == $cn->CDATA_SECTION_NODE) {               $cn_type == $cn->CDATA_SECTION_NODE) {
414        if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {        if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {
415          $self->{onerror}->(type => 'character not allowed',          $self->{onerror}->(type => 'character not allowed',
416                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
417                             node => $cn);                             node => $cn);
418        }        }
419      }      }
# Line 265  sub convert_node_element ($$) { Line 422  sub convert_node_element ($$) {
422    return $subject;    return $subject;
423  } # convert_node_element  } # convert_node_element
424    
425    my $get_id_resource = sub {
426      my $self = shift;
427      my $node = shift;
428    
429      return undef unless $node;
430    
431      return {uri => $id_attr->($self, $node)};
432    }; # $get_id_resource
433    
434  sub convert_property_element ($$%) {  sub convert_property_element ($$%) {
435    my ($self, $node, %opt) = @_;    my ($self, $node, %opt) = @_;
436        
# Line 283  sub convert_property_element ($$%) { Line 449  sub convert_property_element ($$%) {
449         %oldTerms,         %oldTerms,
450        }->{$xuri}) {        }->{$xuri}) {
451      $self->{onerror}->(type => 'element not allowed',      $self->{onerror}->(type => 'element not allowed',
452                         level => $self->{grammer_level},                         level => $self->{level}->{rdf_grammer},
453                         node => $node);                         node => $node);
454      ## TODO: RDF Validator?      ## TODO: RDF Validator?
455    }    }
456    
457    my $id_attr;    my $rdf_id_attr;
458    my $dt_attr;    my $dt_attr;
459    my $parse_attr;    my $parse_attr;
460    my $nodeid_attr;    my $nodeid_attr;
461    my $resource_attr;    my $resource_attr;
462    my @prop_attr;    my @prop_attr;
463    for my $attr (@{$node->attributes}) {    for my $attr (@{$node->attributes}) {
464        my $nsuri = $attr->namespace_uri;
465        if (defined $nsuri and
466            $nsuri eq q<http://www.w3.org/XML/1998/namespace> and
467            $attr->manakai_local_name eq 'lang') {
468          $opt{language} = $attr->value;
469        }
470    
471      my $prefix = $attr->prefix;      my $prefix = $attr->prefix;
472      if (defined $prefix) {      if (defined $prefix) {
473        next if $prefix =~ /^[Xx][Mm][Ll]/;        next if $prefix =~ /^[Xx][Mm][Ll]/;
# Line 305  sub convert_property_element ($$%) { Line 478  sub convert_property_element ($$%) {
478      $check_rdf_namespace->($self, $attr);      $check_rdf_namespace->($self, $attr);
479    
480      my $attr_xuri = $attr->manakai_expanded_uri;      my $attr_xuri = $attr->manakai_expanded_uri;
481    
482        unless (defined $nsuri) {
483          $attr_xuri = $check_local_attr->($self, $node, $attr, $attr_xuri);
484        }
485    
486      if ($attr_xuri eq $RDF_URI . 'ID') {      if ($attr_xuri eq $RDF_URI . 'ID') {
487        $id_attr = $attr;        $rdf_id_attr = $attr;
488      } elsif ($attr_xuri eq $RDF_URI . 'datatype') {      } elsif ($attr_xuri eq $RDF_URI . 'datatype') {
489        $dt_attr = $attr;        $dt_attr = $attr;
490      } elsif ($attr_xuri eq $RDF_URI . 'parseType') {      } elsif ($attr_xuri eq $RDF_URI . 'parseType') {
# Line 322  sub convert_property_element ($$%) { Line 500  sub convert_property_element ($$%) {
500        %oldTerms,        %oldTerms,
501      }->{$attr_xuri}) {      }->{$attr_xuri}) {
502        $self->{onerror}->(type => 'attribute not allowed',        $self->{onerror}->(type => 'attribute not allowed',
503                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
504                           node => $attr);                           node => $attr);
505        ## TODO: RDF Validator?        ## TODO: RDF Validator?
506      } else {      } else {
# Line 337  sub convert_property_element ($$%) { Line 515  sub convert_property_element ($$%) {
515      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {
516        next unless $attr;        next unless $attr;
517        $self->{onerror}->(type => 'attribute not allowed',        $self->{onerror}->(type => 'attribute not allowed',
518                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
519                           node => $attr);                           node => $attr);
520        ## TODO: RDF Validator?        ## TODO: RDF Validator?
521      }      }
522            
523      my $object = {bnodeid => '## TODO: generate bnodeid'};      my $object = {bnodeid => $generate_bnodeid->($self)};
524      $self->{ontriple}->(subject => $opt{subject},      $self->{ontriple}->(subject => $opt{subject},
525                          predicate => {uri => $xuri},                          predicate => {uri => $xuri},
526                          object => $object,                          object => $object,
527                          node => $node);                          node => $node,
528      ## TODO: reification                          id => $get_id_resource->($self, $rdf_id_attr));
529            
530      ## As if nodeElement      ## As if nodeElement
531    
# Line 358  sub convert_property_element ($$%) { Line 536  sub convert_property_element ($$%) {
536        my $cn_type = $cn->node_type;        my $cn_type = $cn->node_type;
537        if ($cn_type == $cn->ELEMENT_NODE) {        if ($cn_type == $cn->ELEMENT_NODE) {
538          $self->convert_property_element ($cn, li_counter => \$li_counter,          $self->convert_property_element ($cn, li_counter => \$li_counter,
539                                           subject => $object);                                           subject => $object,
540                                             language => $opt{language});
541        } elsif ($cn_type == $cn->TEXT_NODE or        } elsif ($cn_type == $cn->TEXT_NODE or
542                 $cn_type == $cn->CDATA_SECTION_NODE) {                 $cn_type == $cn->CDATA_SECTION_NODE) {
543          if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {          if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {
544            $self->{onerror}->(type => 'character not allowed',            $self->{onerror}->(type => 'character not allowed',
545                               level => $self->{grammer_level},                               level => $self->{level}->{rdf_grammer},
546                               node => $cn);                               node => $cn);
547          }          }
548        }        }
# Line 374  sub convert_property_element ($$%) { Line 553  sub convert_property_element ($$%) {
553      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {
554        next unless $attr;        next unless $attr;
555        $self->{onerror}->(type => 'attribute not allowed',        $self->{onerror}->(type => 'attribute not allowed',
556                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
557                           node => $attr);                           node => $attr);
558        ## TODO: RDF Validator?        ## TODO: RDF Validator?
559      }      }
# Line 384  sub convert_property_element ($$%) { Line 563  sub convert_property_element ($$%) {
563      for my $cn (@{$node->child_nodes}) {      for my $cn (@{$node->child_nodes}) {
564        if ($cn->node_type == $cn->ELEMENT_NODE) {        if ($cn->node_type == $cn->ELEMENT_NODE) {
565          push @resource, [$self->convert_node_element ($cn),          push @resource, [$self->convert_node_element ($cn),
566                           {bnodeid => '## TODO: bnodeid generated'},                           {bnodeid => $generate_bnodeid->($self)},
567                           $cn];                           $cn];
568        } elsif ($cn->node_type == $cn->TEXT_NODE or        } elsif ($cn->node_type == $cn->TEXT_NODE or
569                 $cn->node_type == $cn->CDATA_SECTION_NODE) {                 $cn->node_type == $cn->CDATA_SECTION_NODE) {
570          if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {          if ($cn->data =~ /[^\x09\x0A\x0D\x20]/) {
571            $self->{onerror}->(type => 'character not allowed',            $self->{onerror}->(type => 'character not allowed',
572                               level => $self->{grammer_level},                               level => $self->{level}->{rdf_grammer},
573                               node => $cn);                               node => $cn);
574          }          }
575        }        }
# Line 405  sub convert_property_element ($$%) { Line 584  sub convert_property_element ($$%) {
584        $self->{ontriple}->(subject => $opt{subject},        $self->{ontriple}->(subject => $opt{subject},
585                            predicate => {uri => $xuri},                            predicate => {uri => $xuri},
586                            object => {uri => $RDF_URI . 'nil'},                            object => {uri => $RDF_URI . 'nil'},
587                            node => $node);                            node => $node,
588                              id => $get_id_resource->($self, $rdf_id_attr));
589      }      }
590      ## TODO: reification      
   
591      while (@resource) {      while (@resource) {
592        my $resource = shift @resource;        my $resource = shift @resource;
593        $self->{ontriple}->(subject => $resource->[1],        $self->{ontriple}->(subject => $resource->[1],
# Line 429  sub convert_property_element ($$%) { Line 608  sub convert_property_element ($$%) {
608      }      }
609    } elsif ($parse_attr) {    } elsif ($parse_attr) {
610      # |parseTypeLiteralPropertyElt|      # |parseTypeLiteralPropertyElt|
611      # |parseTypeOtherPropertyElt| ## TODO: What RDF Validator does?  
612        if ($parse ne 'Literal') {
613          # |parseTypeOtherPropertyElt| ## TODO: What RDF Validator does?
614    
615          $self->{onerror}->(type => 'parse type other',
616                             level => $self->{level}->{rdf_info},
617                             node => $parse_attr);
618        }
619    
620      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {      for my $attr ($resource_attr, $nodeid_attr, $dt_attr) {
621        next unless $attr;        next unless $attr;
622        $self->{onerror}->(type => 'attribute not allowed',        $self->{onerror}->(type => 'attribute not allowed',
623                           level => $self->{grammer_level},                           level => $self->{level}->{rdf_grammer},
624                           node => $attr);                           node => $attr);
625        ## TODO: RDF Validator?        ## TODO: RDF Validator?
626      }      }
# Line 447  sub convert_property_element ($$%) { Line 633  sub convert_property_element ($$%) {
633                          predicate => {uri => $xuri},                          predicate => {uri => $xuri},
634                          object => {nodes => $value,                          object => {nodes => $value,
635                                     datatype => $RDF_URI . 'XMLLiteral'},                                     datatype => $RDF_URI . 'XMLLiteral'},
636                          node => $node);                          node => $node,
637      ## TODO: reification                          id => $get_id_resource->($self, $rdf_id_attr));
638    } else {    } else {
639      my $mode = 'unknown';      my $mode = 'unknown';
640    
# Line 471  sub convert_property_element ($$%) { Line 657  sub convert_property_element ($$%) {
657              $mode = 'resource';              $mode = 'resource';
658            } else {            } else {
659              $self->{onerror}->(type => 'element not allowed',              $self->{onerror}->(type => 'element not allowed',
660                                 level => $self->{grammer_level},                                 level => $self->{level}->{rdf_grammer},
661                                 node => $cn);                                 node => $cn);
662              ## TODO: RDF Validator?              ## TODO: RDF Validator?
663            }            }
664          } else {          } else {
665            ## TODO: What RDF Validator does?            ## TODO: What RDF Validator does?
666            $self->{onerror}->(type => 'second node element',            $self->{onerror}->(type => 'second node element',
667                               level => $self->{grammer_level},                               level => $self->{level}->{rdf_grammer},
668                               node => $cn);                               node => $cn);
669          }          }
670        } elsif ($cn_type == $cn->TEXT_NODE or        } elsif ($cn_type == $cn->TEXT_NODE or
# Line 492  sub convert_property_element ($$%) { Line 678  sub convert_property_element ($$%) {
678              $mode = 'literal';              $mode = 'literal';
679            } else {            } else {
680              $self->{onerror}->(type => 'character not allowed',              $self->{onerror}->(type => 'character not allowed',
681                                 level => $self->{grammer_level},                                 level => $self->{level}->{rdf_grammer},
682                                 node => $cn);                                 node => $cn);
683              ## TODO: RDF Validator?              ## TODO: RDF Validator?
684            }            }
# Line 512  sub convert_property_element ($$%) { Line 698  sub convert_property_element ($$%) {
698        for my $attr (@prop_attr, $resource_attr, $nodeid_attr, $dt_attr) {        for my $attr (@prop_attr, $resource_attr, $nodeid_attr, $dt_attr) {
699          next unless $attr;          next unless $attr;
700          $self->{onerror}->(type => 'attribute not allowed',          $self->{onerror}->(type => 'attribute not allowed',
701                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
702                             node => $attr);                             node => $attr);
703          ## TODO: RDF Validator?          ## TODO: RDF Validator?
704        }        }
705                
706        my $object = $self->convert_node_element ($node_element);        my $object = $self->convert_node_element ($node_element,
707                                                    language => $opt{language});
708                
709        $self->{ontriple}->(subject => $opt{subject},        $self->{ontriple}->(subject => $opt{subject},
710                            predicate => {uri => $xuri},                            predicate => {uri => $xuri},
711                            object => $object,                            object => $object,
712                            node => $node);                            node => $node,
713                              id => $get_id_resource->($self, $rdf_id_attr));
       ## TODO: reification  
714      } elsif ($mode eq 'literal' or $mode eq 'literal-or-resource') {      } elsif ($mode eq 'literal' or $mode eq 'literal-or-resource') {
715        # |literalPropertyElt|        # |literalPropertyElt|
716                
717        for my $attr (@prop_attr, $resource_attr, $nodeid_attr) {        for my $attr (@prop_attr, $resource_attr, $nodeid_attr) {
718          next unless $attr;          next unless $attr;
719          $self->{onerror}->(type => 'attribute not allowed',          $self->{onerror}->(type => 'attribute not allowed',
720                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
721                             node => $attr);                             node => $attr);
722          ## TODO: RDF Validator?          ## TODO: RDF Validator?
723        }        }
# Line 539  sub convert_property_element ($$%) { Line 725  sub convert_property_element ($$%) {
725        ## TODO: $text SHOULD be in NFC        ## TODO: $text SHOULD be in NFC
726                
727        if ($dt_attr) {        if ($dt_attr) {
728          $self->{ontriple}->(subject => $opt{subject},          $self->{ontriple}
729                              predicate => {uri => $xuri},              ->(subject => $opt{subject},
730                              object => {value => $text,                 predicate => {uri => $xuri},
731                                         datatype => $dt_attr->value},                 object => {value => $text,
732                              node => $node);                            datatype => $uri_attr->$self, ($dt_attr->value)},
733                   ## ISSUE: No resolve() in the spec (but spec says that
734                   ## xml:base is applied also to rdf:datatype).
735                   node => $node,
736                   id => $get_id_resource->($self, $rdf_id_attr));
737        } else {        } else {
738          $self->{ontriple}->(subject => $opt{subject},          $self->{ontriple}->(subject => $opt{subject},
739                              predicate => {uri => $xuri},                              predicate => {uri => $xuri},
740                              object => {value => $text,                              object => {value => $text,
741                                         ## TODO: language                                         language => $opt{language}},
742                                        },                              node => $node,
743                              node => $node);                              id => $get_id_resource->($self, $rdf_id_attr));
744        }        }
   
       ## TODO: reification  
745      } else {      } else {
746        ## |emptyPropertyElt|        ## |emptyPropertyElt|
747    
748        for my $attr ($dt_attr) {        for my $attr ($dt_attr) {
749          next unless $attr;          next unless $attr;
750          $self->{onerror}->(type => 'attribute not allowed',          $self->{onerror}->(type => 'attribute not allowed',
751                             level => $self->{grammer_level},                             level => $self->{level}->{rdf_grammer},
752                             node => $attr);                             node => $attr);
753          ## TODO: RDF Validator?          ## TODO: RDF Validator?
754        }        }
# Line 569  sub convert_property_element ($$%) { Line 757  sub convert_property_element ($$%) {
757          $self->{ontriple}->(subject => $opt{subject},          $self->{ontriple}->(subject => $opt{subject},
758                              predicate => {uri => $xuri},                              predicate => {uri => $xuri},
759                              object => {value => '',                              object => {value => '',
760                                         ## TODO: language                                         language => $opt{language}},
761                                        },                              node => $node,
762                              node => $node);                              id => $get_id_resource->($self, $rdf_id_attr));
           
         ## TODO: reification  
763        } else {        } else {
764          my $object;          my $object;
765          if ($resource_attr) {          if ($resource_attr) {
766            $object = {uri => $resource_attr->value}; ## TODO: resolve            $object = {uri => $uri_attr->($self, $resource_attr)};
767              if (defined $nodeid_attr) {
768                $self->{onerror}->(type => 'attribute not allowed',
769                                   level => $self->{level}->{rdf_grammer},
770                                   node => $nodeid_attr);
771                 ## TODO: RDF Validator?
772              }
773          } elsif ($nodeid_attr) {          } elsif ($nodeid_attr) {
774            $object = {bnodeid => $nodeid_attr->value};            my $id = $nodeid_attr->value;
775              unless ($id =~ /\A\p{InXML_NCNameStartChar10}\p{InXMLNCNameChar10}*\z/) {
776                $self->{onerror}->(type => 'XML 1.0 NCName:syntax error',
777                                   level => $self->{level}->{rdf_grammer},
778                                   node => $self);
779              }
780              $object = {bnodeid => $get_bnodeid->($id)};
781          } else {          } else {
782            $object = {bnodeid => '## TODO: generated bnodeid'};            $object = {bnodeid => $generate_bnodeid->($self)};
783          }          }
784                    
785          for my $attr (@prop_attr) {          for my $attr (@prop_attr) {
# Line 589  sub convert_property_element ($$%) { Line 787  sub convert_property_element ($$%) {
787            if ($attr_xuri eq $RDF_URI . 'type') {            if ($attr_xuri eq $RDF_URI . 'type') {
788              $self->{ontriple}->(subject => $object,              $self->{ontriple}->(subject => $object,
789                                  predicate => {uri => $attr_xuri},                                  predicate => {uri => $attr_xuri},
790                                  object => $attr->value, ## TODO: resolve                                  object => $resolve->($attr->value, $attr),
791                                  node => $attr);                                  node => $attr);
792            } else {            } else {
793              ## TODO: SHOULD be in NFC              ## TODO: SHOULD be in NFC
794              $self->{ontriple}->(subject => $object,              $self->{ontriple}->(subject => $object,
795                                  predicate => {uri => $attr_xuri},                                  predicate => {uri => $attr_xuri},
796                                  object => {value => $attr->value,                                  object => {value => $attr->value,
797                                             ## TODO: lang                                             language => $opt{language}},
                                           },  
798                                  node => $attr);                                  node => $attr);
799            }            }
800          }          }
# Line 605  sub convert_property_element ($$%) { Line 802  sub convert_property_element ($$%) {
802          $self->{ontriple}->(subject => $opt{subject},          $self->{ontriple}->(subject => $opt{subject},
803                              predicate => {uri => $xuri},                              predicate => {uri => $xuri},
804                              object => $object,                              object => $object,
805                              node => $node);                              node => $node,
806                                        id => $get_id_resource->($self, $rdf_id_attr));
         ## TODO: reification  
807        }        }
808      }      }
809    }    }

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24