/[suikacvs]/markup/tool/mkdtds.pl
Suika

Diff of /markup/tool/mkdtds.pl

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

revision 1.2 by wakaba, Fri Oct 24 13:37:38 2003 UTC revision 1.4 by wakaba, Sun Jun 20 04:54:27 2004 UTC
# Line 1  Line 1 
1    #!/usr/bin/perl
2  use strict;  use strict;
3  {require SuikaWiki::Markup::SuikaWikiConfig20::Parser;  our $SCRIPT_NAME = 'mkdtds';
4    our $VERSION = do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
5    {require Message::Markup::SuikaWikiConfig20::Parser;
6    
7  my $parser = new SuikaWiki::Markup::SuikaWikiConfig20::Parser;  my $parser = new Message::Markup::SuikaWikiConfig20::Parser;
8  local $/ = undef;  local $/ = undef;
9  my $src = $parser->parse_text (scalar <>);  my $src = $parser->parse_text (scalar <>);
10  my $Info = {};  my $Info = {};
11    
12  for my $src ($src->get_attribute ('ModuleSet')  for my $src ($src->get_attribute ('ModuleSet')
13            || $src->get_attribute ('DocumentType')) {            || $src->get_attribute ('DocumentType')) {
14    for (qw/ID Copyright BaseURI/) {    for (qw/Description/) {
15      $Info->{$_} = $src->get_attribute_value ($_);      $Info->{$_} = $src->get_attribute_value ($_);
16    }    }
17    $Info->{Name} = $src->get_attribute_value ('Name')    for (qw/Name ID Copyright BaseURI Version/) {
18               .' '.$src->get_attribute_value ('Version');      $Info->{$_} = normalize_wsp ($src->get_attribute_value ($_));
19      }
20      $Info->{realname} = $Info->{Name};
21      $Info->{Name} .= ' ' . $Info->{Version} if length $Info->{Version};
22    $Info->{ns} = $src->get_attribute ('Namespace');    $Info->{ns} = $src->get_attribute ('Namespace');
23  }  }
24    
# Line 38  if (ref $src->get_attribute ('ModuleSet' Line 44  if (ref $src->get_attribute ('ModuleSet'
44  }  }
45  exit}  exit}
46    
47    sub normalize_wsp ($;%) {
48      my $s = shift;
49      $s =~ s/\s+/ /g;
50      $s =~ s/^ +//;
51      $s =~ s/ +$//;
52      $s;
53    }
54    sub make_paragraphs ($;%) {
55      my ($para, %opt) = @_;
56      join "\n\n", map {
57        my $s = $_;
58        $s =~ s/\n+$//g;
59        $s =~ s/\n/\n$opt{indent}/g;
60        $opt{indent}.$s;
61      } grep {length} @$para;
62    }
63    
64    sub dot_padding ($%) {
65      my ($s, %opt) = @_;
66      if ($opt{length} - length $s > 0) {
67        return $s . ( ($opt{dot} or q(.)) x ($opt{length} - length $s) );
68      } else {
69        return $s;
70      }
71    }
72    
73  sub submodule_id_of ($$;%) {  sub submodule_id_of ($$;%) {
74    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
75    my $id = $src->get_attribute_value ('ID') || $opt{default};    my $id = $src->get_attribute_value ('ID') || $opt{default};
# Line 161  sub description ($$;%) { Line 193  sub description ($$;%) {
193    $desc = qq(<!-- $desc -->\n) if $desc;    $desc = qq(<!-- $desc -->\n) if $desc;
194    $desc;    $desc;
195  }  }
196    sub xml_condition_section ($$;%) {
197      my ($condition, $content, %opt) = @_;
198        qq(<![%$condition;[\n)
199      . $content
200      . qq(<!-- end of $condition -->]]>\n);
201    }
202    sub xml_parameter_ENTITY ($%) {
203      my ($name, %opt) = @_;
204      qq(<!ENTITY % $name @{[paralit $opt{value}]}>\n);
205    }
206    
207  sub entity_declaration ($$;%) {  sub entity_declaration ($$;%) {
208    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
# Line 265  sub dtd_driver_module_sets ($$) { Line 307  sub dtd_driver_module_sets ($$) {
307  ]]>  ]]>
308  <!ENTITY % $module_set->{ID}.xmlns.decl.attrib "">\n\n);  <!ENTITY % $module_set->{ID}.xmlns.decl.attrib "">\n\n);
309    }    }
310      $s .= <<EOH;
311    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
312         XML Schema Instance attributes. -->
313    <!ENTITY % XSI.prefix "xsi">
314    
315    <!ENTITY % XSI.pfx "%XSI.prefix;:">
316    
317    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
318    
319    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
320         the schemaLocation attribute. -->
321    <!ENTITY % XSI.xmlns.attrib
322            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
323    EOH
324    $s .= qq(\n<!ENTITY % NS.decl.attrib    $s .= qq(\n<!ENTITY % NS.decl.attrib
325          ").join ("\n\t", (map {qq(%$_->{ID}.xmlns.decl.attrib;)} @src),          ").join ("\n\t", (map {qq(%$_->{ID}.xmlns.decl.attrib;)} @src),
326                           map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src).qq(">\n);                           map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src)
327              .qq(\n\t%XSI.xmlns.attrib;">\n);
328    $s .= qq(\n);    $s .= qq(\n);
329    for my $module_set (@src) {    for my $module_set (@src) {
330      $s .= qq(<!ENTITY % $module_set->{ID}.xmlns.attrib "%NS.decl.attrib;">\n);      $s .= qq(<!ENTITY % $module_set->{ID}.xmlns.attrib "%NS.decl.attrib;">\n);
# Line 369  sub qname_module ($$) { Line 426  sub qname_module ($$) {
426  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
427                              q(INCLUDE):q(IGNORE)]}">                              q(INCLUDE):q(IGNORE)]}">
428    
429  <!-- 1. Declare conditional section keyword, used to activate namespace prefixing. -->  <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->
430    
431    <!-- 1. Declare a %$ID.prefixed; conditional section keyword, used
432            to activate namespace prefixing. -->
433  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
434                              q(INCLUDE):                              q(INCLUDE):
435                              $ns->get_attribute_value ('UsePrefix')==-1?                              $ns->get_attribute_value ('UsePrefix')==-1?
436                              q(IGNORE):                              q(IGNORE):
437                              q(%NS.prefixed;)]}">                              q(%NS.prefixed;)]}">
438    
439  <!-- 2. Declare a parameter entity containing the namespace name. -->  <!ENTITY % $ID.global.attrs.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
440                                q(INCLUDE):
441                                $ns->get_attribute_value ('UsePrefix')==-1?
442                                q(IGNORE):
443                                q(%NS.prefixed;)]}">
444    
445    <!ENTITY % $ID.xsi.attrs "INCLUDE">
446    
447    <!-- 2. Declare a parameter entity %$ID.xmlns; containing
448            the URI reference used to identity the namespace. -->
449  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">
450    
451  <!-- 3. Declare parameter entities containing the default namespace prefix  <!-- 3. Declare parameter entity %$ID.prefix; containing
452          string to use when prefixing is enabled. -->          the default namespace prefix string to use when prefixing
453            is enabled. This may be overridden in the DTD driver or the
454            internal subset of a document instance.
455            
456            NOTE: As specified in XML Namespace speficications, the namespace
457            prefix serves as a proxy for the URI reference, and is not in itself
458            significant. -->
459  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">
460    
461  <!-- 4. Declare parameter entities containing the colonized prefix  <!-- 4. Declare parameter entity %$ID.pfx; containing the
462          used when prefixing is active, an empty string when it is not. -->          colonized prefix (e.g, '%$ID.prefix;:') used when
463            prefixing is active, an empty string when it is not. -->
464  <![%$ID.prefixed;[  <![%$ID.prefixed;[
465  <!ENTITY % $ID.pfx "%$ID.prefix;:">  <!ENTITY % $ID.pfx "%$ID.prefix;:">
466  ]]>  ]]>
467  <!ENTITY % $ID.pfx "">  <!ENTITY % $ID.pfx "">
468    
469  <!-- declare qualified name extensions here -->  <!-- declare qualified name extensions here ............ -->
470  <!ENTITY % ${ID}-qname-extra.mod "">  <!ENTITY % ${ID}-qname-extra.mod "">
471  %${ID}-qname-extra.mod;  %${ID}-qname-extra.mod;
472    
473  <!-- 5. May be redeclared to contain any foreign namespace declaration  <!-- 5. The parameter entity %$ID.xmlns.extra.attrib; may be
474          attributes for namespaces embedded in XML. -->          redeclared to contain any foreign namespace declaration
475            attributes for namespaces embedded.  The default
476            is an empty string. -->
477  <!ENTITY % $ID.xmlns.extra.attrib "">  <!ENTITY % $ID.xmlns.extra.attrib "">
478    
479    <!-- The parameter entity %URI.datatype; should already be defined in
480         Datatype module. -->
481    <!ENTITY % URI.datatype; "CDATA">
482    
483  <![%$ID.prefixed;[  <![%$ID.prefixed;[
484  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
485          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">
# Line 405  sub qname_module ($$) { Line 487  sub qname_module ($$) {
487  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
488          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">
489    
490    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
491         XML Schema Instance attributes. -->
492    <!ENTITY % XSI.prefix "xsi">
493    
494    <!ENTITY % XSI.pfx "%XSI.prefix;:">
495    
496    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
497    
498    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
499         the schemaLocation attribute. -->
500    <!ENTITY % XSI.xmlns.attrib
501            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
502    
503  <![%$ID.prefixed;[  <![%$ID.prefixed;[
504  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
505          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
506          %$ID.xmlns.extra.attrib;">          %$ID.xmlns.extra.attrib;
507            %XSI.xmlns.attrib;">
508  ]]>  ]]>
509  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
510          "%$ID.xmlns.extra.attrib;">          "%$ID.xmlns.extra.attrib;
511            %XSI.xmlns.attrib;">
512    
513  <!-- Declare a parameter entity containing all XML namespace declaration  <!-- Declare a parameter entity containing all XML namespace declaration
514       attributes used, including a default xmlns declaration when prefixing       attributes used, including a default xmlns declaration when prefixing
# Line 424  sub qname_module ($$) { Line 521  sub qname_module ($$) {
521          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
522          %NS.decl.attrib;">          %NS.decl.attrib;">
523    
524  <!-- 6. Declare parameter entities used to provide namespace-qualified  <!-- @{[dot_padding qq(Section B: $Info->{realname} Qualified Names ),
525          names for all element types and global attribute names. -->                 length => 71-9, dot => q(:)]} -->
526    
527    <!-- placeholder for qualified name redeclarations -->
528    <!ENTITY % ${ID}-qname.redecl "">
529    %${ID}-qname.redecl;
530    
531    <!-- 6. This section declare parameter entities used to provide
532            namespace-qualified names for all element types and global
533            attribute names. -->
534  EOH  EOH
535    for my $lname (keys %{$Info->{QName}}) {    for my $lname (sort keys %{$Info->{QName}}) {
536      $s .= qq(<!ENTITY % $Info->{ID}.$lname.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
537           .  (dot_padding qq($Info->{ID}.$lname.qname),
538                           length => 15 + length ($Info->{ID}), dot => ' ')
539           .  qq( "%$Info->{ID}.pfx;$lname">\n);
540    }    }
541    $s .= qq(\n);    $s .= qq(\n);
542    for my $lname (keys %{$Info->{QNameA}}) {    for my $lname (sort keys %{$Info->{QNameA}}) {
543      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attrib.qname "%$Info->{ID}.prefix;:$lname">\n);      $s .= qq(<!ENTITY % )
544           .  (dot_padding qq($Info->{ID}.$lname.attrib.qname),
545                           length => 15 + length ($Info->{ID}), dot => ' ')
546           .  qq( "%$Info->{ID}.prefix;:$lname">\n);
547    }    }
548    $s .= qq(\n);    $s .= qq(\n);
549    for my $lname (keys %{$Info->{QNameB}}) {    for my $lname (sort keys %{$Info->{QNameB}}) {
550      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attribute.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
551           .  (dot_padding qq($Info->{ID}.$lname.attribute.qname),
552                           length => 15 + length ($Info->{ID}), dot => ' ')
553           .  qq( "%$Info->{ID}.pfx;$lname">\n);
554    }    }
555    make_module ($src, $Info, 'qname', $s);    make_module ($src->get_attribute ('QName', make_new_node => 1), $Info, 'qname', $s);
556  }  }
557    
558  sub get_name ($$;$) {  sub get_name ($$;$) {
# Line 498  sub get_adefault ($$) { Line 612  sub get_adefault ($$) {
612    $name;    $name;
613  }  }
614    
615  sub get_desc ($$) {  sub get_desc ($$;%) {
616    my ($src, $Info) = @_;    my ($src, $Info, %opt) = @_;
617        my $desc = $src->get_attribute_value ('Description');    my $desc = $src->get_attribute_value ('Description');
618        $desc =~ s/\n/\n     /g;    $desc =~ s/\n/\n     /g;
619        $desc = qq(<!-- $desc -->\n) if $desc;    if (length $desc) {
620        $desc = qq($opt{prefix}$desc);
621        $desc .= q( ) if $opt{padding_length};
622        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
623                                             dot => $opt{padding_dot}).qq( -->\n);
624      } elsif (length $opt{default}) {
625        $desc = $opt{default};
626        $desc .= q( ) if $opt{padding_length};
627        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
628                                             dot => $opt{padding_dot}).qq( -->\n);
629      }
630    $desc;    $desc;
631  }  }
632    
# Line 581  sub attrib_REF ($$) { Line 705  sub attrib_REF ($$) {
705      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,
706      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,
707      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,
708        'xsi:nil'   => q<%XSI.prefix;:nil (true|false|1|0) #IMPLIED>,
709        'xsi:noNamespaceSchemaLocation'     => q<%XSI.prefix;:noNamespaceSchemaLocation CDATA #IMPLIED>,
710        'xsi:schemaLocation'        => q<%XSI.prefix;:schemaLocation CDATA #IMPLIED>,
711        'xsi:type'  => q<%XSI.prefix;:type NMTOKEN #IMPLIED>,
712    }->{$src->value};    }->{$src->value};
713  }  }
714    
715  sub submodule ($$) {  sub submodule ($$) {
716    my ($src, $Info) = @_;    my ($src, $Info) = @_;
717      local $Info->{elements} = [];
718    my $s = submodule_declarations ($src, $Info);    my $s = submodule_declarations ($src, $Info);
719    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);
720  }  }
# Line 607  sub submodule_declarations ($$) { Line 736  sub submodule_declarations ($$) {
736      } elsif ($src->local_name eq 'IfModuleSet') {      } elsif ($src->local_name eq 'IfModuleSet') {
737        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);
738        $s .= submodule_declarations ($src, $Info);        $s .= submodule_declarations ($src, $Info);
739        $s .= qq(]]>\n);        $s .= qq(<!-- end of  -->]]>\n);
740      } elsif ($src->local_name eq 'ElementSwitch') {      } elsif ($src->local_name eq 'ElementSwitch') {
741        $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.element "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);        $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.element "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
742      } elsif ($src->local_name eq 'AttributeSwitch') {      } elsif ($src->local_name eq 'AttributeSwitch') {
# Line 632  sub element_def ($$) { Line 761  sub element_def ($$) {
761    my ($src, $Info) = @_;    my ($src, $Info) = @_;
762    my $name = get_name ($src, $Info);    my $name = get_name ($src, $Info);
763    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);
764    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    my $short_name = $name;
765    my $s = <<EOH;    if ($name =~ /^\Q$Info->{ID}\E\.(.+)/) {
766  @{[get_desc ($src, $Info)]}<!ENTITY % $mname.element "INCLUDE">      $Info->{QName}->{$1} = 1;
767  <![%$mname.element;[      push @{$Info->{elements}}, $1;
768  <!ENTITY % $name.content @{[paralit convert_content_model ($src, $Info, default => 'EMPTY')]}>      $short_name = $1;
769  <!ELEMENT %$name.qname; %$name.content;>    }
770  ]]>    my $s = get_desc $src, $Info, prefix => qq($short_name: ),
771  EOH                     padding_length => 51, padding_dot => q(.),
772                       default => qq($short_name);
773      $s .= "\n";
774      $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';
775      $s .= xml_condition_section (qq($mname.element) =>
776                xml_parameter_ENTITY
777                  (qq($name.content),
778                   value => convert_content_model ($src, $Info, default => 'EMPTY'))
779              . xml_parameter_ENTITY (qq($name.qname), value => $short_name)
780              . qq(<!ELEMENT %$name.qname; %$name.content;>\n));
781      $s .= "\n";
782    $s .= attlist_def (scalar $src->get_attribute ('Attribute', make_new_node => 1), $Info, $mname);    $s .= attlist_def (scalar $src->get_attribute ('Attribute', make_new_node => 1), $Info, $mname);
783    $s;    $s;
784  }  }
# Line 669  sub attlist_def ($$;$) { Line 808  sub attlist_def ($$;$) {
808    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))
809      if $mname eq "$Info->{ID}.";      if $mname eq "$Info->{ID}.";
810    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;
811    my $s = qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">    my $s = qq(<!ATTLIST %$name.qname;);
 <![%$mname.attlist;[  
 <!ATTLIST %$name.qname;);  
812    for my $src (@{$src->child_nodes}) {    for my $src (@{$src->child_nodes}) {
813      ## Attribute Definition      ## Attribute Definition
814      if ($src->local_name eq 'Attribute') {      if ($src->local_name eq 'Attribute') {
# Line 686  sub attlist_def ($$;$) { Line 823  sub attlist_def ($$;$) {
823    if ($_[2]) {    if ($_[2]) {
824      $s .= qq(\n\t%$Info->{ID}.common.attrib;);      $s .= qq(\n\t%$Info->{ID}.common.attrib;);
825    }    }
826    $s .= qq(>    $s .= qq(>\n);
827  ]]>      qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">\n)
828      . xml_condition_section (qq($mname.attlist) => $s)
829  );    . "\n";
   $s;  
830  }  }
831    
832  sub make_module ($$$$) {  sub make_module ($$$$;%) {
833    my ($src, $Info, $id, $s) = @_;    my ($src, $Info, $id, $s, %opt) = @_;
834    my $name = $src->get_attribute_value ('Name')    my $name = $src->get_attribute_value ('Name')
835            || {attribs  => q/Common Attributes/,            || {arch     => q/Base Architecture/,
836                  attribs  => q/Common Attributes/,
837                  blkphras => q/Block Phrasal/,
838                  blkpres  => q/Block Presentation/,
839                  blkstruct => q/Block Structural/,
840                  charent  => q/Character Entities/,
841                datatype => q/Datatypes/,                datatype => q/Datatypes/,
842                  framework => q/Modular Framework/,
843                  inlphras => q/Inline Phrasal/,
844                  inlpres  => q/Inline Presentation/,
845                  inlstruct => q/Inline Structural/,
846                  legacy   => q/Legacy Markup/,
847                  list     => q/Lists/,
848                  meta     => q/Metainformation/,
849                model    => q/Document Model/,                model    => q/Document Model/,
850                qname    => q/QName/,                notations => q/Notations/,
851                struct   => q/Structual/,                pres     => q/Presentation/,
852                  qname    => q/QName (Qualified Name)/,
853                  struct   => q/Document Structure/,
854                  text     => q/Text/,
855               }->{$id}               }->{$id}
856            || $id;            || $id;
857    return unless $s;    return unless $s;
858        
859    my $r = <<EOH;    my $r = <<EOH;
860  <!-- $Info->{Name} : $name Module  <!-- ...................................................................... -->
861    <!-- @{[do{
862           my $s = qq($Info->{Name} $name Module );
863           if (70 - length $s > 0) {
864             $s = dot_padding $s, length => 70, dot => q(.);
865           } else {
866             $s = qq(        $name Module );
867             $s = qq($Info->{Name}\n     ) . dot_padding $s, length => 70, dot => q(.);
868           }
869           $s;
870         }]} -->
871    <!-- file: $Info->{ID}-$id.mod
872        
873    @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
874        
875         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
876        
877         Permission to use, copy, modify and distribute this DTD and its
878         accompanying documentation for any purpose and without fee is hereby
879         granted in perpetuity, provided that the above copyright notice and
880         this paragraph appear in all copies.  The copyright holders make no
881         representation about the suitability of the DTD for any purpose.
882        
883         It is provided "as is" without expressed or implied warranty.
884            
      Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}  
885       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
886                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
887                   ]} (Generated by $SCRIPT_NAME/$VERSION)
888        
889         This DTD module is identified by the SYSTEM identifier:
890            
891       SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"         SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"
892    -->      
893         ...................................................................... -->
894    
895    EOH
896      ## TODO: Support PUBLIC identifier.
897        
898      ## Module description
899      my @para = ({
900                  arch     => (join "\n",
901                    q!This optional module includes declarations that enable to be used!,
902                    q!as a base architecture according to the 'Architectural Forms Definition!,
903                    q!Requirements' (Annex A.3, ISO/IEC 10744, 2nd edition). For more!,
904                    q!information on use of architectural forms, see the HyTime web site at!,
905                    q!<http://www.hytime.org/>.!),
906                  attribs  => q/This module declares many of the common attributes./,
907                  blkphras => qq/This module declares the element types and their attributes used\n/.
908                              q/to support block-level phrasal markup./,
909                  blkpres  => qq/This module declares the element types and their attributes used\n/.
910                              q/to support block-level presentational markup./,
911                  blkstruct => qq/This module declares the element types and their attributes used\n/.
912                              q/to support block-level structural markup./,
913                  charent  => q/This module declares the set of character entities./,
914                  datatype => q/This module defines containers for the datatypes./,
915                  framework => qq/This module imstantiates the modules needed to support\n/.
916                               q/the modularization model./,
917                  inlphras => qq/This module declares the element types and their attributes used\n/.
918                              q/to support inline phrasal markup./,
919                  inlpres  => qq/This module declares the element types and their attributes used\n/.
920                              q/to support inline presentational markup./,
921                  inlstruct => qq/This module declares the element types and their attributes used\n/.
922                              q/to support inline structural markup./,
923                  legacy   => q/This module declares additional markup that is considered obsolete./,
924                  list     => qq/This module declares the list-oriented element types\n/.
925                              q/and their attributes./,
926                  meta     => qq/This module declares the element types and their attributes\n/.
927                              q/to support metainformation markup./,
928                  model    => qq/This model describes the groupings of element types that\n/.
929                              q/make up common content models./,
930                  pres     => qq/This module declares the element types and their attributes used\n/.
931                              q/to support presentational markup./,
932                  qname    => (join "\n",
933                    q!This module is contained in two parts, labeled Section 'A' and 'B':!,
934                    q!!,
935                    q!  Section A declares parameter entities to support namespace-qualified!,
936                    q!  names, namespace declarations, and name prefixing.!,
937                    q!!,
938                    q!  Section B declares parameter entities used to provide namespace-qualified!,
939                    q!  names for all element types and global attribute names.!),
940                  struct   => qq/This module defines the major structural element types and\n/.
941                              q/their attributes./,
942                  }->{$id}, $src->get_attribute_value ('Description'));
943      unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};
944      if (@para) {
945        $name = qq($Info->{realname} QName (Qualified Name) Module)
946          if $id eq 'qname';
947        $r .= <<EOH;
948    <!-- $name
949    
950    @{[make_paragraphs \@para, indent => '     ']}
951    -->
952    
953  EOH  EOH
954      }
955        
956    $r .= $s;    $r .= $s;
957        
# Line 733  sub make_dtd ($$$$) { Line 969  sub make_dtd ($$$$) {
969    $id = "-$id" if $id;    $id = "-$id" if $id;
970        
971    my $r = <<EOH;    my $r = <<EOH;
972  <!-- $Info->{Name} : Document Type Definition  <!-- ....................................................................... -->
973        <!-- @{[ dot_padding "$Info->{Name} DTD ", length => 71, dot => q(.) ]} -->
974       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}  <!-- file: $Info->{ID}.dtd
975       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  -->
976                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}  
977        <!-- $Info->{Name} DTD
978    
979    @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
980    
981         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
982    
983         Permission to use, copy, modify and distribute this DTD and its
984         accompanying documentation for any purpose and without fee is hereby
985         granted in perpetuity, provided that the above copyright notice and
986         this paragraph appear in all copies.  The copyright holders make no
987         representation about the suitability of the DTD for any purpose.
988    
989         It is provided "as is" without expressed or implied warranty.
990    
991           Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
992                                (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}
993    
994    -->
995    <!-- This is the driver file for the $Info->{Name} DTD.
996    
997         This DTD is identified by the SYSTEM identifier:
998    
999       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"
1000    -->  -->
1001      
1002  EOH  EOH
1003        
1004    $r .= $s;    $r .= $s;
# Line 758  EOH Line 1015  EOH
1015    
1016  =head1 NAME  =head1 NAME
1017    
1018  mkdtds.pl --- Moduralized XML Document Type Definition Generator  mkdtds.pl - Modularized XML Document Type Definition (DTD) Generator
1019    
1020  =head1 DESCRIPTION  =head1 DESCRIPTION
1021    
1022  This script can be used to generate XML DTD modules and driver  This script generates XML DTD module implementations and/or DTD drivers,
1023  which is interoperable with XHTML DTD modules.  that can be used with modularized XHTML DTDs.
1024    
1025  =head1 USAGE  =head1 USAGE
1026    
# Line 780  which is interoperable with XHTML DTD mo Line 1037  which is interoperable with XHTML DTD mo
1037    
1038  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))
1039    
1040  =head1 REQUIRED MODULE  =head1 REQUIRED MODULES
1041    
1042  This script uses SuikaWiki::Markup::SuikaWikiConfig20 and  This script uses C<Message::Markup::SuikaWikiConfig20::Node> and
1043  SuikaWiki::Markup::SuikaWikiConfig20::Parser.  C<Message::Markup::SuikaWikiConfig20::Parser>.  Please retrive it from
1044  Please get it from <http://suika.fam.cx/gate/cvs/suikawiki/script/lib/>  <http://suika.fam.cx/gate/cvs/messaging/manakai/lib/Message/Markup/SuikaWikiConfig20/>
1045  and put into your lib directory.  and put into your C<lib> directory.
1046    
1047  =head1 AUTHOR  =head1 AUTHOR
1048    
# Line 793  Wakaba <w@suika.fam.cx> Line 1050  Wakaba <w@suika.fam.cx>
1050    
1051  =head1 LICENSE  =head1 LICENSE
1052    
1053  Copyright 2003 Wakaba <w@suika.fam.cx>  Copyright 2003-2004 Wakaba <w@suika.fam.cx>
1054    
1055  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
1056  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
1057    
1058  Note that author claims no right about DTD modules generated by this script.  Note that author claims no copyright with regard to DTD modules/drivers generated
1059  Author(s) of DTD modules should be explicily state their license terms.  by this script.  Author(s) of DTD modules/drivers should explicily state their
1060    license terms in them and their documentation (if any).
1061    
1062  =cut  =cut

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24