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

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

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

revision 1.2 by wakaba, Sun Oct 10 06:09:47 2004 UTC revision 1.3 by wakaba, Sat Oct 16 13:34:55 2004 UTC
# Line 794  sub perl_builtin_code ($;%) { Line 794  sub perl_builtin_code ($;%) {
794    $r;    $r;
795  }  }
796    
797    =head2 C<Operator> element
798    
799    An C<Operatpr> element associates an operator or special-purpose
800    function name to the method or attribute.  For the Perl binding,
801    it can be used to declare the method or attribute to be
802    called at the operation (by overloading of an operator;
803    see also L<overload>).
804    
805    Element value: A C<Type> dependent operator name.  
806    For the Perl binding, it is either the operator name
807    used with the C<overload> module (except C<=>),
808    C<DESTROY> or C<new>.
809    
810    Child elements:
811    
812    =over 4
813    
814    =item C<Type> = type (Required)
815    
816    The type of the element value.  It also specifies the
817    target binding of the C<Operatpr> element.
818    
819    =back
820    
821    =cut
822    
823  sub ops2perl () {  sub ops2perl () {
824    my $result = '';    my $result = '';
825    for (keys %{$Status->{Operator}}) {    for (keys %{$Status->{Operator}}) {
# Line 893  sub qname_label ($;%) { Line 919  sub qname_label ($;%) {
919    }    }
920  }  }
921    
922    =head1 TYPES
923    
924    In the DIS format, types (such as datatypes of something defined
925    by the DIS document or media types of the element values) are
926    identified by pair of a namespace URI and a local name.  In general,
927    the pair is specified by a QName in the DIS document.  The pair is
928    sometiems interpreted as a URI reference for the purpose of
929    comparise.
930    
931    NOTE:  In DIS documents, the QName is less strictly defined than
932    the XML standards; its namespace prefix can be empty; and
933    its namespace prefix and local name can contain any character
934    other than C<COLON>.  In addition, the interpretation of the
935    null-prefixed QName might differ by the context in which the
936    QName is used.  In general, its namespace is the default
937    namespace, as is QName in the XML document representing an element
938    type name.  But some local names, such as C<long> and C<DOMString>
939    might be interpreted as belonging to the C<DOMMain> namespace.
940    
941    =cut
942    
943  {  {
944  my $nest = 0;  my $nest = 0;
945  sub type_normalize ($);  sub type_normalize ($);
# Line 934  sub type_label ($;%) { Line 981  sub type_label ($;%) {
981    my %opt = @_;    my %opt = @_;
982    my $pod_code = sub { $opt{is_pod} ? pod_code $_[0] : $_[0] };    my $pod_code = sub { $opt{is_pod} ? pod_code $_[0] : $_[0] };
983    my $r = {    my $r = {
984        ExpandedURI q<DOMMain:boolean> => q<Boolean Value>,
985        ExpandedURI q<DOMMain:long> => q<Signed Long Integer>,
986      ExpandedURI q<DOMMain:unsigned-long> => q<Unsigned Long Integer>,      ExpandedURI q<DOMMain:unsigned-long> => q<Unsigned Long Integer>,
987      ExpandedURI q<DOMMain:unsigned-short> => q<Unsigned Short Integer>,      ExpandedURI q<DOMMain:unsigned-short> => q<Unsigned Short Floating Number>,
988      ExpandedURI q<ManakaiDOM:ManakaiDOMURI>      ExpandedURI q<ManakaiDOM:ManakaiDOMURI>
989        => $pod_code->(q<DOMString>).q< (DOM URI)>,        => $pod_code->(q<DOMString>).q< (DOM URI)>,
990      ExpandedURI q<ManakaiDOM:ManakaiDOMNamespaceURI>      ExpandedURI q<ManakaiDOM:ManakaiDOMNamespaceURI>
991        => $pod_code->(q<DOMString>).q< (Namespace URI)>,        => $pod_code->(q<DOMString>).q< (DOM Namespace URI)>,
992      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureName>      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureName>
993        => $pod_code->(q<DOMString>).q< (DOM Feature name)>,        => $pod_code->(q<DOMString>).q< (DOM Feature name)>,
994      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureVersion>      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureVersion>
995        => $pod_code->(q<DOMString>).q< (DOM Feature version)>,        => $pod_code->(q<DOMString>).q< (DOM Feature version)>,
996      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatures>      ExpandedURI q<ManakaiDOM:ManakaiDOMFeatures>
997        => $pod_code->(q<DOMString>).q< (DOM features)>,        => $pod_code->(q<DOMString>).q< (DOM features)>,
998        ExpandedURI q<ManakaiDOM:ManakaiDOMKeyIdentifier>
999          => $pod_code->(q<DOMString>).q< (DOM Key Identifier)>,
1000        ExpandedURI q<ManakaiDOM:ManakaiDOMKeyIdentifiers>
1001          => $pod_code->(q<DOMString>).q< (DOM Key Identifiers)>,
1002    }->{$uri};    }->{$uri};
1003    unless ($r) {    unless ($r) {
1004      if ($uri =~ /([\w_-]+)$/) {      if ($uri =~ /([\w_-]+)$/) {
# Line 1094  sub get_perl_definition ($%) { Line 1147  sub get_perl_definition ($%) {
1147    $def ? $def->value : $opt{default};    $def ? $def->value : $opt{default};
1148  }  }
1149    
1150    =head1 DISDOC DOCUMENTATION FORMAT
1151    
1152    The DISDOC format is a documentation format for DIS documents.
1153    
1154    =cut
1155    
1156  sub dis2perl ($) {  sub dis2perl ($) {
1157    my $node = shift;    my $node = shift;
1158    my $r = '';    my $r = '';
# Line 1182  sub disdoc2text ($;%) { Line 1241  sub disdoc2text ($;%) {
1241            $marker = disdoc_inline2text ($1, %opt) . ': ';            $marker = disdoc_inline2text ($1, %opt) . ': ';
1242          }          }
1243          push @r, $marker . (disdoc_inline2text ($s, %opt));          push @r, $marker . (disdoc_inline2text ($s, %opt));
1244          } elsif ($et eq 'NOTE') {
1245            push @r, "NOTE: ". disdoc_inline2text ($s, %opt);
1246          } elsif ($et eq 'eg') {
1247            push @r, "Example. ";
1248            $s =~ s/^\s+//;
1249            valid_err qq<Invalid content for DISDOC "eg" element: "$s">,
1250              node => $opt{node} if length $s;
1251        } else {        } else {
1252          valid_err qq<Unknown DISDOC element type "$et">, node => $opt{node};          valid_err qq<Unknown DISDOC element type "$et">, node => $opt{node};
1253        }        }
# Line 1219  sub disdoc_inline2text ($;%) { Line 1285  sub disdoc_inline2text ($;%) {
1285          node => $opt{node};          node => $opt{node};
1286      } elsif (defined $cdata) {      } elsif (defined $cdata) {
1287        $r = $cdata;        $r = $cdata;
1288      } elsif ({DFN => 1, CITE => 1}->{$type}) {      } elsif ({DFN => 1, CITE => 1, KEY => 1}->{$type}) {
1289        $r = disdoc_inline2text $data;        $r = disdoc_inline2text $data;
1290      } elsif ({SRC => 1}->{$type}) {      } elsif ({SRC => 1}->{$type}) {
1291        $r = q<[>. disdoc_inline2text ($data) . q<]>;        $r = q<[>. disdoc_inline2text ($data) . q<]>;
1292        } elsif ({EM => 1}->{$type}) {
1293          $r = q<*>. disdoc_inline2text ($data) . q<*>;
1294      } elsif ({URI => 1}->{$type}) {      } elsif ({URI => 1}->{$type}) {
1295        $r = q{<} . $data . q{>};        $r = q{<} . $data . q{>};
1296      } elsif ({CODE => 1, Perl => 1}->{$type}) {      } elsif ({CODE => 1, Perl => 1}->{$type}) {
# Line 1279  sub disdoc2pod ($;%) { Line 1347  sub disdoc2pod ($;%) {
1347        push @el, {type => $et};        push @el, {type => $et};
1348        if ($et eq 'P') { ## Paragraph        if ($et eq 'P') { ## Paragraph
1349          push @r, pod_para (disdoc_inline2pod ($s, %opt));          push @r, pod_para (disdoc_inline2pod ($s, %opt));
1350          } elsif ($et eq 'NOTE') {
1351            push @r, pod_para (pod_em ('NOTE').": ".disdoc_inline2pod ($s, %opt));
1352          } elsif ($et eq 'eg') {
1353            push @r, pod_para (pod_em ('Example').". ");
1354            $s =~ s/^\s+//;
1355            valid_err qq<Invalid content for DISDOC "eg" element: "$s">,
1356              node => $opt{node} if length $s;
1357        } elsif ($et eq 'LI' or $et eq 'OLI') { ## List        } elsif ($et eq 'LI' or $et eq 'OLI') { ## List
1358          my $marker = '*';          my $marker = '*';
1359          unless ($el[-1]->{type} eq '#list') {          unless ($el[-1]->{type} eq '#list') {
# Line 1357  sub disdoc_inline2pod ($;%) { Line 1432  sub disdoc_inline2pod ($;%) {
1432          node => $opt{node};          node => $opt{node};
1433      } elsif (defined $cdata) {      } elsif (defined $cdata) {
1434        $r = pod_cdata $cdata;        $r = pod_cdata $cdata;
1435      } elsif ({CODE => 1}->{$type}) {      } elsif ({CODE => 1, KEY => 1}->{$type}) {
1436        $r = pod_code disdoc_inline2pod $data;        $r = pod_code disdoc_inline2pod $data;
1437        } elsif ({EM => 1}->{$type}) {
1438          $r = pod_em disdoc_inline2pod $data;
1439      } elsif ({DFN => 1}->{$type}) {      } elsif ({DFN => 1}->{$type}) {
1440        $r = pod_dfn disdoc_inline2pod $data;        $r = pod_dfn disdoc_inline2pod $data;
1441      } elsif ({CITE => 1}->{$type}) {      } elsif ({CITE => 1}->{$type}) {
# Line 1590  sub get_redef_description ($;%) { Line 1667  sub get_redef_description ($;%) {
1667    }    }
1668    if ($node->get_attribute_value ('IsAbstract', default => 0)) {    if ($node->get_attribute_value ('IsAbstract', default => 0)) {
1669      push @desc, pod_para (qq<This $opt{method} is defined abstractly; >.      push @desc, pod_para (qq<This $opt{method} is defined abstractly; >.
1670                            qq<it must be overridden by cocrete implementation. >);                            qq<it must be overridden by the concrete >.
1671                              qq<implementation. >);
1672    }    }
1673      my @redefBy;      my @redefBy;
1674      for (@{$node->child_nodes}) {      for (@{$node->child_nodes}) {
# Line 2016  sub if2perl ($) { Line 2094  sub if2perl ($) {
2094      push @desc, pod_para ('This interface is intended to be implemented '.      push @desc, pod_para ('This interface is intended to be implemented '.
2095                            'by DOM applications.  To implement this '.                            'by DOM applications.  To implement this '.
2096                            'interface, put the statement '),                            'interface, put the statement '),
2097                  pod_pre ('push our @ISA, q<'.($is_abs?$if_name:$pack_name).'>;'),                  pod_pre ('push our @ISA, q<'.($is_abs?$if_pack_name:$pack_name).
2098                             '>;'),
2099                  pod_para ('on your package and define methods and '.                  pod_para ('on your package and define methods and '.
2100                            'attributes.');                            'attributes.');
2101    }    }
# Line 2329  sub method2perl ($;%) { Line 2408  sub method2perl ($;%) {
2408          }          }
2409          push my @param_desc_val,          push my @param_desc_val,
2410                            pod_item (type_label $type, is_pod => 1),                            pod_item (type_label $type, is_pod => 1),
2411                            pod_para get_description $_;                            pod_paras get_description $_;
2412          $param_prototype .= '$';          $param_prototype .= '$';
2413          for (@{$_->child_nodes}) {          for (@{$_->child_nodes}) {
2414            next unless $_->local_name eq 'InCase';            next unless $_->local_name eq 'InCase';
2415            push @param_desc_val, pod_item (get_incase_label $_, is_pod => 1),            push @param_desc_val, pod_item (get_incase_label $_, is_pod => 1),
2416                                  pod_para (get_description $_);                                  pod_paras (get_description $_);
2417          }          }
2418          push @param_desc, pod_list 4, @param_desc_val;          push @param_desc, pod_list 4, @param_desc_val;
2419        }        }
# Line 2359  sub method2perl ($;%) { Line 2438  sub method2perl ($;%) {
2438                             q< has been > . $level . '.') : ();                             q< has been > . $level . '.') : ();
2439    
2440    if (@param_list) {    if (@param_list) {
2441      push @desc, pod_para ('This method requires ' .      push @desc, pod_para ('This method has ' .
2442                            english_number (@param_list + 0,                            english_number (@param_list + 0,
2443                                            singular => q<parameter>,                                            singular => q<parameter>,
2444                                            plural => q<parameters>) . ':'),                                            plural => q<parameters>) . ':'),
# Line 2487  sub method2perl ($;%) { Line 2566  sub method2perl ($;%) {
2566                                                  ('Type',                                                  ('Type',
2567                                                   default => 'DOMMain:any')),                                                   default => 'DOMMain:any')),
2568                                            is_pod => 1)),                                            is_pod => 1)),
2569                      pod_para (get_description $return);                      pod_paras (get_description $return);
2570      }      }
2571      for (@{$return->child_nodes}) {      for (@{$return->child_nodes}) {
2572        if ($_->local_name eq 'InCase') {        if ($_->local_name eq 'InCase') {
2573          push @return, pod_item ( get_incase_label $_, is_pod => 1),          push @return, pod_item ( get_incase_label $_, is_pod => 1),
2574                        pod_para (get_description $_);                        pod_paras (get_description $_);
2575          $has_return++;          $has_return++;
2576        } elsif ($_->local_name eq 'Exception') {        } elsif ($_->local_name eq 'Exception') {
2577          push @exception, pod_item ('Exception: ' .          push @exception, pod_item ('Exception: ' .
# Line 2503  sub method2perl ($;%) { Line 2582  sub method2perl ($;%) {
2582                                  '.' . pod_code $_->get_attribute_value                                  '.' . pod_code $_->get_attribute_value
2583                                                     ('Name',                                                     ('Name',
2584                                                      default => '<unknown>')),                                                      default => '<unknown>')),
2585                        pod_para (get_description $_);                        pod_paras (get_description $_);
2586          my @st;          my @st;
2587          for (@{$_->child_nodes}) {          for (@{$_->child_nodes}) {
2588            next unless $_->node_type eq '#element';            next unless $_->node_type eq '#element';
# Line 2775  sub attr2perl ($;%) { Line 2854  sub attr2perl ($;%) {
2854                                                  ('Type',                                                  ('Type',
2855                                                   default => 'DOMMain:any'),                                                   default => 'DOMMain:any'),
2856                                            is_pod => 1)),                                            is_pod => 1)),
2857                      pod_para (get_description $return);                      pod_paras (get_description $return);
2858      for (@{$return->child_nodes}) {      for (@{$return->child_nodes}) {
2859        if ($_->local_name eq 'InCase') {        if ($_->local_name eq 'InCase') {
2860          push @return, pod_item (get_incase_label $_, is_pod => 1),          push @return, pod_item (get_incase_label $_, is_pod => 1),
2861                        pod_para (get_description $_);                        pod_paras (get_description $_);
2862        } elsif ($_->local_name eq 'Exception') {        } elsif ($_->local_name eq 'Exception') {
2863          push @return_xcept, pod_item ('Exception: ' .          push @return_xcept, pod_item ('Exception: ' .
2864                                  (type_label ($_->get_attribute_value                                  (type_label ($_->get_attribute_value
# Line 2789  sub attr2perl ($;%) { Line 2868  sub attr2perl ($;%) {
2868                                  '.' . pod_code $_->get_attribute_value                                  '.' . pod_code $_->get_attribute_value
2869                                                     ('Name',                                                     ('Name',
2870                                                      default => '<unknown>')),                                                      default => '<unknown>')),
2871                        pod_para (get_description $_);                        pod_paras (get_description $_);
2872          my @st;          my @st;
2873          for (@{$_->child_nodes}) {          for (@{$_->child_nodes}) {
2874            next unless $_->node_type eq '#element';            next unless $_->node_type eq '#element';
# Line 2863  sub attr2perl ($;%) { Line 2942  sub attr2perl ($;%) {
2942                                                  ('Type',                                                  ('Type',
2943                                                   default => 'DOMMain:any')),                                                   default => 'DOMMain:any')),
2944                                            is_pod => 1)),                                            is_pod => 1)),
2945                      pod_para (get_description $set);                      pod_paras (get_description $set);
2946      for (@{$set->child_nodes}) {      for (@{$set->child_nodes}) {
2947        if ($_->local_name eq 'InCase') {        if ($_->local_name eq 'InCase') {
2948          push @set_desc, pod_item (get_incase_label $_, is_pod => 1),          push @set_desc, pod_item (get_incase_label $_, is_pod => 1),
2949                          pod_para (get_description $_);                          pod_paras (get_description $_);
2950        } elsif ($_->local_name eq 'Exception') {        } elsif ($_->local_name eq 'Exception') {
2951          push @set_xcept, pod_item ('Exception: ' .          push @set_xcept, pod_item ('Exception: ' .
2952                                  (type_label ($_->get_attribute_value                                  (type_label ($_->get_attribute_value
# Line 2877  sub attr2perl ($;%) { Line 2956  sub attr2perl ($;%) {
2956                                  '.' . pod_code $_->get_attribute_value                                  '.' . pod_code $_->get_attribute_value
2957                                                     ('Name',                                                     ('Name',
2958                                                      default => '<unknown>')),                                                      default => '<unknown>')),
2959                        pod_para (get_description $_);                        pod_paras (get_description $_);
2960          my @st;          my @st;
2961          for (@{$_->child_nodes}) {          for (@{$_->child_nodes}) {
2962            next unless $_->node_type eq '#element';            next unless $_->node_type eq '#element';
# Line 3443  sub param2poditem ($;%) { Line 3522  sub param2poditem ($;%) {
3522                                                  ('Type',                                                  ('Type',
3523                                                   default => 'DOMMain:any')),                                                   default => 'DOMMain:any')),
3524                                     is_pod => 1)),                                     is_pod => 1)),
3525               pod_para (get_description $node);               pod_paras (get_description $node);
3526    for (@{$node->child_nodes}) {    for (@{$node->child_nodes}) {
3527      last unless $_->node_type eq '#element';      last unless $_->node_type eq '#element';
3528      if ($_->local_name eq 'InCase') {      if ($_->local_name eq 'InCase') {
3529        push @val, pod_item (get_incase_label $_, is_pod => 1),        push @val, pod_item (get_incase_label $_, is_pod => 1),
3530                   pod_para (get_description $_);                   pod_paras (get_description $_);
3531      } elsif ({qw/Name 1 QName 1 Type 1      } elsif ({qw/Name 1 QName 1 Type 1
3532                   Description 1 ImplNote 1/}->{$_->local_name}) {                   Description 1 ImplNote 1/}->{$_->local_name}) {
3533        #        #
# Line 3479  sub subtype2poditem ($;%) { Line 3558  sub subtype2poditem ($;%) {
3558        node => $node;        node => $node;
3559    }    }
3560        
3561    push @desc, pod_para (get_description $node);    push @desc, pod_paras (get_description $node);
3562    my @param;    my @param;
3563    for (@{$node->child_nodes}) {    for (@{$node->child_nodes}) {
3564      last unless $_->node_type eq '#element';      last unless $_->node_type eq '#element';
# Line 3689  for (ExpandedURI q<ManakaiDOM:ManakaiDOM Line 3768  for (ExpandedURI q<ManakaiDOM:ManakaiDOM
3768       ExpandedURI q<ManakaiDOM:ManakaiDOMNamespaceURI>,       ExpandedURI q<ManakaiDOM:ManakaiDOMNamespaceURI>,
3769       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureName>,       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureName>,
3770       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureVersion>,       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatureVersion>,
3771       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatures>) {       ExpandedURI q<ManakaiDOM:ManakaiDOMFeatures>,
3772         ExpandedURI q<ManakaiDOM:ManakaiDOMKeyIdentifier>,
3773         ExpandedURI q<ManakaiDOM:ManakaiDOMKeyIdentifiers>) {
3774    $Info->{DataTypeAlias}->{$_}    $Info->{DataTypeAlias}->{$_}
3775         ->{isa_uri} = [ExpandedURI q<DOMMain:DOMString>];         ->{isa_uri} = [ExpandedURI q<DOMMain:DOMString>];
3776  }  }
# Line 3733  $result .= pod_block Line 3814  $result .= pod_block
3814                         ' - ' . get_description ($Module, name => 'FullName')),                         ' - ' . get_description ($Module, name => 'FullName')),
3815               section (               section (
3816                 opt => pod_head (1, 'DESCRIPTION'),                 opt => pod_head (1, 'DESCRIPTION'),
3817                 req => pod_para (get_description ($Module)),                 req => pod_paras (get_description ($Module)),
3818               ),               ),
3819               pod_head (1, 'DOM INTERFACES');               pod_head (1, 'DOM INTERFACES');
3820    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24