/[suikacvs]/messaging/manakai/bin/mkdisdump.pl
Suika

Diff of /messaging/manakai/bin/mkdisdump.pl

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

revision 1.12 by wakaba, Fri Sep 30 13:06:13 2005 UTC revision 1.13 by wakaba, Sat Oct 1 12:14:29 2005 UTC
# Line 36  use Message::Util::QName::Filter { Line 36  use Message::Util::QName::Filter {
36    dump => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#DISDump/>,    dump => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#DISDump/>,
37    dx => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#>,    dx => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#>,
38    ecore => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/>,    ecore => q<http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/>,
39      idl => q<http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#>,
40    infoset => q<http://www.w3.org/2001/04/infoset#>,    infoset => q<http://www.w3.org/2001/04/infoset#>,
41    lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,    lang => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#>,
42    ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,    ManakaiDOM => q<http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#>,
# Line 293  sub append_document_documentation (%) { Line 294  sub append_document_documentation (%) {
294    $section->set_attribute_ns    $section->set_attribute_ns
295        (ExpandedURI q<ddoct:>, 'ddoct:basePath', '../' x ($path =~ tr#/#/#));        (ExpandedURI q<ddoct:>, 'ddoct:basePath', '../' x ($path =~ tr#/#/#));
296    
297    $section->set_attribute_ns (ExpandedURI q<dump:>,    if ($opt{source_resource}->is_type_uri (ExpandedURI q<doc:Document>)) {
298                                'dump:docType' => ExpandedURI q<doc:Document>)      $section->append_child ($od->create_element_ns (ExpandedURI q<doc:>, 'rel'))
299      if $opt{source_resource}->is_type_uri (ExpandedURI q<doc:Document>);        ->set_attribute_ns (ExpandedURI q<dump:>, 'dump:uri',
300                              ExpandedURI q<doc:Document>);
301      }
302        
303    ## TODO: Conneg    ## TODO: Conneg
304    for my $con (@{$opt{source_resource}->get_property_value_list    for my $con (@{$opt{source_resource}->get_property_value_list
# Line 311  sub append_document_documentation (%) { Line 314  sub append_document_documentation (%) {
314        ->append_child (transform_disdoc_tree ($tree));        ->append_child (transform_disdoc_tree ($tree));
315    }    }
316    
317    for my $con (@{$opt{source_resource}->get_property_value_list    append_document_properties
318                     (ExpandedURI q<dis:Label>)}) {      (source_resource => $opt{source_resource},
319      my $cond = $con->get_feature (ExpandedURI q<DIS:Doc>, '2.0');       result_parent => $section);
     my $tree = $cond->get_disdoc_tree  
       ($od, ExpandedURI q<lang:disdocInline>,  
        $opt{source_resource}->database,  
        default_name_uri => $opt{source_resource}->source_node_id,  
        default_for_uri => $opt{source_resource}->for_uri);  
     my $ns = $con->name;  
     my $ln = $1 if ($ns =~ s/(\w+)$//);  
     $section->append_child ($od->create_element_ns ($ns, $ln))  
         ->append_child (transform_disdoc_tree ($tree));  
   }  
320    
321    for my $v (@{$opt{source_resource}->get_property_value_list    for my $v (@{$opt{source_resource}->get_property_value_list
322                     (ExpandedURI q<doc:part>)}) {                     (ExpandedURI q<doc:part>)}) {
# Line 332  sub append_document_documentation (%) { Line 325  sub append_document_documentation (%) {
325      my $doc = $section->append_child      my $doc = $section->append_child
326        ($od->create_element_ns (ExpandedURI q<dump:>, 'document'));        ($od->create_element_ns (ExpandedURI q<dump:>, 'document'));
327      $doc->ref ($res->uri);      $doc->ref ($res->uri);
328      $doc->set_attribute_ns (ExpandedURI q<dump:>, 'dump:docType' => $v->name);      for my $vv (@{$v->get_property (ExpandedURI q<doc:rel>)||[]}) {
329          $doc->append_child ($od->create_element_ns (ExpandedURI q<doc:>, 'rel'))
330            ->set_attribute_ns (ExpandedURI q<dump:>, 'dump:uri', $vv->uri);
331        }
332    }    }
333  } # append_document_documentation  } # append_document_documentation
334    
# Line 392  sub append_module_documentation (%) { Line 388  sub append_module_documentation (%) {
388    
389  sub append_datatype_documentation (%) {  sub append_datatype_documentation (%) {
390    my %opt = @_;    my %opt = @_;
391    my $section = $opt{result_parent}->create_data_type    my $od = $opt{result_parent}->owner_document;
392                                          ($opt{source_resource}->uri);    my $section = $opt{result_parent}->can ('create_data_type')
393        ? $opt{result_parent}->create_data_type
394                                            ($opt{source_resource}->uri)
395        : $opt{result_parent}->append_child
396          ($od->create_element_ns
397           (ExpandedURI q<dump:>, 'dataType'));
398        
399    add_uri ($opt{source_resource} => $section);    add_uri ($opt{source_resource} => $section);
400    
# Line 414  sub append_datatype_documentation (%) { Line 415  sub append_datatype_documentation (%) {
415    $section->set_attribute_ns    $section->set_attribute_ns
416        (ExpandedURI q<ddoct:>, 'ddoct:basePath', '../' x (@file - 1));        (ExpandedURI q<ddoct:>, 'ddoct:basePath', '../' x (@file - 1));
417    
418      for my $con (@{$opt{source_resource}->get_property_value_list
419                       (ExpandedURI q<dis:AppName>)},
420                   @{$opt{source_resource}->get_property_value_list
421                       (ExpandedURI q<dis:Def>)}) {
422        my $ns = $con->name;
423        my $ln = $1 if ($ns =~ s/(\w+)$//);
424        $section->append_child ($od->create_element_ns ($ns, $ln))
425          ->text_content ($con->string_value);
426        if ($con->isa ('Message::Util::IF::DVURIValue')) {
427          $ReferredResource{$con->uri} ||= 1;
428        }
429      }
430    
431      append_document_properties
432        (source_resource => $opt{source_resource},
433         result_parent => $section);
434                                    
435    append_description (source_resource => $opt{source_resource},    append_description (source_resource => $opt{source_resource},
436                        result_parent => $section,                        result_parent => $section,
437                        has_label => 1);                        has_label => 1);
# Line 489  sub append_interface_documentation (%) { Line 507  sub append_interface_documentation (%) {
507    
508  } # append_interface_documentation  } # append_interface_documentation
509    
510    sub append_idl_interface_documentation (%) {
511      my %opt = @_;
512      my $section = $opt{result_parent}->append_child
513        ($opt{result_parent}->owner_document->create_element_ns
514           (ExpandedURI q<dump:>, 'interface'));
515      
516      add_uri ($opt{source_resource} => $section);
517    
518      my $path = $opt{source_resource}->get_property_text
519                       (ExpandedURI q<dis:FileName>,
520                        $opt{source_resource}->local_name);
521      $path =~ s#::#/#g;
522      $section->resource_file_path_stem ($path);
523    
524      $section->set_attribute_ns
525          (ExpandedURI q<ddoct:>, 'ddoct:basePath',
526           join '', '../' x ($path =~ tr#/#/#));
527    
528      $section->is_exception_interface (1)
529        if $opt{source_resource}->is_type_uri (ExpandedURI q<idl:Exception>);
530    
531      append_description (source_resource => $opt{source_resource},
532                          result_parent => $section);
533    
534      for my $memres (@{$opt{source_resource}->get_child_resource_list}) {
535        if ($memres->is_type_uri (ExpandedURI q<DISLang:Method>)) {
536          append_method_documentation (source_resource => $memres,
537                                       result_parent => $section);
538        } elsif ($memres->is_type_uri (ExpandedURI q<DISLang:Attribute>)) {
539          append_attr_documentation (source_resource => $memres,
540                                     result_parent => $section);
541        } elsif ($memres->is_type_uri (ExpandedURI q<DISLang:ConstGroup>)) {
542          append_constgroup_documentation (source_resource => $memres,
543                                           result_parent => $section);
544        }
545      }
546    
547      ## Inheritance
548      append_inheritance (source_resource => $opt{source_resource},
549                          result_parent => $section,
550                          target => 'idl');
551    
552      $ReferredResource{ExpandedURI q<idl:void>} ||= 1;
553    } # append_idl_interface_documentation
554    
555  sub append_class_documentation (%) {  sub append_class_documentation (%) {
556    my %opt = @_;    my %opt = @_;
557    my $section = $opt{result_parent}->create_class    my $section = $opt{result_parent}->create_class
# Line 871  sub append_description (%) { Line 934  sub append_description (%) {
934    }    }
935  } # append_description  } # append_description
936    
937    sub append_document_properties (%) {
938      my %opt = @_;
939      my $od = $opt{result_parent}->owner_document;
940    
941      for my $con (@{$opt{source_resource}->get_property_value_list
942                       (ExpandedURI q<dis:Label>)}) {
943        my $cond = $con->get_feature (ExpandedURI q<DIS:Doc>, '2.0');
944        my $tree = $cond->get_disdoc_tree
945          ($od, ExpandedURI q<lang:disdocInline>,
946           $opt{source_resource}->database,
947           default_name_uri => $opt{source_resource}->source_node_id,
948           default_for_uri => $opt{source_resource}->for_uri);
949        my $ns = $con->name;
950        my $ln = $1 if ($ns =~ s/(\w+)$//);
951        $opt{result_parent}->append_child ($od->create_element_ns ($ns, $ln))
952          ->append_child (transform_disdoc_tree ($tree));
953      }
954    } # append_document_properties
955    
956  sub transform_disdoc_tree ($;%) {  sub transform_disdoc_tree ($;%) {
957    my ($el, %opt) = @_;    my ($el, %opt) = @_;
958    my @el = ($el);    my @el = ($el);
# Line 1311  while (my @ruri = grep {$ReferredResourc Line 1393  while (my @ruri = grep {$ReferredResourc
1393          (result_parent => $body,          (result_parent => $body,
1394           source_resource => $res,           source_resource => $res,
1395           is_partial => 1);           is_partial => 1);
1396        } elsif ($res->is_type_uri (ExpandedURI q<idl:Interface>) or
1397                 $res->is_type_uri (ExpandedURI q<idl:Exception>)) {
1398          append_idl_interface_documentation
1399            (result_parent => $body,
1400             source_resource => $res);
1401      } elsif ($res->is_type_uri (ExpandedURI q<DISLang:Class>)) {      } elsif ($res->is_type_uri (ExpandedURI q<DISLang:Class>)) {
1402        my $mod = $res->owner_module;        my $mod = $res->owner_module;
1403        unless ($ReferredResource{$mod->uri} < 0) {        unless ($ReferredResource{$mod->uri} < 0) {
# Line 1337  while (my @ruri = grep {$ReferredResourc Line 1424  while (my @ruri = grep {$ReferredResourc
1424           source_resource => $res,           source_resource => $res,
1425           is_partial => 1);           is_partial => 1);
1426      } elsif ($res->is_type_uri (ExpandedURI q<DISCore:AnyType>)) {      } elsif ($res->is_type_uri (ExpandedURI q<DISCore:AnyType>)) {
1427        my $mod = $res->owner_module;        if ($res->is_type_uri (ExpandedURI q<idl:IDLDataType>)) {
1428        unless ($mod->is_defined) {          append_datatype_documentation
1429          $ReferredResource{$uri} = -1;            (result_parent => $body,
1430          next U;             source_resource => $res);
1431        } elsif (not ($ReferredResource{$mod->uri} < 0)) {        } else {
1432          unshift @ruri, $uri;          my $mod = $res->owner_module;
1433          unshift @ruri, $mod->uri;          unless ($mod->is_defined) {
1434          next U;            $ReferredResource{$uri} = -1;
1435              next U;
1436            } elsif (not ($ReferredResource{$mod->uri} < 0)) {
1437              unshift @ruri, $uri;
1438              unshift @ruri, $mod->uri;
1439              next U;
1440            }
1441            append_datatype_documentation
1442              (result_parent => $body->create_module ($mod->uri),
1443               source_resource => $res);
1444        }        }
       append_datatype_documentation  
         (result_parent => $body->create_module ($mod->uri),  
          source_resource => $res);  
1445      } elsif ($res->is_type_uri (ExpandedURI q<DISLang:AnyMethod>) or      } elsif ($res->is_type_uri (ExpandedURI q<DISLang:AnyMethod>) or
1446               $res->is_type_uri (ExpandedURI q<DISLang:ConstGroup>)) {               $res->is_type_uri (ExpandedURI q<DISLang:ConstGroup>)) {
1447        my $cls = $res->parent_resource;        my $cls = $res->parent_resource;

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24