/[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.3 by wakaba, Tue Jan 13 11:17:20 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/ID Copyright BaseURI Description Version/) {
15      $Info->{$_} = $src->get_attribute_value ($_);      $Info->{$_} = $src->get_attribute_value ($_);
16    }    }
17    $Info->{Name} = $src->get_attribute_value ('Name')    $Info->{Name} = $src->get_attribute_value ('Name');
18               .' '.$src->get_attribute_value ('Version');    $Info->{Name} .= ' ' . $Info->{Version} if length $Info->{Version};
19    $Info->{ns} = $src->get_attribute ('Namespace');    $Info->{ns} = $src->get_attribute ('Namespace');
20  }  }
21    
# Line 27  for (@{$src->child_nodes}) { Line 30  for (@{$src->child_nodes}) {
30      submodule ($_, $Info);      submodule ($_, $Info);
31    } elsif ($_->local_name eq 'Model') {    } elsif ($_->local_name eq 'Model') {
32      model_module ($_, $Info);      model_module ($_, $Info);
33        $Info->{has_model} = 1;
34    } elsif ($_->local_name eq 'Driver') {    } elsif ($_->local_name eq 'Driver') {
35      dtd_driver ($_, $Info);      dtd_driver ($_, $Info);
36    }    }
# Line 37  if (ref $src->get_attribute ('ModuleSet' Line 41  if (ref $src->get_attribute ('ModuleSet'
41  }  }
42  exit}  exit}
43    
44    
45    sub make_paragraphs ($;%) {
46      my ($para, %opt) = @_;
47      join "\n\n", map {
48        my $s = $_;
49        $s =~ s/\n+$//g;
50        $s =~ s/\n/\n$opt{indent}/g;
51        $opt{indent}.$s;
52      } grep {length} @$para;
53    }
54    
55    sub dot_padding ($%) {
56      my ($s, %opt) = @_;
57      if ($opt{length} - length $s > 0) {
58        return $s . ( ($opt{dot} or q(.)) x ($opt{length} - length $s) );
59      } else {
60        return $s;
61      }
62    }
63    
64  sub submodule_id_of ($$;%) {  sub submodule_id_of ($$;%) {
65    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
66    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 75  sub xml_datatype_of ($$;%) {
75    $type =~ s/\s+//g;    $type =~ s/\s+//g;
76    $type;    $type;
77  }  }
78    sub system_id_of ($$;%) {
79      my ($src, $Info, %opt) = @_;
80      my $sysid = $src->get_attribute_value ('SYSTEM');
81      if ($sysid =~ /<([^>]+)>/) {
82        return $1;
83      } else {
84        return $opt{base}.($sysid || $opt{default});
85      }
86    }
87  sub external_id_of ($$;%) {  sub external_id_of ($$;%) {
88    my ($src, $Info, %opt) = @_;    my ($src, $Info, %opt) = @_;
89    my $sysid = $opt{base}.($src->get_attribute_value ('SYSTEM') || $opt{default});    my $sysid = system_id_of ($src, $Info, %opt);
90    my $pubid = $src->get_attribute_value ('PUBLIC');    my $pubid = $src->get_attribute_value ('PUBLIC');
91    if ($pubid) {    if ($pubid) {
92      if ($sysid) {      if ($sysid) {
# Line 115  sub convert_content_model ($$;%) { Line 148  sub convert_content_model ($$;%) {
148    $model =~ s/(?<![%#.])((?:\$|\b)$nonsymbol+(?::$nonsymbol+)?|\$?:$nonsymbol+|"[^"]+")/get_model_token ($1, $Info)/ge;    $model =~ s/(?<![%#.])((?:\$|\b)$nonsymbol+(?::$nonsymbol+)?|\$?:$nonsymbol+|"[^"]+")/get_model_token ($1, $Info)/ge;
149    $model;    $model;
150  }  }
151    sub sparalit ($) {
152      my $s = paralit (shift);
153      $s =~ s/&/&#x26;/g;
154      $s =~ s/%/&#x25;/g;
155      $s;
156    }
157  sub paralit ($) {  sub paralit ($) {
158    my $s = shift;    my $s = shift;
159    if ($s =~ /"/) {    if ($s =~ /"/) {
# Line 145  sub description ($$;%) { Line 184  sub description ($$;%) {
184    $desc = qq(<!-- $desc -->\n) if $desc;    $desc = qq(<!-- $desc -->\n) if $desc;
185    $desc;    $desc;
186  }  }
187    sub xml_condition_section ($$;%) {
188      my ($condition, $content, %opt) = @_;
189        qq(<![%$condition;[\n)
190      . $content
191      . qq(<!-- end of $condition -->]]>\n);
192    }
193    sub xml_parameter_ENTITY ($%) {
194      my ($name, %opt) = @_;
195      qq(<!ENTITY % $name @{[paralit $opt{value}]}>\n);
196    }
197    
198    sub entity_declaration ($$;%) {
199      my ($src, $Info, %opt) = @_;
200      my $val;
201      if ($src->get_attribute_value ('ID')
202       || $src->get_attribute_value ('SYSTEM')
203       || $src->get_attribute_value ('PUBLIC')) {
204        $val = "\n\t".external_id_of ($src, $Info, default => $src->get_attribute_value ('ID'));
205      } elsif (ref $src->get_attribute ('Declaration')) {
206        $val = "\n\t".sparalit submodule_declarations ($src->get_attribute ('Declaration'), $Info);
207      } else {
208        $val = paralit $src->get_attribute_value ('EntityValue');
209      }
210      my $s = <<EOH;
211    @{[description ($src, $Info)]}<!ENTITY @{[$opt{param}?'% ':'']}@{[$src->get_attribute_value ('Name')]} $val>
212    
213    EOH
214      $s;
215    }
216    
217  sub dtd_driver ($$) {  sub dtd_driver ($$) {
218    my ($src, $Info) = @_;    my ($src, $Info) = @_;
# Line 155  sub dtd_driver ($$) { Line 222  sub dtd_driver ($$) {
222    for my $src (@{$src->child_nodes}) {    for my $src (@{$src->child_nodes}) {
223      if ($src->local_name eq 'Module') {      if ($src->local_name eq 'Module') {
224        $s .= dtd_driver_load_module ($src, $Info);        $s .= dtd_driver_load_module ($src, $Info);
225        } elsif ($src->local_name eq 'DTD') {
226          $s .= dtd_driver_load_dtd ($src, $Info);
227      } elsif ($src->local_name eq 'ModuleSet') {      } elsif ($src->local_name eq 'ModuleSet') {
228        push @module_set, $src;        push @module_set, $src;
229      } elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) {      } elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) {
# Line 164  sub dtd_driver ($$) { Line 233  sub dtd_driver ($$) {
233        $s .= submodule_declarations ($src, $Info);        $s .= submodule_declarations ($src, $Info);
234        $s .= qq(]]>\n);        $s .= qq(]]>\n);
235      } elsif ($src->local_name eq 'GeneralEntity') {      } elsif ($src->local_name eq 'GeneralEntity') {
236        $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);
237      } elsif ($src->local_name eq 'ParameterEntity') {      } elsif ($src->local_name eq 'ParameterEntity') {
238        $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);
239      }      }
240    }    }
241        
242    $s{ModelModule} = <<EOH;    $s{ModelModule} = $src->get_attribute_value ('NoModelModule') ? '' :
243        $Info->{has_model} ? <<EOH : '';
244  <!-- Document Model module -->  <!-- Document Model module -->
245  <!ENTITY % $Info->{ID}-model.module "INCLUDE">  <!ENTITY % $Info->{ID}-model.module "INCLUDE">
246  <![%$Info->{ID}-model.module;[  <![%$Info->{ID}-model.module;[
# Line 248  sub dtd_driver_load_module ($$) { Line 318  sub dtd_driver_load_module ($$) {
318        
319    my $s .= <<EOH;    my $s .= <<EOH;
320  @{[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;[
321  <!ENTITY % $module_name.module "INCLUDE">  <!ENTITY % $module_name.module "@{[$src->get_attribute_value ('Default') >= 0 ? 'INCLUDE' : 'IGNORE']}">
322  <![%$module_name.module;[  <![%$module_name.module;[
323  @{[submodule_declarations ($src, $Info)]}<!ENTITY % $module_name.decl  @{[submodule_declarations ($src, $Info)]}<!ENTITY % $module_name.decl
324          @{[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 329  sub dtd_driver_load_module ($$) {
329  EOH  EOH
330    $s;    $s;
331  }  }
332    
333    sub dtd_driver_load_dtd ($$) {
334      my ($src, $Info) = @_;
335      my $module_set_name = $src->get_attribute_value ('ID');
336      
337      my $s .= <<EOH;
338    @{[description ($src, $Info)]}<![%$module_set_name.module;[
339    @{[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;))]}">
340    @{[do{
341      my $pubid = $src->get_attribute_value ('PUBLIC');
342      if ($pubid) {
343        qq(<!ENTITY % $module_set_name.dtd.fpi "$pubid">\n<!ENTITY % $module_set_name.dtd.fpi.defined "INCLUDE">\n);
344      } else {
345        qq(<!ENTITY % $module_set_name.dtd.fpi "">\n<!ENTITY % $module_set_name.dtd.fpi.defined "IGNORE">\n);
346      }
347    }]}
348    <![%$module_set_name.dtd.fpi.defined;[
349    <!ENTITY % $module_set_name.dtd.decl
350            'PUBLIC "%$module_set_name.dtd.fpi;"
351                   "%$module_set_name.dtd.sysid;"'>
352    ]]>
353    <!ENTITY % $module_set_name.dtd.decl
354            'SYSTEM "%$module_set_name.dtd.sysid;"'>
355    <!ENTITY % $module_set_name.dtd %$module_set_name.dtd.decl;>
356    %$module_set_name.dtd;]]>
357    
358    EOH
359      $s;
360    }
361    
362  sub model_module ($$) {  sub model_module ($$) {
363    my ($src, $Info) = @_;    my ($src, $Info) = @_;
364      my $s = '';      my $s = '';
365      for my $src (@{$src->child_nodes}) {      for my $src (@{$src->child_nodes}) {
366        if ($src->local_name eq 'Class') {        if ($src->local_name eq 'Class') {
367          $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);
368        } elsif ($src->local_name eq 'Content') {        } elsif ($src->local_name eq 'Content') {
369          $s .= element_content_def ($src, $Info);          $s .= element_content_def ($src, $Info);
370        }        }
# Line 301  sub qname_module ($$) { Line 401  sub qname_module ($$) {
401    my $s = <<EOH;    my $s = <<EOH;
402  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
403                              q(INCLUDE):q(IGNORE)]}">                              q(INCLUDE):q(IGNORE)]}">
404    
405    <!-- Section A: XML Namespace Framework :::::::::::::::::::::::::: -->
406    
407    <!-- 1. Declare conditional section keyword, used to activate namespace
408            prefixing. -->
409  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?  <!ENTITY % $ID.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
410                              q(INCLUDE):                              q(INCLUDE):
411                              $ns->get_attribute_value ('UsePrefix')==-1?                              $ns->get_attribute_value ('UsePrefix')==-1?
412                              q(IGNORE):                              q(IGNORE):
413                              q(%NS.prefixed;)]}">                              q(%NS.prefixed;)]}">
414    
415    <!-- 2. Declare a parameter entity containing the namespace name. -->
416  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">  <!ENTITY % $ID.xmlns "@{[$ns->get_attribute_value ('Name')]}">
417    
418    <!-- 3. Declare parameter entities containing the default namespace prefix
419            string to use when prefixing is enabled. -->
420  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">  <!ENTITY % $ID.prefix "@{[$ns->get_attribute_value ('DefaultPrefix')]}">
421    
422    <!-- 4. Declare parameter entities containing the colonized prefix
423            used when prefixing is active, an empty string when it is not. -->
424  <![%$ID.prefixed;[  <![%$ID.prefixed;[
425  <!ENTITY % $ID.pfx "%$ID.prefix;:">  <!ENTITY % $ID.pfx "%$ID.prefix;:">
426  ]]>  ]]>
427  <!ENTITY % $ID.pfx "">  <!ENTITY % $ID.pfx "">
428    
429    <!-- declare qualified name extensions here -->
430    <!ENTITY % ${ID}-qname-extra.mod "">
431    %${ID}-qname-extra.mod;
432    
433    <!-- 5. This parameter entity may be redeclared to contain any foreign
434            namespace declaration attributes for namespaces embedded. -->
435  <!ENTITY % $ID.xmlns.extra.attrib "">  <!ENTITY % $ID.xmlns.extra.attrib "">
436    
437  <![%$ID.prefixed;[  <![%$ID.prefixed;[
# Line 329  sub qname_module ($$) { Line 449  sub qname_module ($$) {
449  <!ENTITY % NS.decl.attrib  <!ENTITY % NS.decl.attrib
450          "%$ID.xmlns.extra.attrib;">          "%$ID.xmlns.extra.attrib;">
451    
452    <!-- Declare a parameter entity containing all XML namespace declaration
453         attributes used, including a default xmlns declaration when prefixing
454         is inactive. -->
455  <![%$ID.prefixed;[  <![%$ID.prefixed;[
456  <!ENTITY % $ID.xmlns.attrib  <!ENTITY % $ID.xmlns.attrib
457          "%NS.decl.attrib;">          "%NS.decl.attrib;">
# Line 337  sub qname_module ($$) { Line 460  sub qname_module ($$) {
460          "%$ID.xmlns.decl.attrib;          "%$ID.xmlns.decl.attrib;
461          %NS.decl.attrib;">          %NS.decl.attrib;">
462    
463    <!-- Section B: Qualified Names :::::::::::::::::::::::::::::::::: -->
464    
465    <!-- placeholder for qualified name redeclarations -->
466    <!ENTITY % ${ID}-qname-extra.mod "">
467    %${ID}-qname-extra.mod;
468    
469    <!-- 6. Declare parameter entities used to provide namespace-qualified
470            names for all element types and global attribute names. -->
471  EOH  EOH
472    for my $lname (keys %{$Info->{QName}}) {    for my $lname (sort keys %{$Info->{QName}}) {
473      $s .= qq(<!ENTITY % $Info->{ID}.$lname.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
474           .  (dot_padding qq($Info->{ID}.$lname.qname),
475                           length => 15 + length ($Info->{ID}), dot => ' ')
476           .  qq( "%$Info->{ID}.pfx;$lname">\n);
477    }    }
478    $s .= qq(\n);    $s .= qq(\n);
479    for my $lname (keys %{$Info->{QNameA}}) {    for my $lname (sort keys %{$Info->{QNameA}}) {
480      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attrib.qname "%$Info->{ID}.prefix;:$lname">\n);      $s .= qq(<!ENTITY % )
481           .  (dot_padding qq($Info->{ID}.$lname.attrib.qname),
482                           length => 15 + length ($Info->{ID}), dot => ' ')
483           .  qq( "%$Info->{ID}.prefix;:$lname">\n);
484    }    }
485    $s .= qq(\n);    $s .= qq(\n);
486    for my $lname (keys %{$Info->{QNameB}}) {    for my $lname (sort keys %{$Info->{QNameB}}) {
487      $s .= qq(<!ENTITY % $Info->{ID}.$lname.attribute.qname "%$Info->{ID}.pfx;$lname">\n);      $s .= qq(<!ENTITY % )
488           .  (dot_padding qq($Info->{ID}.$lname.attribute.qname),
489                           length => 15 + length ($Info->{ID}), dot => ' ')
490           .  qq( "%$Info->{ID}.pfx;$lname">\n);
491    }    }
492    make_module ($src, $Info, 'qname', $s);    make_module ($src->get_attribute ('QName', make_new_node => 1), $Info, 'qname', $s);
493  }  }
494    
495  sub get_name ($$;$) {  sub get_name ($$;$) {
# Line 409  sub get_adefault ($$) { Line 549  sub get_adefault ($$) {
549    $name;    $name;
550  }  }
551    
552  sub get_desc ($$) {  sub get_desc ($$;%) {
553    my ($src, $Info) = @_;    my ($src, $Info, %opt) = @_;
554        my $desc = $src->get_attribute_value ('Description');        my $desc = $src->get_attribute_value ('Description');
555        $desc =~ s/\n/\n     /g;        $desc =~ s/\n/\n     /g;
556        $desc = qq(<!-- $desc -->\n) if $desc;    if (length $desc) {
557        $desc = qq($opt{prefix}$desc);
558        $desc .= q( ) if $opt{padding_length};
559        $desc = q(<!-- ).(dot_padding $desc, length => $opt{padding_length},
560                                             dot => $opt{padding_dot}).qq( -->\n);
561      }
562    $desc;    $desc;
563  }  }
564    
# Line 497  sub attrib_REF ($$) { Line 642  sub attrib_REF ($$) {
642    
643  sub submodule ($$) {  sub submodule ($$) {
644    my ($src, $Info) = @_;    my ($src, $Info) = @_;
645      local $Info->{elements} = [];
646    my $s = submodule_declarations ($src, $Info);    my $s = submodule_declarations ($src, $Info);
647    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);    make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);
648  }  }
# Line 511  sub submodule_declarations ($$) { Line 657  sub submodule_declarations ($$) {
657        $s .= attlist_def ($src, $Info);        $s .= attlist_def ($src, $Info);
658      } elsif ($src->local_name eq 'AttributeSet') {      } elsif ($src->local_name eq 'AttributeSet') {
659        $s .= attset_def ($src, $Info);        $s .= attset_def ($src, $Info);
660        } elsif ($src->local_name eq 'Class') {
661          $s .= qq(@{[description ($src, $Info)]}<!ENTITY % @{[class_name_of ($src, $Info)]} @{[paralit convert_content_model ($src, $Info)]}>\n\n);
662      } elsif ($src->local_name eq 'Content') {      } elsif ($src->local_name eq 'Content') {
663        $s .= element_content_def ($src, $Info);        $s .= element_content_def ($src, $Info);
664      } elsif ($src->local_name eq 'IfModuleSet') {      } elsif ($src->local_name eq 'IfModuleSet') {
665        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);        $s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);
666        $s .= submodule_declarations ($src, $Info);        $s .= submodule_declarations ($src, $Info);
667        $s .= qq(]]>\n);        $s .= qq(<!-- end of  -->]]>\n);
668      } elsif ($src->local_name eq 'ElementSwitch') {      } elsif ($src->local_name eq 'ElementSwitch') {
669        $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);
670      } elsif ($src->local_name eq 'AttributeSwitch') {      } elsif ($src->local_name eq 'AttributeSwitch') {
671        $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);
672        } elsif ($src->local_name eq 'ModuleSwitch') {
673          $s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.module "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
674        } elsif ($src->local_name eq 'GeneralEntity') {
675          $s .= entity_declaration ($src, $Info, param => 0);
676      } elsif ($src->local_name eq 'ParameterEntity') {      } elsif ($src->local_name eq 'ParameterEntity') {
677        $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);
678      }      }
679    }    }
680    $s;    $s;
# Line 537  sub element_def ($$) { Line 689  sub element_def ($$) {
689    my ($src, $Info) = @_;    my ($src, $Info) = @_;
690    my $name = get_name ($src, $Info);    my $name = get_name ($src, $Info);
691    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);    my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);
692    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    my $short_name = $name;
693    my $s = <<EOH;    if ($name =~ /^\Q$Info->{ID}\E\.(.+)/) {
694  @{[get_desc ($src, $Info)]}<!ENTITY % $mname.element "INCLUDE">      $Info->{QName}->{$1} = 1;
695  <![%$mname.element;[      push @{$Info->{elements}}, $1;
696  <!ENTITY % $name.content @{[paralit convert_content_model ($src, $Info, default => 'EMPTY')]}>      $short_name = $1;
697  <!ELEMENT %$name.qname; %$name.content;>    }
698  ]]>    my $s = get_desc $src, $Info, prefix => qq($short_name: ),
699  EOH                     padding_length => 51, padding_dot => q(.);
700      $s .= "\n";
701      $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE';
702      $s .= xml_condition_section (qq($mname.element) =>
703                xml_parameter_ENTITY
704                  (qq($name.content),
705                   value => convert_content_model ($src, $Info, default => 'EMPTY'))
706              . xml_parameter_ENTITY (qq($name.qname), value => $short_name)
707              . qq(<!ELEMENT %$name.qname; %$name.content;>\n));
708      $s .= "\n";
709    $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);
710    $s;    $s;
711  }  }
# Line 574  sub attlist_def ($$;$) { Line 735  sub attlist_def ($$;$) {
735    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))    $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))
736      if $mname eq "$Info->{ID}.";      if $mname eq "$Info->{ID}.";
737    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;    $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;
738    my $s = qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">    my $s = qq(<!ATTLIST %$name.qname;);
 <![%$mname.attlist;[  
 <!ATTLIST %$name.qname;);  
739    for my $src (@{$src->child_nodes}) {    for my $src (@{$src->child_nodes}) {
740      ## Attribute Definition      ## Attribute Definition
741      if ($src->local_name eq 'Attribute') {      if ($src->local_name eq 'Attribute') {
# Line 591  sub attlist_def ($$;$) { Line 750  sub attlist_def ($$;$) {
750    if ($_[2]) {    if ($_[2]) {
751      $s .= qq(\n\t%$Info->{ID}.common.attrib;);      $s .= qq(\n\t%$Info->{ID}.common.attrib;);
752    }    }
753    $s .= qq(>    $s .= qq(>\n);
754  ]]>      qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">\n)
755      . xml_condition_section (qq($mname.attlist) => $s)
756  );    . "\n";
   $s;  
757  }  }
758    
759  sub make_module ($$$$) {  sub make_module ($$$$;%) {
760    my ($src, $Info, $id, $s) = @_;    my ($src, $Info, $id, $s, %opt) = @_;
761    my $name = $src->get_attribute_value ('Name')    my $name = $src->get_attribute_value ('Name')
762            || {attribs  => q/Common Attributes/,            || {arch     => q/Base Architecture/,
763                  attribs  => q/Common Attributes/,
764                  blkphras => q/Block Phrasal/,
765                  blkpres  => q/Block Presentation/,
766                  blkstruct => q/Block Structural/,
767                  charent  => q/Character Entities/,
768                datatype => q/Datatypes/,                datatype => q/Datatypes/,
769                  framework => q/Modular Framework/,
770                  inlphras => q/Inline Phrasal/,
771                  inlpres  => q/Inline Presentation/,
772                  inlstruct => q/Inline Structural/,
773                  legacy   => q/Legacy Markup/,
774                  list     => q/Lists/,
775                  meta     => q/Metainformation/,
776                model    => q/Document Model/,                model    => q/Document Model/,
777                qname    => q/QName/,                notations => q/Notations/,
778                struct   => q/Structual/,                pres     => q/Presentation/,
779                  qname    => q/QName (Qualified Name)/,
780                  struct   => q/Document Structure/,
781                  text     => q/Text/,
782               }->{$id}               }->{$id}
783            || $id;            || $id;
784      return unless $s;
785        
786    my $r = <<EOH;    my $r = <<EOH;
787  <!-- $Info->{Name} : $name Module  <!-- ...................................................................... -->
788    <!-- @{[do{
789           my $s = qq($Info->{Name} $name Module );
790           if (70 - length $s > 0) {
791             $s = dot_padding $s, length => 70, dot => q(.);
792           } else {
793             $s = qq(        $name Module );
794             $s = qq($Info->{Name}\n     ) . dot_padding $s, length => 70, dot => q(.);
795           }
796           $s;
797         }]} -->
798    <!-- file: $Info->{ID}-$id.mod
799            
800       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}       $Info->{Description}
801         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
802       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
803                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
804                   ]} (Generated by $SCRIPT_NAME/$VERSION)
805        
806         This DTD module is identified by the SYSTEM identifier:
807            
808       SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"         SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"
809    -->      
810         ...................................................................... -->
811    
812    EOH
813      ## TODO: Support PUBLIC identifier.
814        
815      ## Module description
816      my @para = ({
817                  arch     => (join "\n",
818                    q!This optional module includes declarations that enable to be used!,
819                    q!as a base architecture according to the 'Architectural Forms Definition!,
820                    q!Requirements' (Annex A.3, ISO/IEC 10744, 2nd edition). For more!,
821                    q!information on use of architectural forms, see the HyTime web site at!,
822                    q!<http://www.hytime.org/>.!),
823                  attribs  => q/This module declares many of the common attributes./,
824                  blkphras => qq/This module declares the element types and their attributes used\n/.
825                              q/to support block-level phrasal markup./,
826                  blkpres  => qq/This module declares the element types and their attributes used\n/.
827                              q/to support block-level presentational markup./,
828                  blkstruct => qq/This module declares the element types and their attributes used\n/.
829                              q/to support block-level structural markup./,
830                  charent  => q/This module declares the set of character entities./,
831                  datatype => q/This module defines containers for the datatypes./,
832                  framework => qq/This module imstantiates the modules needed to support\n/.
833                               q/the modularization model./,
834                  inlphras => qq/This module declares the element types and their attributes used\n/.
835                              q/to support inline phrasal markup./,
836                  inlpres  => qq/This module declares the element types and their attributes used\n/.
837                              q/to support inline presentational markup./,
838                  inlstruct => qq/This module declares the element types and their attributes used\n/.
839                              q/to support inline structural markup./,
840                  legacy   => q/This module declares additional markup that is considered obsolete./,
841                  list     => qq/This module declares the list-oriented element types\n/.
842                              q/and their attributes./,
843                  meta     => qq/This module declares the element types and their attributes\n/.
844                              q/to support metainformation markup./,
845                  model    => qq/This model describes the groupings of element types that\n/.
846                              q/make up common content models./,
847                  pres     => qq/This module declares the element types and their attributes used\n/.
848                              q/to support presentational markup./,
849                  qname    => (join "\n",
850                    q!This module is contained in two parts, labeled Section 'A' and 'B':!,
851                    q!!,
852                    q!  Section A declares parameter entities to support namespace-qualified!,
853                    q!  names, namespace declarations, and name prefixing.!,
854                    q!!,
855                    q!  Section B declares parameter entities used to provide namespace-qualified!,
856                    q!  names for all element types and global attribute names.!),
857                  struct   => qq/This module defines the major structural element types and\n/.
858                              q/their attributes./,
859                  }->{$id}, $src->get_attribute_value ('Description'));
860      unshift @para, '  '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]};
861      if (@para) {
862        $r .= <<EOH;
863    <!-- $name
864    
865    @{[make_paragraphs \@para, indent => '     ']}
866    -->
867    
868  EOH  EOH
869      }
870        
871    $r .= $s;    $r .= $s;
872        
# Line 637  sub make_dtd ($$$$) { Line 884  sub make_dtd ($$$$) {
884    $id = "-$id" if $id;    $id = "-$id" if $id;
885        
886    my $r = <<EOH;    my $r = <<EOH;
887  <!-- $Info->{Name} : Document Type Definition  <!-- ....................................................................... -->
888        <!-- @{[ dot_padding "$Info->{Name} DTD ", length => 71, dot => q(.) ]} -->
889       Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}  <!-- file: $Info->{ID}.dtd
890       Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',  -->
891                            (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}  
892        <!-- $Info->{Name} DTD
893    
894         $Info->{Description}
895    
896         Copyright @{[(gmtime)[5]+1900]} $Info->{Copyright}, All Rights Reserved.
897    
898         Permission to use, copy, modify and distribute this DTD and its
899         accompanying documentation for any purpose and without fee is hereby
900         granted in perpetuity, provided that the above copyright notice and
901         this paragraph appear in all copies.  The copyright holders make no
902         representation about the suitability of the DTD for any purpose.
903    
904         It is provided "as is" without expressed or implied warranty.
905    
906           Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
907                                (gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]]}
908    
909    -->
910    <!-- This is the driver file for the $Info->{Name} DTD.
911    
912         This DTD is identified by the SYSTEM identifier:
913    
914       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"       SYSTEM "$Info->{BaseURI}$Info->{ID}$id.dtd"
915    -->  -->
916      
917  EOH  EOH
918        
919    $r .= $s;    $r .= $s;
# Line 662  EOH Line 930  EOH
930    
931  =head1 NAME  =head1 NAME
932    
933  mkdtds.pl --- Moduralized XML Document Type Definition Generator  mkdtds.pl - Modularized XML Document Type Definition (DTD) Generator
934    
935  =head1 DESCRIPTION  =head1 DESCRIPTION
936    
937  This script can be used to generate XML DTD modules and driver  This script generates XML DTD module implementations and/or DTD drivers,
938  which is interoperable with XHTML DTD modules.  that can be used with modularized XHTML DTDs.
939    
940  =head1 USAGE  =head1 USAGE
941    
# Line 684  which is interoperable with XHTML DTD mo Line 952  which is interoperable with XHTML DTD mo
952    
953  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))  (((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))
954    
955  =head1 REQUIRED MODULE  =head1 REQUIRED MODULES
956    
957  This script uses SuikaWiki::Markup::SuikaWikiConfig20 and  This script uses C<Message::Markup::SuikaWikiConfig20::Node> and
958  SuikaWiki::Markup::SuikaWikiConfig20::Parser.  C<Message::Markup::SuikaWikiConfig20::Parser>.  Please retrive it from
959  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/>
960  and put into your lib directory.  and put into your C<lib> directory.
961    
962  =head1 AUTHOR  =head1 AUTHOR
963    
# Line 697  Wakaba <w@suika.fam.cx> Line 965  Wakaba <w@suika.fam.cx>
965    
966  =head1 LICENSE  =head1 LICENSE
967    
968  Copyright 2003 Wakaba <w@suika.fam.cx>  Copyright 2003-2004 Wakaba <w@suika.fam.cx>
969    
970  This program is free software; you can redistribute it and/or  This program is free software; you can redistribute it and/or
971  modify it under the same terms as Perl itself.  modify it under the same terms as Perl itself.
972    
973  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
974  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
975    license terms in them and their documentation (if any).
976    
977  =cut  =cut
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24