1 |
#!/usr/bin/perl
|
2 |
use strict;
|
3 |
our $SCRIPT_NAME = 'mkdtds';
|
4 |
our $VERSION = do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
|
5 |
{require Message::Markup::SuikaWikiConfig20::Parser;
|
6 |
|
7 |
my $parser = new Message::Markup::SuikaWikiConfig20::Parser;
|
8 |
local $/ = undef;
|
9 |
my $src = $parser->parse_text (scalar <>);
|
10 |
my $Info = {};
|
11 |
|
12 |
for my $src ($src->get_attribute ('ModuleSet')
|
13 |
|| $src->get_attribute ('DocumentType')) {
|
14 |
for (qw/Description/) {
|
15 |
$Info->{$_} = $src->get_attribute_value ($_);
|
16 |
}
|
17 |
for (qw/Name ID Copyright BaseURI Version/) {
|
18 |
$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');
|
23 |
}
|
24 |
|
25 |
for (@{$src->child_nodes}) {
|
26 |
if ($_->local_name eq 'Attribute') {
|
27 |
attrib_module ($_, $Info);
|
28 |
} elsif ($_->local_name eq 'Datatype') {
|
29 |
datatype_module ($_, $Info);
|
30 |
} elsif ($_->local_name eq 'Notation') {
|
31 |
notation_module ($_, $Info);
|
32 |
} elsif ($_->local_name eq 'Module') {
|
33 |
submodule ($_, $Info);
|
34 |
} elsif ($_->local_name eq 'Model') {
|
35 |
model_module ($_, $Info);
|
36 |
$Info->{has_model} = 1;
|
37 |
} elsif ($_->local_name eq 'Driver') {
|
38 |
dtd_driver ($_, $Info);
|
39 |
}
|
40 |
}
|
41 |
|
42 |
if (ref $src->get_attribute ('ModuleSet')) {
|
43 |
qname_module ($src->get_attribute ('ModuleSet'), $Info);
|
44 |
}
|
45 |
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 ($$;%) {
|
74 |
my ($src, $Info, %opt) = @_;
|
75 |
my $id = $src->get_attribute_value ('ID') || $opt{default};
|
76 |
unless ($id) {
|
77 |
die "$0: Submodule identifier not specified";
|
78 |
}
|
79 |
$id;
|
80 |
}
|
81 |
sub xml_datatype_of ($$;%) {
|
82 |
my ($src, $Info, %opt) = @_;
|
83 |
my $type = $src->get_attribute_value ('XMLType') || $opt{default};
|
84 |
$type =~ s/\s+//g;
|
85 |
$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 ($$;%) {
|
97 |
my ($src, $Info, %opt) = @_;
|
98 |
my $sysid = system_id_of ($src, $Info, %opt);
|
99 |
my $pubid = $src->get_attribute_value ('PUBLIC');
|
100 |
if ($pubid) {
|
101 |
if ($sysid) {
|
102 |
return qq(PUBLIC "$pubid"\n\t "$sysid");
|
103 |
} else {
|
104 |
return qq(PUBLIC "$pubid");
|
105 |
}
|
106 |
} else {
|
107 |
return qq(SYSTEM "$sysid");
|
108 |
}
|
109 |
}
|
110 |
sub name_of ($$;%) {
|
111 |
my ($src, $Info, %opt) = @_;
|
112 |
unless (ref $src) {require Carp; Carp::croak ('$src undefined')}
|
113 |
my $name = $src->get_attribute_value ($opt{key} || 'Name');
|
114 |
if ($name =~ /^:(.+)/) { ## Global namespace
|
115 |
return $1;
|
116 |
} elsif ($name =~ /([^:]+):(.+)/) { ## Named space
|
117 |
return $1.($opt{delim}||'.').$2;
|
118 |
} else { ## Default namespace
|
119 |
return $Info->{ID}.($opt{delim}||'.').$name;
|
120 |
}
|
121 |
}
|
122 |
sub local_name_of ($$;%) {
|
123 |
my ($src, $Info, %opt) = @_;
|
124 |
my $name = $src->get_attribute_value ($opt{key} || 'Name');
|
125 |
if ($name =~ /^:(.+)/) { ## Global namespace
|
126 |
return $1;
|
127 |
} elsif ($name =~ /[^:]+:(.+)/) { ## Named space
|
128 |
return $1;
|
129 |
} else { ## Default namespace
|
130 |
return $name;
|
131 |
}
|
132 |
}
|
133 |
sub set_name_of ($$;%) {
|
134 |
my ($src, $Info, %opt) = @_;
|
135 |
my $name = $src->get_attribute_value ($opt{key} || 'Name');
|
136 |
if ($name =~ /^:.+/) { ## Global namespace
|
137 |
return 'XHTML';
|
138 |
} elsif ($name =~ /([^:]+):.+/) { ## Named space
|
139 |
return $1;
|
140 |
} else { ## Default namespace
|
141 |
return $Info->{ID};
|
142 |
}
|
143 |
}
|
144 |
sub class_name_of ($$;%) {
|
145 |
my ($src, $Info, %opt) = @_;
|
146 |
my $name = name_of ($src, $Info, %opt);
|
147 |
unless ($name =~ /\.(class|mix|content|datatype)$/) {
|
148 |
$name .= '.class';
|
149 |
}
|
150 |
$name;
|
151 |
}
|
152 |
sub convert_content_model ($$;%) {
|
153 |
my ($src, $Info, %opt) = @_;
|
154 |
my $model = $src->get_attribute_value ($opt{key} || 'Content') || $opt{default};
|
155 |
$model =~ s/\s//g;
|
156 |
my $nonsymbol = qr/[^%#?,\$;()+*|:]/;
|
157 |
$model =~ s/(?<![%#.])((?:\$|\b)$nonsymbol+(?::$nonsymbol+)?|\$?:$nonsymbol+|"[^"]+")/get_model_token ($1, $Info)/ge;
|
158 |
$model;
|
159 |
}
|
160 |
sub sparalit ($) {
|
161 |
my $s = paralit (shift);
|
162 |
$s =~ s/&/&/g;
|
163 |
$s =~ s/%/%/g;
|
164 |
$s;
|
165 |
}
|
166 |
sub paralit ($) {
|
167 |
my $s = shift;
|
168 |
if ($s =~ /"/) {
|
169 |
if ($s =~ /'/) {
|
170 |
$s =~ s/'/'/g;
|
171 |
return qq("$s");
|
172 |
} else {
|
173 |
return qq('$s');
|
174 |
}
|
175 |
} else {
|
176 |
return qq("$s");
|
177 |
}
|
178 |
}
|
179 |
sub description ($$;%) {
|
180 |
my ($src, $Info, %opt) = @_;
|
181 |
my $desc = $src->get_attribute_value ('Description');
|
182 |
$desc =~ s/\n/\n /g;
|
183 |
unless ($desc) {
|
184 |
$desc = {
|
185 |
load_module => {
|
186 |
AttributeModule => q/Common Attributes Module/,
|
187 |
DatatypeModule => q/Datatypes Module/,
|
188 |
NotationModule => q/Notation Module/,
|
189 |
QNameModule => q/QName Module/,
|
190 |
},
|
191 |
}->{$opt{context}}->{$opt{id} || $src->get_attribute_value ($opt{id_key}||'ID')};
|
192 |
}
|
193 |
$desc = qq(<!-- $desc -->\n) if $desc;
|
194 |
$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 ($$) {
|
227 |
my ($src, $Info) = @_;
|
228 |
my $s = '';
|
229 |
my %s;
|
230 |
my @module_set;
|
231 |
for my $src (@{$src->child_nodes}) {
|
232 |
if ($src->local_name eq 'Module') {
|
233 |
$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') {
|
237 |
push @module_set, $src;
|
238 |
} elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) {
|
239 |
$s{$src->local_name} .= dtd_driver_load_module ($src, $Info);
|
240 |
} elsif ($src->local_name eq 'IfModuleSet') {
|
241 |
$s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);
|
242 |
$s .= submodule_declarations ($src, $Info);
|
243 |
$s .= qq(]]>\n);
|
244 |
} elsif ($src->local_name eq 'GeneralEntity') {
|
245 |
$s .= entity_declaration ($src, $Info, param => 0);
|
246 |
} elsif ($src->local_name eq 'ParameterEntity') {
|
247 |
$s .= entity_declaration ($src, $Info, param => 1);
|
248 |
}
|
249 |
}
|
250 |
|
251 |
$s{ModelModule} = $src->get_attribute_value ('NoModelModule') ? '' :
|
252 |
$Info->{has_model} ? <<EOH : '';
|
253 |
<!-- Document Model module -->
|
254 |
<!ENTITY % $Info->{ID}-model.module "INCLUDE">
|
255 |
<![%$Info->{ID}-model.module;[
|
256 |
<!ENTITY % $Info->{ID}-model.decl
|
257 |
'SYSTEM "$Info->{ID}-model.mod"'>
|
258 |
<!ENTITY % $Info->{ID}-model.mod %$Info->{ID}-model.decl;>
|
259 |
%$Info->{ID}-model.mod;]]>
|
260 |
|
261 |
EOH
|
262 |
|
263 |
$s = dtd_driver_module_sets (\@module_set, $Info)
|
264 |
. $s{QNameModule}.$s{DatatypeModule}.$s{NotationModule}.$s{AttributeModule}
|
265 |
. $s{ModelModule}
|
266 |
.$s;
|
267 |
make_dtd ($src, $Info, $src->get_attribute_value ('ID'), $s);
|
268 |
}
|
269 |
|
270 |
sub dtd_driver_module_sets ($$) {
|
271 |
my ($srces, $Info) = @_;
|
272 |
my @src = map {{src => $_}} @$srces;
|
273 |
my $s = qq(<!-- Switchers to include/ignore each vocabulary -->\n);
|
274 |
for my $module_set (@src) {
|
275 |
$module_set->{ID} = $module_set->{src}->get_attribute_value ('ID') || 'XHTML';
|
276 |
$s .= qq(<!ENTITY % $module_set->{ID}.module "@{[$module_set->{src}->get_attribute_value ('Default') > 0 ? 'INCLUDE' : 'IGNORE']}">\n);
|
277 |
}
|
278 |
$s .= qq(\n<!-- Namespace names -->\n);
|
279 |
for my $module_set (@src) {
|
280 |
$module_set->{ns} = $module_set->{src}->get_attribute ('Namespace');
|
281 |
$s .= qq(<!ENTITY % $module_set->{ID}.xmlns "@{[$module_set->{ns}->get_attribute_value ('Name')]}">\n);
|
282 |
}
|
283 |
$s .= qq(\n<!-- Base URIs for the relavant DTD modules -->\n);
|
284 |
for my $module_set (@src) {
|
285 |
$s .= qq(<!ENTITY % $module_set->{ID}.sysid.base "@{[$module_set->{src}->get_attribute_value ('BaseURI')]}">\n);
|
286 |
}
|
287 |
$s .= qq(\n<!-- Namespace prefix -->\n);
|
288 |
$s .= qq(<!ENTITY % NS.prefixed "@{[$Info->{ns}->get_attribute_value ('UsePrefix') > 0 ? 'INCLUDE' : 'IGNORE']}">\n);
|
289 |
for my $module_set (@src) {
|
290 |
$s .= qq(<!ENTITY % $module_set->{ID}.prefix "@{[$module_set->{ns}->get_attribute_value ('DefaultPrefix')]}">\n);
|
291 |
$s .= qq(<!ENTITY % $module_set->{ID}.prefixed "@{[$module_set->{ns}->get_attribute_value ('UsePrefix') > 0 ? 'INCLUDE' : $module_set->{ns}->get_attribute_value ('UsePrefix') < 0 ? 'IGNORE' : '%NS.prefixed;']}">\n);
|
292 |
}
|
293 |
$s .= qq(\n<!-- a URI reference -->\n<!ENTITY % URI.datatype "CDATA">\n);
|
294 |
$s .= qq(\n<!-- Placefolders for foreign namespace declarations -->\n);
|
295 |
for my $module_set (@src) {
|
296 |
$s .= qq(<!ENTITY % $module_set->{ID}.xmlns.extra.attrib "">\n);
|
297 |
}
|
298 |
$s .= qq(\n<!-- Namespace declarations -->\n);
|
299 |
for my $module_set (@src) {
|
300 |
$s .= qq(<![%$module_set->{ID}.module;[
|
301 |
<![%$module_set->{ID}.prefixed;[
|
302 |
<!ENTITY % $module_set->{ID}.xmlns.decl.attrib
|
303 |
"xmlns:%$module_set->{ID}.prefix; %URI.datatype; #FIXED '%$module_set->{ID}.xmlns;'">
|
304 |
]]>
|
305 |
<!ENTITY % $module_set->{ID}.xmlns.decl.attrib
|
306 |
"xmlns %URI.datatype; #FIXED '%$module_set->{ID}.xmlns;'">
|
307 |
]]>
|
308 |
<!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
|
325 |
").join ("\n\t", (map {qq(%$_->{ID}.xmlns.decl.attrib;)} @src),
|
326 |
map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src)
|
327 |
.qq(\n\t%XSI.xmlns.attrib;">\n);
|
328 |
$s .= qq(\n);
|
329 |
for my $module_set (@src) {
|
330 |
$s .= qq(<!ENTITY % $module_set->{ID}.xmlns.attrib "%NS.decl.attrib;">\n);
|
331 |
}
|
332 |
$s .= qq(\n\n);
|
333 |
$s;
|
334 |
}
|
335 |
|
336 |
sub dtd_driver_load_module ($$) {
|
337 |
my ($src, $Info) = @_;
|
338 |
my $module_name = name_of ($src, $Info, key => 'ID');
|
339 |
my $module_hyphen_name = name_of ($src, $Info, key => 'ID', delim => '-');
|
340 |
my $module_set_name = set_name_of ($src, $Info, key => 'ID');
|
341 |
my $module_id = local_name_of ($src, $Info, key => 'ID');
|
342 |
|
343 |
my $s .= <<EOH;
|
344 |
@{[description ($src, $Info, context => 'load_module', id => $src->local_name)]}<![%$module_set_name.module;[
|
345 |
<!ENTITY % $module_name.module "@{[$src->get_attribute_value ('Default') >= 0 ? 'INCLUDE' : 'IGNORE']}">
|
346 |
<![%$module_name.module;[
|
347 |
@{[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;))]}>
|
349 |
<!ENTITY % $module_name.mod %$module_name.decl;>
|
350 |
%$module_name.mod;]]>
|
351 |
]]>
|
352 |
|
353 |
EOH
|
354 |
$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 ($$) {
|
387 |
my ($src, $Info) = @_;
|
388 |
my $s = '';
|
389 |
for my $src (@{$src->child_nodes}) {
|
390 |
if ($src->local_name eq 'Class') {
|
391 |
$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') {
|
393 |
$s .= element_content_def ($src, $Info);
|
394 |
}
|
395 |
}
|
396 |
make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'model'), $s);
|
397 |
}
|
398 |
|
399 |
sub datatype_module ($$) {
|
400 |
my ($src, $Info) = @_;
|
401 |
my $s = '';
|
402 |
for my $src (@{$src->child_nodes}) {
|
403 |
if ($src->local_name eq 'Type') {
|
404 |
$s .= qq(@{[get_desc ($src, $Info)]}<!ENTITY % @{[name_of ($src, $Info)]}.datatype "@{[xml_datatype_of ($src, $Info, default => 'CDATA')]}">\n\n);
|
405 |
}
|
406 |
}
|
407 |
make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'datatype'), $s);
|
408 |
}
|
409 |
|
410 |
sub notation_module ($$) {
|
411 |
my ($src, $Info) = @_;
|
412 |
my $s = '';
|
413 |
for my $src (@{$src->child_nodes}) {
|
414 |
if ($src->local_name eq 'Notation') {
|
415 |
$s .= qq(@{[get_desc ($src, $Info)]}<!NOTATION @{[name_of ($src, $Info)]} @{[external_id_of ($src, $Info)]}>\n\n);
|
416 |
}
|
417 |
}
|
418 |
make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'notation'), $s);
|
419 |
}
|
420 |
|
421 |
sub qname_module ($$) {
|
422 |
my ($src, $Info) = @_;
|
423 |
my $ID = $Info->{ID};
|
424 |
my $ns = $src->get_attribute ('Namespace');
|
425 |
my $s = <<EOH;
|
426 |
<!ENTITY % NS.prefixed "@{[$ns->get_attribute_value ('UsePrefix')==1?
|
427 |
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?
|
434 |
q(INCLUDE):
|
435 |
$ns->get_attribute_value ('UsePrefix')==-1?
|
436 |
q(IGNORE):
|
437 |
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')]}">
|
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')]}">
|
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;[
|
465 |
<!ENTITY % $ID.pfx "%$ID.prefix;:">
|
466 |
]]>
|
467 |
<!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 "">
|
478 |
|
479 |
<!-- The parameter entity %URI.datatype; should already be defined in
|
480 |
Datatype module. -->
|
481 |
<!ENTITY % URI.datatype; "CDATA">
|
482 |
|
483 |
<![%$ID.prefixed;[
|
484 |
<!ENTITY % $ID.xmlns.decl.attrib
|
485 |
"xmlns:%$ID.prefix; %URI.datatype; #FIXED '%$ID.xmlns;'">
|
486 |
]]>
|
487 |
<!ENTITY % $ID.xmlns.decl.attrib
|
488 |
"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;[
|
504 |
<!ENTITY % NS.decl.attrib
|
505 |
"%$ID.xmlns.decl.attrib;
|
506 |
%$ID.xmlns.extra.attrib;
|
507 |
%XSI.xmlns.attrib;">
|
508 |
]]>
|
509 |
<!ENTITY % NS.decl.attrib
|
510 |
"%$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;[
|
517 |
<!ENTITY % $ID.xmlns.attrib
|
518 |
"%NS.decl.attrib;">
|
519 |
]]>
|
520 |
<!ENTITY % $ID.xmlns.attrib
|
521 |
"%$ID.xmlns.decl.attrib;
|
522 |
%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
|
535 |
for my $lname (sort keys %{$Info->{QName}}) {
|
536 |
$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);
|
542 |
for my $lname (sort keys %{$Info->{QNameA}}) {
|
543 |
$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);
|
549 |
for my $lname (sort keys %{$Info->{QNameB}}) {
|
550 |
$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->get_attribute ('QName', make_new_node => 1), $Info, 'qname', $s);
|
556 |
}
|
557 |
|
558 |
sub get_name ($$;$) {
|
559 |
my ($src, $Info, $key) = @_;
|
560 |
my $name = $src->get_attribute_value ($key || 'Name');
|
561 |
if ($name =~ /^:(.+)/) {
|
562 |
$name = $1;
|
563 |
} elsif ($name =~ /([^:]+):(.+)/) {
|
564 |
$name = qq($1.$2);
|
565 |
} else {
|
566 |
$name = qq($Info->{ID}.$name);
|
567 |
}
|
568 |
$name;
|
569 |
}
|
570 |
|
571 |
sub get_qname ($$) {
|
572 |
my ($src, $Info) = @_;
|
573 |
my $name = $src->get_attribute_value ('Name');
|
574 |
if ($name =~ /"([^"]+)"/) {
|
575 |
$name = qq($1);
|
576 |
} elsif ($name =~ /^:(.+)/) {
|
577 |
$name = qq(%$1.qname;);
|
578 |
} elsif ($name =~ /([^:]+):(.+)/) {
|
579 |
$name = qq(%$1.$2.qname;);
|
580 |
} elsif ($name =~ /\{([^{}]+)\}/) {
|
581 |
$Info->{QNameB}->{$1} = 1;
|
582 |
$name = qq(%$Info->{ID}.$1.attribute.qname;);
|
583 |
} else {
|
584 |
$Info->{QNameA}->{$name} = 1;
|
585 |
$name = qq(%$Info->{ID}.$name.attrib.qname;);
|
586 |
}
|
587 |
$name;
|
588 |
}
|
589 |
|
590 |
sub get_atype ($$) {
|
591 |
my ($src, $Info) = @_;
|
592 |
my $name = $src->get_attribute_value ('Type');
|
593 |
if ($name =~ /^:(.+)/) {
|
594 |
$name = qq(%$1.datatype;);
|
595 |
} elsif ($name =~ /([^:]+):(.+)/) {
|
596 |
$name = qq(%$1.$2.datatype;);
|
597 |
} elsif ($name =~ /"([^"]+)"/) {
|
598 |
$name = qq($1);
|
599 |
} else {
|
600 |
$name = qq(%$Info->{ID}.$name.datatype;);
|
601 |
}
|
602 |
$name;
|
603 |
}
|
604 |
|
605 |
sub get_adefault ($$) {
|
606 |
my ($src, $Info) = @_;
|
607 |
my $name = $src->get_attribute_value ('Default');
|
608 |
if (defined $name) {
|
609 |
} else {
|
610 |
$name = qq(#IMPLIED);
|
611 |
}
|
612 |
$name;
|
613 |
}
|
614 |
|
615 |
sub get_desc ($$;%) {
|
616 |
my ($src, $Info, %opt) = @_;
|
617 |
my $desc = $src->get_attribute_value ('Description');
|
618 |
$desc =~ s/\n/\n /g;
|
619 |
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;
|
631 |
}
|
632 |
|
633 |
sub attset_def ($$) {
|
634 |
my ($src, $Info) = @_;
|
635 |
my $name = get_name ($src, $Info);
|
636 |
my $s .= qq(@{[get_desc ($src, $Info)]}<!ENTITY % $name.attrib\n\t);
|
637 |
my @s;
|
638 |
if ($name eq qq($Info->{ID}.common)) {
|
639 |
push @s, qq(%$Info->{ID}.common.extra.attrib;);
|
640 |
push @s, qq(%$Info->{ID}.xmlns.attrib;);
|
641 |
}
|
642 |
for my $src (@{$src->child_nodes}) {
|
643 |
## Attribute Definition
|
644 |
if ($src->local_name eq 'Attribute') {
|
645 |
push @s, attrib_def ($src, $Info);
|
646 |
## Reference to Attribute Definition
|
647 |
} elsif ($src->local_name eq 'ref') {
|
648 |
push @s, attrib_ref ($src, $Info);
|
649 |
} elsif ($src->local_name eq 'REF') {
|
650 |
push @s, attrib_REF ($src, $Info);
|
651 |
}
|
652 |
}
|
653 |
$s .= paralit join "\n\t", @s;
|
654 |
$s .= qq(>\n\n);
|
655 |
$s;
|
656 |
}
|
657 |
|
658 |
sub attrib_module ($$) {
|
659 |
my ($src, $Info) = @_;
|
660 |
my $s = <<EOH;
|
661 |
<!ENTITY % $Info->{ID}.common.extra.attrib "">
|
662 |
|
663 |
EOH
|
664 |
my $output_common = 0;
|
665 |
for my $src (@{$src->child_nodes}) {
|
666 |
## Attributes Set
|
667 |
if ($src->local_name eq 'Attribute' or $src->local_name eq 'AttributeSet') {
|
668 |
$s .= attset_def ($src, $Info);
|
669 |
$output_common = 1 if get_name ($src, $Info) eq qq($Info->{ID}.common);
|
670 |
}
|
671 |
}
|
672 |
unless ($output_common) {
|
673 |
$s .= <<EOH;
|
674 |
<!ENTITY % $Info->{ID}.common.attrib
|
675 |
"%$Info->{ID}.common.extra.attrib;
|
676 |
%$Info->{ID}.xmlns.attrib;">
|
677 |
|
678 |
EOH
|
679 |
}
|
680 |
make_module ($src, $Info, ($src->get_attribute_value ('ID') || 'attribs'), $s);
|
681 |
}
|
682 |
|
683 |
sub attrib_def ($$) {
|
684 |
my ($src, $Info) = @_;
|
685 |
my $s = qq(@{[get_qname ($src, $Info)]} @{[get_atype ($src, $Info)]} @{[get_adefault ($src, $Info)]});
|
686 |
$s;
|
687 |
}
|
688 |
|
689 |
sub attrib_ref ($$) {
|
690 |
my ($src, $Info) = @_;
|
691 |
my $name = $src->value;
|
692 |
if ($name =~ /^:(.+)/) {
|
693 |
$name = $1;
|
694 |
} elsif ($name =~ /([^:]+):(.+)/) {
|
695 |
$name = qq($1.$2);
|
696 |
} else {
|
697 |
$name = qq($Info->{ID}.$name);
|
698 |
}
|
699 |
qq(%$name.attrib;);
|
700 |
}
|
701 |
|
702 |
sub attrib_REF ($$) {
|
703 |
my ($src, $Info) = @_;
|
704 |
{
|
705 |
'xml:base' => q<xml:base %URI.datatype; #IMPLIED>,
|
706 |
'xml:lang' => q<xml:lang %LanguageCode.datatype; #IMPLIED>,
|
707 |
'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};
|
713 |
}
|
714 |
|
715 |
sub submodule ($$) {
|
716 |
my ($src, $Info) = @_;
|
717 |
local $Info->{elements} = [];
|
718 |
my $s = submodule_declarations ($src, $Info);
|
719 |
make_module ($src, $Info, $src->get_attribute_value ('ID'), $s);
|
720 |
}
|
721 |
|
722 |
sub submodule_declarations ($$) {
|
723 |
my ($src, $Info) = @_;
|
724 |
my $s = '';
|
725 |
for my $src (@{$src->child_nodes}) {
|
726 |
if ($src->local_name eq 'Element') {
|
727 |
$s .= element_def ($src, $Info);
|
728 |
} elsif ($src->local_name eq 'Attribute') {
|
729 |
$s .= attlist_def ($src, $Info);
|
730 |
} elsif ($src->local_name eq 'AttributeSet') {
|
731 |
$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') {
|
735 |
$s .= element_content_def ($src, $Info);
|
736 |
} elsif ($src->local_name eq 'IfModuleSet') {
|
737 |
$s .= qq(<![%@{[$src->get_attribute_value ('ModuleSet')]}.module;[\n);
|
738 |
$s .= submodule_declarations ($src, $Info);
|
739 |
$s .= qq(<!-- end of -->]]>\n);
|
740 |
} elsif ($src->local_name eq 'ElementSwitch') {
|
741 |
$s .= qq(<!ENTITY % @{[name_of ($src, $Info)]}.element "@{[$src->get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n);
|
742 |
} elsif ($src->local_name eq 'AttributeSwitch') {
|
743 |
$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') {
|
749 |
$s .= entity_declaration ($src, $Info, param => 1);
|
750 |
}
|
751 |
}
|
752 |
$s;
|
753 |
}
|
754 |
|
755 |
sub element_content_def ($$) {
|
756 |
my ($src, $Info) = @_;
|
757 |
qq(<!ENTITY % @{[name_of ($src, $Info, key => 'ElementType')]}.content @{[paralit convert_content_model ($src, $Info, default => 'EMPTY')]}>\n);
|
758 |
}
|
759 |
|
760 |
sub element_def ($$) {
|
761 |
my ($src, $Info) = @_;
|
762 |
my $name = get_name ($src, $Info);
|
763 |
my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name);
|
764 |
my $short_name = $name;
|
765 |
if ($name =~ /^\Q$Info->{ID}\E\.(.+)/) {
|
766 |
$Info->{QName}->{$1} = 1;
|
767 |
push @{$Info->{elements}}, $1;
|
768 |
$short_name = $1;
|
769 |
}
|
770 |
my $s = get_desc $src, $Info, prefix => qq($short_name: ),
|
771 |
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);
|
783 |
$s;
|
784 |
}
|
785 |
|
786 |
sub get_model_token ($$) {
|
787 |
my ($name, $Info) = @_;
|
788 |
my $suffix = '.qname';
|
789 |
if ($name =~ s/^\$//) {
|
790 |
$suffix = $name =~ /\.(?:mix|class|content|datatype)$/ ? '' : '.class';
|
791 |
}
|
792 |
if ($name =~ /^:(.+)/) {
|
793 |
$name = qq(%$1$suffix;);
|
794 |
} elsif ($name =~ /([^:]+):(.+)/) {
|
795 |
$name = qq(%$1.$2$suffix;);
|
796 |
} elsif ($name =~ /"([^"]+)"/) {
|
797 |
$name = qq($1);
|
798 |
} else {
|
799 |
$name = qq(%$Info->{ID}.$name$suffix;);
|
800 |
}
|
801 |
$name;
|
802 |
}
|
803 |
|
804 |
sub attlist_def ($$;$) {
|
805 |
my ($src, $Info, $name) = @_;
|
806 |
$name ||= get_name ($src, $Info, 'ElementType');
|
807 |
my $mname = get_name ($src, $Info);
|
808 |
$mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name))
|
809 |
if $mname eq "$Info->{ID}.";
|
810 |
$Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/;
|
811 |
my $s = qq(<!ATTLIST %$name.qname;);
|
812 |
for my $src (@{$src->child_nodes}) {
|
813 |
## Attribute Definition
|
814 |
if ($src->local_name eq 'Attribute') {
|
815 |
$s .= "\n\t". attrib_def ($src, $Info);
|
816 |
## Reference to Attribute Definition
|
817 |
} elsif ($src->local_name eq 'ref') {
|
818 |
$s .= "\n\t". attrib_ref ($src, $Info);
|
819 |
} elsif ($src->local_name eq 'REF') {
|
820 |
$s .= "\n\t". attrib_REF ($src, $Info);
|
821 |
}
|
822 |
}
|
823 |
if ($_[2]) {
|
824 |
$s .= qq(\n\t%$Info->{ID}.common.attrib;);
|
825 |
}
|
826 |
$s .= qq(>\n);
|
827 |
qq(@{[description ($src, $Info)]}<!ENTITY % $mname.attlist "INCLUDE">\n)
|
828 |
. xml_condition_section (qq($mname.attlist) => $s)
|
829 |
. "\n";
|
830 |
}
|
831 |
|
832 |
sub make_module ($$$$;%) {
|
833 |
my ($src, $Info, $id, $s, %opt) = @_;
|
834 |
my $name = $src->get_attribute_value ('Name')
|
835 |
|| {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/,
|
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/,
|
850 |
notations => q/Notations/,
|
851 |
pres => q/Presentation/,
|
852 |
qname => q/QName (Qualified Name)/,
|
853 |
struct => q/Document Structure/,
|
854 |
text => q/Text/,
|
855 |
}->{$id}
|
856 |
|| $id;
|
857 |
return unless $s;
|
858 |
|
859 |
my $r = <<EOH;
|
860 |
<!-- ...................................................................... -->
|
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 |
|
885 |
Revision: @{[sprintf '%04d-%02d-%02dT%02d:%02d:%02d+00:00',
|
886 |
(gmtime)[5]+1900, (gmtime)[4]+1, (gmtime)[3,2,1,0]
|
887 |
]} (Generated by $SCRIPT_NAME/$VERSION)
|
888 |
|
889 |
This DTD module is identified by the SYSTEM identifier:
|
890 |
|
891 |
SYSTEM "$Info->{BaseURI}$Info->{ID}-$id.mod"
|
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
|
954 |
}
|
955 |
|
956 |
$r .= $s;
|
957 |
|
958 |
$r .= qq(\n<!-- end of $Info->{ID}-$id.mod -->\n);
|
959 |
|
960 |
my $file = qq"$Info->{ID}-$id.mod";
|
961 |
open FILE, '>', $file or die "$0: $file: $!";
|
962 |
print FILE $r;
|
963 |
close FILE;
|
964 |
print STDERR "$0: $file created\n";
|
965 |
}
|
966 |
|
967 |
sub make_dtd ($$$$) {
|
968 |
my ($src, $Info, $id, $s) = @_;
|
969 |
$id = "-$id" if $id;
|
970 |
|
971 |
my $r = <<EOH;
|
972 |
<!-- ....................................................................... -->
|
973 |
<!-- @{[ dot_padding "$Info->{Name} DTD ", length => 71, dot => q(.) ]} -->
|
974 |
<!-- file: $Info->{ID}.dtd
|
975 |
-->
|
976 |
|
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"
|
1000 |
-->
|
1001 |
|
1002 |
EOH
|
1003 |
|
1004 |
$r .= $s;
|
1005 |
|
1006 |
$r .= qq(\n<!-- end of $Info->{ID}$id.dtd -->\n);
|
1007 |
|
1008 |
my $file = qq"$Info->{ID}$id.dtd";
|
1009 |
open FILE, '>', $file or die "$0: $file: $!";
|
1010 |
print FILE $r;
|
1011 |
close FILE;
|
1012 |
print STDERR "$0: $file created\n";
|
1013 |
}
|
1014 |
|
1015 |
|
1016 |
=head1 NAME
|
1017 |
|
1018 |
mkdtds.pl - Modularized XML Document Type Definition (DTD) Generator
|
1019 |
|
1020 |
=head1 DESCRIPTION
|
1021 |
|
1022 |
This script generates XML DTD module implementations and/or DTD drivers,
|
1023 |
that can be used with modularized XHTML DTDs.
|
1024 |
|
1025 |
=head1 USAGE
|
1026 |
|
1027 |
$ perl mkdtds.pl driver.dds
|
1028 |
mkdtds.pl: driver.dtd created
|
1029 |
mkdtds.pl: driver-model.mod created
|
1030 |
|
1031 |
$ perl mkdtds.pl moduleset.dms
|
1032 |
mkdtds.pl: moduleset-datatype.mod created
|
1033 |
mkdtds.pl: moduleset-attrib.mod created
|
1034 |
mkdtds.pl: moduleset-module1.mod created
|
1035 |
|
1036 |
=head1 DTD SOURCE FORMAT
|
1037 |
|
1038 |
(((See examples on <http://suika.fam.cx/gate/cvs/markup/>)))
|
1039 |
|
1040 |
=head1 REQUIRED MODULES
|
1041 |
|
1042 |
This script uses C<Message::Markup::SuikaWikiConfig20::Node> and
|
1043 |
C<Message::Markup::SuikaWikiConfig20::Parser>. Please retrive it from
|
1044 |
<http://suika.fam.cx/gate/cvs/messaging/manakai/lib/Message/Markup/SuikaWikiConfig20/>
|
1045 |
and put into your C<lib> directory.
|
1046 |
|
1047 |
=head1 AUTHOR
|
1048 |
|
1049 |
Wakaba <w@suika.fam.cx>
|
1050 |
|
1051 |
=head1 LICENSE
|
1052 |
|
1053 |
Copyright 2003-2004 Wakaba <w@suika.fam.cx>
|
1054 |
|
1055 |
This program is free software; you can redistribute it and/or
|
1056 |
modify it under the same terms as Perl itself.
|
1057 |
|
1058 |
Note that author claims no copyright with regard to DTD modules/drivers generated
|
1059 |
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
|