/[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.1 by wakaba, Fri Oct 24 11:21:28 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 27  for (@{$src->child_nodes}) { Line 33  for (@{$src->child_nodes}) {
33      submodule ($_, $Info);      submodule ($_, $Info);
34    } elsif ($_->local_name eq 'Model') {    } elsif ($_->local_name eq 'Model') {
35      model_module ($_, $Info);      model_module ($_, $Info);
36        $Info->{has_model} = 1;
37    } elsif ($_->local_name eq 'Driver') {    } elsif ($_->local_name eq 'Driver') {
38      dtd_driver ($_, $Info);      dtd_driver ($_, $Info);
39    }    }
# Line 37  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 51  sub xml_datatype_of ($$;%) { Line 84  sub xml_datatype_of ($$;%) {
84    $type =~ s/\s+//g;    $type =~ s/\s+//g;
85    $type;    $type;
86  }  }
87    sub system_id_of ($$;%) {
88      my ($src, $Info, %opt) = @_;
89      my $sysid = $src->get_attribute_value ('SYSTEM');
90      if ($sysid =~ /<([^>]+)>/) {
91        return $1;
92      } else {
93        return $opt{base}.($sysid || $opt{default});
94      }
95    }
96  sub external_id_of ($$;%) {  sub external_id_of ($$;%) {
97    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
98    my $sysid = $opt{base}.($src->get_attribute_value ('SYSTEM') || $opt{default});    my $sysid = system_id_of ($src, $Info, %opt);
99    my $pubid = $src->get_attribute_value ('PUBLIC');    my $pubid = $src->get_attribute_value ('PUBLIC');
100    if ($pubid) {    if ($pubid) {
101      if ($sysid) {      if ($sysid) {
# Line 115  sub convert_content_model ($$;%) { Line 157  sub convert_content_model ($$;%) {
157    $model =~ s/(?<![%#.])((?:\$|\b)$nonsymbol+(?::$nonsymbol+)?|\$?:$nonsymbol+|"[^"]+")/get_model_token ($1, $Info)/ge;    $model =~ s/(?<![%#.])((?:\$|\b)$nonsymbol+(?::$nonsymbol+)?|\$?:$nonsymbol+|"[^"]+")/get_model_token ($1, $Info)/ge;
158    $model;    $model;
159  }  }
160    sub sparalit ($) {
161      my $s = paralit (shift);
162      $s =~ s/&/&#x26;/g;
163      $s =~ s/%/&#x25;/g;
164      $s;
165    }
166  sub paralit ($) {  sub paralit ($) {
167    my $s = shift;    my $s = shift;
168    if ($s =~ /"/) {    if ($s =~ /"/) {
# Line 145  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 ($$;%) {
208      my ($src, $Info, %opt) = @_;
209      my $val;
210      if ($src->get_attribute_value ('ID')
211       || $src->get_attribute_value ('SYSTEM')
212       || $src->get_attribute_value ('PUBLIC')) {
213        $val = "\n\t".external_id_of ($src, $Info, default => $src->get_attribute_value ('ID'));
214      } elsif (ref $src->get_attribute ('Declaration')) {
215        $val = "\n\t".sparalit submodule_declarations ($src->get_attribute ('Declaration'), $Info);
216      } else {
217        $val = paralit $src->get_attribute_value ('EntityValue');
218      }
219      my $s = <<EOH;
220    @{[description ($src, $Info)]}<!ENTITY @{[$opt{param}?'% ':'']}@{[$src->get_attribute_value ('Name')]} $val>
221    
222    EOH
223      $s;
224    }
225    
226  sub dtd_driver ($$) {  sub dtd_driver ($$) {
227    my ($src, $Info) = @_;    my ($src, $Info) = @_;
# Line 155  sub dtd_driver ($$) { Line 231  sub dtd_driver ($$) {
231    for my $src (@{$src->child_nodes}) {    for my $src (@{$src->child_nodes}) {
232      if ($src->local_name eq 'Module') {      if ($src->local_name eq 'Module') {
233        $s .= dtd_driver_load_module ($src, $Info);        $s .= dtd_driver_load_module ($src, $Info);
234        } elsif ($src->local_name eq 'DTD') {
235          $s .= dtd_driver_load_dtd ($src, $Info);
236      } elsif ($src->local_name eq 'ModuleSet') {      } elsif ($src->local_name eq 'ModuleSet') {
237        push @module_set, $src;        push @module_set, $src;
238      } elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) {      } elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) {
# Line 164  sub dtd_driver ($$) { Line 242  sub dtd_driver ($$) {
242        $s .= submodule_declarations ($src, $Info);        $s .= submodule_declarations ($src, $Info);
243        $s .= qq(]]>\n);        $s .= qq(]]>\n);
244      } elsif ($src->local_name eq 'GeneralEntity') {      } elsif ($src->local_name eq 'GeneralEntity') {
245        $s .= qq(@{[description ($src, $Info)]}<!ENTITY @{[$src->get_attribute_value ('Name')]} @{[paralit $src->get_attribute_value ('EntityValue')]}>\n\n);        $s .= entity_declaration ($src, $Info, param => 0);
246      } elsif ($src->local_name eq 'ParameterEntity') {      } elsif ($src->local_name eq 'ParameterEntity') {
247        $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[$src->get_attribute_value ('Name')]} @{[paralit $src->get_attribute_value ('EntityValue')]}>\n\n);        $s .= entity_declaration ($src, $Info, param => 1);
248      }      }
249    }    }
250        
251    $s{ModelModule} = <<EOH;    $s{ModelModule} = $src->get_attribute_value ('NoModelModule') ? '' :
252        $Info->{has_model} ? <<EOH : '';
253  <!-- Document Model module -->  <!-- Document Model module -->
254  <!ENTITY % $Info->{ID}-model.module "INCLUDE">  <!ENTITY % $Info->{ID}-model.module "INCLUDE">
255  <![%$Info->{ID}-model.module;[  <![%$Info->{ID}-model.module;[
# Line 228  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 248  sub dtd_driver_load_module ($$) { Line 342  sub dtd_driver_load_module ($$) {
342        
343    my $s .= <<EOH;    my $s .= <<EOH;
344  @{[description ($src, $Info, context => 'load_module', id => $src->local_name)]}<![%$module_set_name.module;[  @{[description ($src, $Info, context => 'load_module', id => $src->local_name)]}<![%$module_set_name.module;[
345  <!ENTITY % $module_name.module "INCLUDE">  <!ENTITY % $module_name.module "@{[$src->get_attribute_value ('Default') >= 0 ? 'INCLUDE' : 'IGNORE']}">
346  <![%$module_name.module;[  <![%$module_name.module;[
347  @{[submodule_declarations ($src, $Info)]}<!ENTITY % $module_name.decl  @{[submodule_declarations ($src, $Info)]}<!ENTITY % $module_name.decl
348          @{[paralit external_id_of ($src, $Info, default => qq($module_hyphen_name.mod), base => qq(%$module_set_name.sysid.base;))]}>          @{[paralit external_id_of ($src, $Info, default => qq($module_hyphen_name.mod), base => qq(%$module_set_name.sysid.base;))]}>
# Line 259  sub dtd_driver_load_module ($$) { Line 353  sub dtd_driver_load_module ($$) {
353  EOH  EOH
354    $s;    $s;
355  }  }
356    
357    sub dtd_driver_load_dtd ($$) {
358      my ($src, $Info) = @_;
359      my $module_set_name = $src->get_attribute_value ('ID');
360      
361      my $s .= <<EOH;
362    @{[description ($src, $Info)]}<![%$module_set_name.module;[
363    @{[submodule_declarations ($src, $Info)]}<!ENTITY % $module_set_name.dtd.sysid "@{[system_id_of ($src, $Info, default => $src->get_attribute_value ('ID').'.dtd', base => qq(%$module_set_name.sysid.base;))]}">
364    @{[do{
365      my $pubid = $src->get_attribute_value ('PUBLIC');
366      if ($pubid) {
367        qq(<!ENTITY % $module_set_name.dtd.fpi "$pubid">\n<!ENTITY % $module_set_name.dtd.fpi.defined "INCLUDE">\n);
368      } else {
369        qq(<!ENTITY % $module_set_name.dtd.fpi "">\n<!ENTITY % $module_set_name.dtd.fpi.defined "IGNORE">\n);
370      }
371    }]}
372    <![%$module_set_name.dtd.fpi.defined;[
373    <!ENTITY % $module_set_name.dtd.decl
374            'PUBLIC "%$module_set_name.dtd.fpi;"
375                   "%$module_set_name.dtd.sysid;"'>
376    ]]>
377    <!ENTITY % $module_set_name.dtd.decl
378            'SYSTEM "%$module_set_name.dtd.sysid;"'>
379    <!ENTITY % $module_set_name.dtd %$module_set_name.dtd.decl;>
380    %$module_set_name.dtd;]]>
381    
382    EOH
383      $s;
384    }
385    
386  sub model_module ($$) {  sub model_module ($$) {
387    my ($src, $Info) = @_;    my ($src, $Info) = @_;
388      my $s = '';      my $s = '';
389      for my $src (@{$src->child_nodes}) {      for my $src (@{$src->child_nodes}) {
390        if ($src->local_name eq 'Class') {        if ($src->local_name eq 'Class') {
391          $s .= qq(@{[get_desc ($src, $Info)]}<!ENTITY % @{[class_name_of ($src, $Info)]} @{[paralit convert_content_model ($src, $Info)]}>\n\n);          $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[class_name_of ($src, $Info)]} @{[paralit convert_content_model ($src, $Info)]}>\n\n);
392        } elsif ($src->local_name eq 'Content') {        } elsif ($src->local_name eq 'Content') {
393          $s .= element_content_def ($src, $Info);          $s .= element_content_def ($src, $Info);
394        }        }
# Line 301  sub qname_module ($$) { Line 425  sub qname_module ($$) {
425    my $s = <<EOH;    my $s = <<EOH;
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    <!-- 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    <!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 entity %$ID.prefix; containing
452            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 entity %$ID.pfx; containing the
462            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 ............ -->
470    <!ENTITY % ${ID}-qname-extra.mod "">
471    %${ID}-qname-extra.mod;
472    
473    <!-- 5. The parameter entity %$ID.xmlns.extra.attrib; may be
474            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 321  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
514         attributes used, including a default xmlns declaration when prefixing
515         is inactive. -->
516  <![%$ID.prefixed;[  <![%$ID.prefixed;[
517  <!ENTITY % $ID.xmlns.attrib  <!ENTITY % $ID.xmlns.attrib
518          "%NS.decl.attrib;">          "%NS.decl.attrib;">
# Line 337  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    <!-- @{[dot_padding qq(Section B: $Info->{realname} Qualified Names ),
525                   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 409  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 492  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 511  sub submodule_declarations ($$) { Line 729  sub submodule_declarations ($$) {
729        $s .= attlist_def ($src, $Info);        $s .= attlist_def ($src, $Info);
730      } elsif ($src->local_name eq 'AttributeSet') {      } elsif ($src->local_name eq 'AttributeSet') {
731        $s .= attset_def ($src, $Info);        $s .= attset_def ($src, $Info);
732        } elsif ($src->local_name eq 'Class') {
733          $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[class_name_of ($src, $Info)]} @{[paralit convert_content_model ($src, $Info)]}>\n\n);
734      } elsif ($src->local_name eq 'Content') {      } elsif ($src->local_name eq 'Content') {
735        $s .= element_content_def ($src, $Info);        $s .= element_content_def ($src, $Info);
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') {
743        $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.attlist "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);        $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.attlist "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
744        } elsif ($src->local_name eq 'ModuleSwitch') {
745          $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.module "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
746        } elsif ($src->local_name eq 'GeneralEntity') {
747          $s .= entity_declaration ($src, $Info, param => 0);
748      } elsif ($src->local_name eq 'ParameterEntity') {      } elsif ($src->local_name eq 'ParameterEntity') {
749        $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[$src->get_attribute_value ('Name')]} @{[paralit $src->get_attribute_value ('EntityValue')]}>\n);        $s .= entity_declaration ($src, $Info, param => 1);
750      }      }
751    }    }
752    $s;    $s;
# Line 537  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 574  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 591  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;
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       SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"       This DTD module is identified by the SYSTEM identifier:
890    -->      
891           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 637  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 662  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 684  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 697  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.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24