/[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.5 by wakaba, Sun Jun 20 05:16:45 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 299  sub qname_module ($$) { Line 423  sub qname_module ($$) {
423    my $ID = $Info->{ID};    my $ID = $Info->{ID};
424    my $ns = $src->get_attribute ('Namespace');    my $ns = $src->get_attribute ('Namespace');
425    my $s = <<EOH;    my $s = <<EOH;
426    <!ENTITY % sgml.tag.minimizable "IGNORE">
427    
428  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
429                              q(INCLUDE):q(IGNORE)]}">                              q(INCLUDE):q(IGNORE)]}">
430    
431    <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->
432    
433    <!-- 1. Declare a %$ID.prefixed; conditional section keyword, used
434            to activate namespace prefixing. -->
435  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
436                              q(INCLUDE):                              q(INCLUDE):
437                              $ns->get_attribute_value ('UsePrefix')==-1?                              $ns->get_attribute_value ('UsePrefix')==-1?
438                              q(IGNORE):                              q(IGNORE):
439                              q(%NS.prefixed;)]}">                              q(%NS.prefixed;)]}">
440    
441    <!ENTITY % $ID.global.attrs.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
442                                q(INCLUDE):
443                                $ns->get_attribute_value ('UsePrefix')==-1?
444                                q(IGNORE):
445                                q(%NS.prefixed;)]}">
446    
447    <!ENTITY % $ID.xsi.attrs "INCLUDE">
448    
449    <!-- 2. Declare a parameter entity %$ID.xmlns; containing
450            the URI reference used to identity the namespace. -->
451  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">
452    
453    <!-- 3. Declare parameter entity %$ID.prefix; containing
454            the default namespace prefix string to use when prefixing
455            is enabled. This may be overridden in the DTD driver or the
456            internal subset of a document instance.
457            
458            NOTE: As specified in XML Namespace speficications, the namespace
459            prefix serves as a proxy for the URI reference, and is not in itself
460            significant. -->
461  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">
462    
463    <!-- 4. Declare parameter entity %$ID.pfx; containing the
464            colonized prefix (e.g, '%$ID.prefix;:') used when
465            prefixing is active, an empty string when it is not. -->
466  <![%$ID.prefixed;[  <![%$ID.prefixed;[
467  <!ENTITY % $ID.pfx "%$ID.prefix;:">  <!ENTITY % $ID.pfx "%$ID.prefix;:">
468  ]]>  ]]>
469  <!ENTITY % $ID.pfx "">  <!ENTITY % $ID.pfx "">
470    
471    <!-- declare qualified name extensions here ............ -->
472    <!ENTITY % ${ID}-qname-extra.mod "">
473    %${ID}-qname-extra.mod;
474    
475    <!-- 5. The parameter entity %$ID.xmlns.extra.attrib; may be
476            redeclared to contain any foreign namespace declaration
477            attributes for namespaces embedded.  The default
478            is an empty string. -->
479  <!ENTITY % $ID.xmlns.extra.attrib "">  <!ENTITY % $ID.xmlns.extra.attrib "">
480    
481    <!-- The parameter entity %URI.datatype; should already be defined in
482         Datatype module. -->
483    <!ENTITY % URI.datatype; "CDATA">
484    
485  <![%$ID.prefixed;[  <![%$ID.prefixed;[
486  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
487          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns:%$ID.prefix;     %URI.datatype;  #FIXED '%$ID.xmlns;'">
# Line 321  sub qname_module ($$) { Line 489  sub qname_module ($$) {
489  <!ENTITY % $ID.xmlns.decl.attrib  <!ENTITY % $ID.xmlns.decl.attrib
490          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">          "xmlns  %URI.datatype;  #FIXED '%$ID.xmlns;'">
491    
492    <!-- Declare a parameter entity %XSI.prefix as a prefix to use for
493         XML Schema Instance attributes. -->
494    <!ENTITY % XSI.prefix "xsi">
495    
496    <!ENTITY % XSI.pfx "%XSI.prefix;:">
497    
498    <!ENTITY % XSI.xmlns "http://www.w3.org/2001/XMLSchema-instance">
499    
500    <!-- Declare a parameter entity %XSI.xmlns.attrib as support for
501         the schemaLocation attribute. -->
502    <!ENTITY % XSI.xmlns.attrib
503            "xmlns:%XSI.prefix;     %URI.datatype;  #FIXED '%XSI.xmlns;'">
504    
505  <![%$ID.prefixed;[  <![%$ID.prefixed;[
506  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
507          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
508          %$ID.xmlns.extra.attrib;">          %$ID.xmlns.extra.attrib;
509            %XSI.xmlns.attrib;">
510  ]]>  ]]>
511  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
512          "%$ID.xmlns.extra.attrib;">          "%$ID.xmlns.extra.attrib;
513            %XSI.xmlns.attrib;">
514    
515    <!-- Declare a parameter entity containing all XML namespace declaration
516         attributes used, including a default xmlns declaration when prefixing
517         is inactive. -->
518  <![%$ID.prefixed;[  <![%$ID.prefixed;[
519  <!ENTITY % $ID.xmlns.attrib  <!ENTITY % $ID.xmlns.attrib
520          "%NS.decl.attrib;">          "%NS.decl.attrib;">
# Line 337  sub qname_module ($$) { Line 523  sub qname_module ($$) {
523          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
524          %NS.decl.attrib;">          %NS.decl.attrib;">
525    
526    <!-- @{[dot_padding qq(Section B: $Info->{realname} Qualified Names ),
527                   length => 71-9, dot => q(:)]} -->
528    
529    <!-- placeholder for qualified name redeclarations -->
530    <!ENTITY % ${ID}-qname.redecl "">
531    %${ID}-qname.redecl;
532    
533    <!-- 6. This section declare parameter entities used to provide
534            namespace-qualified names for all element types and global
535            attribute names. -->
536  EOH  EOH
537    for my $lname (keys %{$Info->{QName}}) {    for my $lname (sort keys %{$Info->{QName}}) {
538      $s .= qq(<!ENTITY % $Info->{ID}.$lname.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
539           .  (dot_padding qq($Info->{ID}.$lname.qname),
540                           length => 15 + length ($Info->{ID}), dot => ' ')
541           .  qq( "%$Info->{ID}.pfx;$lname">\n);
542    }    }
543    $s .= qq(\n);    $s .= qq(\n);
544    for my $lname (keys %{$Info->{QNameA}}) {    for my $lname (sort keys %{$Info->{QNameA}}) {
545      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attrib.qname "%$Info->{ID}.prefix;:$lname">\n);      $s .= qq(<!ENTITY % )
546           .  (dot_padding qq($Info->{ID}.$lname.attrib.qname),
547                           length => 15 + length ($Info->{ID}), dot => ' ')
548           .  qq( "%$Info->{ID}.prefix;:$lname">\n);
549    }    }
550    $s .= qq(\n);    $s .= qq(\n);
551    for my $lname (keys %{$Info->{QNameB}}) {    for my $lname (sort keys %{$Info->{QNameB}}) {
552      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attribute.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
553           .  (dot_padding qq($Info->{ID}.$lname.attribute.qname),
554                           length => 15 + length ($Info->{ID}), dot => ' ')
555           .  qq( "%$Info->{ID}.pfx;$lname">\n);
556    }    }
557    make_module ($src, $Info, 'qname', $s);    make_module ($src->get_attribute ('QName', make_new_node => 1), $Info, 'qname', $s);
558  }  }
559    
560  sub get_name ($$;$) {  sub get_name ($$;$) {
# Line 409  sub get_adefault ($$) { Line 614  sub get_adefault ($$) {
614    $name;    $name;
615  }  }
616    
617  sub get_desc ($$) {  sub get_desc ($$;%) {
618    my ($src, $Info) = @_;    my ($src, $Info, %opt) = @_;
619        my $desc = $src->get_attribute_value ('Description');    my $desc = $src->get_attribute_value ('Description');
620        $desc =~ s/\n/\n     /g;    $desc =~ s/\n/\n     /g;
621        $desc = qq(<!-- $desc -->\n) if $desc;    if (length $desc) {
622        $desc = qq($opt{prefix}$desc);
623        $desc .= q( ) if $opt{padding_length};
624        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
625                                             dot => $opt{padding_dot}).qq( -->\n);
626      } elsif (length $opt{default}) {
627        $desc = $opt{default};
628        $desc .= q( ) if $opt{padding_length};
629        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
630                                             dot => $opt{padding_dot}).qq( -->\n);
631      }
632    $desc;    $desc;
633  }  }
634    
# Line 492  sub attrib_REF ($$) { Line 707  sub attrib_REF ($$) {
707      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,      'xml:base'  => q<xml:base   %URI.datatype;  #IMPLIED>,
708      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,      'xml:lang'  => q<xml:lang   %LanguageCode.datatype; #IMPLIED>,
709      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,      'xml:space' => q<xml:space  (default|preserve)      #IMPLIED>,
710        'xsi:nil'   => q<%XSI.prefix;:nil (true|false|1|0) #IMPLIED>,
711        'xsi:noNamespaceSchemaLocation'     => q<%XSI.prefix;:noNamespaceSchemaLocation CDATA #IMPLIED>,
712        'xsi:schemaLocation'        => q<%XSI.prefix;:schemaLocation CDATA #IMPLIED>,
713        'xsi:type'  => q<%XSI.prefix;:type NMTOKEN #IMPLIED>,
714    }->{$src->value};    }->{$src->value};
715  }  }
716    
717  sub submodule ($$) {  sub submodule ($$) {
718    my ($src, $Info) = @_;    my ($src, $Info) = @_;
719      local $Info->{elements} = [];
720    my $s = submodule_declarations ($src, $Info);    my $s = submodule_declarations ($src, $Info);
721    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);
722  }  }
# Line 511  sub submodule_declarations ($$) { Line 731  sub submodule_declarations ($$) {
731        $s .= attlist_def ($src, $Info);        $s .= attlist_def ($src, $Info);
732      } elsif ($src->local_name eq 'AttributeSet') {      } elsif ($src->local_name eq 'AttributeSet') {
733        $s .= attset_def ($src, $Info);        $s .= attset_def ($src, $Info);
734        } elsif ($src->local_name eq 'Class') {
735          $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[class_name_of ($src, $Info)]} @{[paralit convert_content_model ($src, $Info)]}>\n\n);
736      } elsif ($src->local_name eq 'Content') {      } elsif ($src->local_name eq 'Content') {
737        $s .= element_content_def ($src, $Info);        $s .= element_content_def ($src, $Info);
738      } elsif ($src->local_name eq 'IfModuleSet') {      } elsif ($src->local_name eq 'IfModuleSet') {
739        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);
740        $s .= submodule_declarations ($src, $Info);        $s .= submodule_declarations ($src, $Info);
741        $s .= qq(]]>\n);        $s .= qq(<!-- end of  -->]]>\n);
742      } elsif ($src->local_name eq 'ElementSwitch') {      } elsif ($src->local_name eq 'ElementSwitch') {
743        $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);
744      } elsif ($src->local_name eq 'AttributeSwitch') {      } elsif ($src->local_name eq 'AttributeSwitch') {
745        $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);
746        } elsif ($src->local_name eq 'ModuleSwitch') {
747          $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.module "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
748        } elsif ($src->local_name eq 'GeneralEntity') {
749          $s .= entity_declaration ($src, $Info, param => 0);
750      } elsif ($src->local_name eq 'ParameterEntity') {      } elsif ($src->local_name eq 'ParameterEntity') {
751        $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);
752      }      }
753    }    }
754    $s;    $s;
# Line 537  sub element_def ($$) { Line 763  sub element_def ($$) {
763    my ($src, $Info) = @_;    my ($src, $Info) = @_;
764    my $name = get_name ($src, $Info);    my $name = get_name ($src, $Info);
765    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);
766    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    my $short_name = $name;
767    my $s = <<EOH;    if ($name =~ /^\Q$Info->{ID}\E\.(.+)/) {
768  @{[get_desc ($src, $Info)]}<!ENTITY % $mname.element "INCLUDE">      $Info->{QName}->{$1} = 1;
769  <![%$mname.element;[      push @{$Info->{elements}}, $1;
770  <!ENTITY % $name.content @{[paralit convert_content_model ($src, $Info, default => 'EMPTY')]}>      $short_name = $1;
771  <!ELEMENT %$name.qname; %$name.content;>    }
772  ]]>    my $s = get_desc $src, $Info, prefix => qq($short_name: ),
773  EOH                     padding_length => 51, padding_dot => q(.),
774                       default => qq($short_name);
775      $s .= "\n";
776      $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';
777      my $cm = convert_content_model ($src, $Info, default => 'EMPTY');
778      $s .= xml_condition_section (qq($mname.element) =>
779                xml_parameter_ENTITY (qq($name.content), value => $cm)
780              . xml_parameter_ENTITY (qq($name.qname), value => $short_name)
781              . xml_parameter_ENTITY (qq($name.tagmin.start), value => q<->)
782              . xml_parameter_ENTITY (qq($name.tagmin.end), value => $cm eq 'EMPTY' ? q<o> : q<->)
783              . xml_condition_section (qq(sgml.tag.minimizable) =>
784                  xml_parameter_ENTITY (qq($name.tagmin),
785                                        value => qq"%$name.tagmin.start; %$name.tagmin.end;"))
786              . xml_parameter_ENTITY (qq($name.tagmin), value => q"")
787              . qq(<!ELEMENT %$name.qname; %$name.tagmin; %$name.content;>\n));
788      $s .= "\n";
789    $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);
790    $s;    $s;
791  }  }
# Line 574  sub attlist_def ($$;$) { Line 815  sub attlist_def ($$;$) {
815    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))
816      if $mname eq "$Info->{ID}.";      if $mname eq "$Info->{ID}.";
817    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;
818    my $s = qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">    my $s = qq(<!ATTLIST %$name.qname;);
 <![%$mname.attlist;[  
 <!ATTLIST %$name.qname;);  
819    for my $src (@{$src->child_nodes}) {    for my $src (@{$src->child_nodes}) {
820      ## Attribute Definition      ## Attribute Definition
821      if ($src->local_name eq 'Attribute') {      if ($src->local_name eq 'Attribute') {
# Line 591  sub attlist_def ($$;$) { Line 830  sub attlist_def ($$;$) {
830    if ($_[2]) {    if ($_[2]) {
831      $s .= qq(\n\t%$Info->{ID}.common.attrib;);      $s .= qq(\n\t%$Info->{ID}.common.attrib;);
832    }    }
833    $s .= qq(>    $s .= qq(>\n);
834  ]]>      qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">\n)
835      . xml_condition_section (qq($mname.attlist) => $s)
836  );    . "\n";
   $s;  
837  }  }
838    
839  sub make_module ($$$$) {  sub make_module ($$$$;%) {
840    my ($src, $Info, $id, $s) = @_;    my ($src, $Info, $id, $s, %opt) = @_;
841    my $name = $src->get_attribute_value ('Name')    my $name = $src->get_attribute_value ('Name')
842            || {attribs  => q/Common Attributes/,            || {arch     => q/Base Architecture/,
843                  attribs  => q/Common Attributes/,
844                  blkphras => q/Block Phrasal/,
845                  blkpres  => q/Block Presentation/,
846                  blkstruct => q/Block Structural/,
847                  charent  => q/Character Entities/,
848                datatype => q/Datatypes/,                datatype => q/Datatypes/,
849                  framework => q/Modular Framework/,
850                  inlphras => q/Inline Phrasal/,
851                  inlpres  => q/Inline Presentation/,
852                  inlstruct => q/Inline Structural/,
853                  legacy   => q/Legacy Markup/,
854                  list     => q/Lists/,
855                  meta     => q/Metainformation/,
856                model    => q/Document Model/,                model    => q/Document Model/,
857                qname    => q/QName/,                notations => q/Notations/,
858                struct   => q/Structual/,                pres     => q/Presentation/,
859                  qname    => q/QName (Qualified Name)/,
860                  struct   => q/Document Structure/,
861                  text     => q/Text/,
862               }->{$id}               }->{$id}
863            || $id;            || $id;
864      return unless $s;
865        
866    my $r = <<EOH;    my $r = <<EOH;
867  <!-- $Info->{Name} : $name Module  <!-- ...................................................................... -->
868    <!-- @{[do{
869           my $s = qq($Info->{Name} $name Module );
870           if (70 - length $s > 0) {
871             $s = dot_padding $s, length => 70, dot => q(.);
872           } else {
873             $s = qq(        $name Module );
874             $s = qq($Info->{Name}\n     ) . dot_padding $s, length => 70, dot => q(.);
875           }
876           $s;
877         }]} -->
878    <!-- file: $Info->{ID}-$id.mod
879        
880    @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
881        
882         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
883        
884         Permission to use, copy, modify and distribute this DTD and its
885         accompanying documentation for any purpose and without fee is hereby
886         granted in perpetuity, provided that the above copyright notice and
887         this paragraph appear in all copies.  The copyright holders make no
888         representation about the suitability of the DTD for any purpose.
889        
890         It is provided "as is" without expressed or implied warranty.
891            
      Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}  
892       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
893                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
894                   ]} (Generated by $SCRIPT_NAME/$VERSION)
895            
896       SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"       This DTD module is identified by the SYSTEM identifier:
897    -->      
898           SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"
899        
900         ...................................................................... -->
901    
902    EOH
903      ## TODO: Support PUBLIC identifier.
904        
905      ## Module description
906      my @para = ({
907                  arch     => (join "\n",
908                    q!This optional module includes declarations that enable to be used!,
909                    q!as a base architecture according to the 'Architectural Forms Definition!,
910                    q!Requirements' (Annex A.3, ISO/IEC 10744, 2nd edition). For more!,
911                    q!information on use of architectural forms, see the HyTime web site at!,
912                    q!<http://www.hytime.org/>.!),
913                  attribs  => q/This module declares many of the common attributes./,
914                  blkphras => qq/This module declares the element types and their attributes used\n/.
915                              q/to support block-level phrasal markup./,
916                  blkpres  => qq/This module declares the element types and their attributes used\n/.
917                              q/to support block-level presentational markup./,
918                  blkstruct => qq/This module declares the element types and their attributes used\n/.
919                              q/to support block-level structural markup./,
920                  charent  => q/This module declares the set of character entities./,
921                  datatype => q/This module defines containers for the datatypes./,
922                  framework => qq/This module imstantiates the modules needed to support\n/.
923                               q/the modularization model./,
924                  inlphras => qq/This module declares the element types and their attributes used\n/.
925                              q/to support inline phrasal markup./,
926                  inlpres  => qq/This module declares the element types and their attributes used\n/.
927                              q/to support inline presentational markup./,
928                  inlstruct => qq/This module declares the element types and their attributes used\n/.
929                              q/to support inline structural markup./,
930                  legacy   => q/This module declares additional markup that is considered obsolete./,
931                  list     => qq/This module declares the list-oriented element types\n/.
932                              q/and their attributes./,
933                  meta     => qq/This module declares the element types and their attributes\n/.
934                              q/to support metainformation markup./,
935                  model    => qq/This model describes the groupings of element types that\n/.
936                              q/make up common content models./,
937                  pres     => qq/This module declares the element types and their attributes used\n/.
938                              q/to support presentational markup./,
939                  qname    => (join "\n",
940                    q!This module is contained in two parts, labeled Section 'A' and 'B':!,
941                    q!!,
942                    q!  Section A declares parameter entities to support namespace-qualified!,
943                    q!  names, namespace declarations, and name prefixing.!,
944                    q!!,
945                    q!  Section B declares parameter entities used to provide namespace-qualified!,
946                    q!  names for all element types and global attribute names.!),
947                  struct   => qq/This module defines the major structural element types and\n/.
948                              q/their attributes./,
949                  }->{$id}, $src->get_attribute_value ('Description'));
950      unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};
951      if (@para) {
952        $name = qq($Info->{realname} QName (Qualified Name) Module)
953          if $id eq 'qname';
954        $r .= <<EOH;
955    <!-- $name
956    
957    @{[make_paragraphs \@para, indent => '     ']}
958    -->
959    
960  EOH  EOH
961      }
962        
963    $r .= $s;    $r .= $s;
964        
# Line 637  sub make_dtd ($$$$) { Line 976  sub make_dtd ($$$$) {
976    $id = "-$id" if $id;    $id = "-$id" if $id;
977        
978    my $r = <<EOH;    my $r = <<EOH;
979  <!-- $Info->{Name} : Document Type Definition  <!-- ....................................................................... -->
980        <!-- @{[ dot_padding "$Info->{Name} DTD ", length => 71, dot => q(.) ]} -->
981       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}  <!-- file: $Info->{ID}.dtd
982       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  -->
983                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}  
984        <!-- $Info->{Name} DTD
985    
986    @{[make_paragraphs [$Info->{Description}], indent => q<     >]}
987    
988         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
989    
990         Permission to use, copy, modify and distribute this DTD and its
991         accompanying documentation for any purpose and without fee is hereby
992         granted in perpetuity, provided that the above copyright notice and
993         this paragraph appear in all copies.  The copyright holders make no
994         representation about the suitability of the DTD for any purpose.
995    
996         It is provided "as is" without expressed or implied warranty.
997    
998           Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
999                                (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}
1000    
1001    -->
1002    <!-- This is the driver file for the $Info->{Name} DTD.
1003    
1004         This DTD is identified by the SYSTEM identifier:
1005    
1006       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"
1007    -->  -->
1008      
1009  EOH  EOH
1010        
1011    $r .= $s;    $r .= $s;
# Line 662  EOH Line 1022  EOH
1022    
1023  =head1 NAME  =head1 NAME
1024    
1025  mkdtds.pl --- Moduralized XML Document Type Definition Generator  mkdtds.pl - Modularized XML Document Type Definition (DTD) Generator
1026    
1027  =head1 DESCRIPTION  =head1 DESCRIPTION
1028    
1029  This script can be used to generate XML DTD modules and driver  This script generates XML DTD module implementations and/or DTD drivers,
1030  which is interoperable with XHTML DTD modules.  that can be used with modularized XHTML DTDs.
1031    
1032  =head1 USAGE  =head1 USAGE
1033    
# Line 684  which is interoperable with XHTML DTD mo Line 1044  which is interoperable with XHTML DTD mo
1044    
1045  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))
1046    
1047  =head1 REQUIRED MODULE  =head1 REQUIRED MODULES
1048    
1049  This script uses SuikaWiki::Markup::SuikaWikiConfig20 and  This script uses C<Message::Markup::SuikaWikiConfig20::Node> and
1050  SuikaWiki::Markup::SuikaWikiConfig20::Parser.  C<Message::Markup::SuikaWikiConfig20::Parser>.  Please retrive it from
1051  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/>
1052  and put into your lib directory.  and put into your C<lib> directory.
1053    
1054  =head1 AUTHOR  =head1 AUTHOR
1055    
# Line 697  Wakaba <w@suika.fam.cx> Line 1057  Wakaba <w@suika.fam.cx>
1057    
1058  =head1 LICENSE  =head1 LICENSE
1059    
1060  Copyright 2003 Wakaba <w@suika.fam.cx>  Copyright 2003-2004 Wakaba <w@suika.fam.cx>
1061    
1062  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
1063  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
1064    
1065  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
1066  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
1067    license terms in them and their documentation (if any).
1068    
1069  =cut  =cut
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24