#!/usr/bin/perl use strict; our $SCRIPT_NAME = 'mkdtds'; our $VERSION = do{my @r=(q$Revision: 1.6 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; {require Message::Markup::SuikaWikiConfig20::Parser; my $parser = new Message::Markup::SuikaWikiConfig20::Parser; local $/ = undef; my $src = $parser->parse_text (scalar <>); my $Info = {}; for my $src ($src->get_attribute ('ModuleSet') || $src->get_attribute ('DocumentType')) { for (qw/Description/) { $Info->{$_} = $src->get_attribute_value ($_); } for (qw/Name ID Copyright BaseURI Version/) { $Info->{$_} = normalize_wsp ($src->get_attribute_value ($_)); } $Info->{realname} = $Info->{Name}; $Info->{Name} .= ' ' . $Info->{Version} if length $Info->{Version}; $Info->{ns} = $src->get_attribute ('Namespace'); } for (@{$src->child_nodes}) { if ($_->local_name eq 'Attribute') { attrib_module ($_, $Info); } elsif ($_->local_name eq 'Datatype') { datatype_module ($_, $Info); } elsif ($_->local_name eq 'Notation') { notation_module ($_, $Info); } elsif ($_->local_name eq 'Module') { submodule ($_, $Info); } elsif ($_->local_name eq 'Model') { model_module ($_, $Info); $Info->{has_model} = 1; } elsif ($_->local_name eq 'Driver') { dtd_driver ($_, $Info); } } if (ref $src->get_attribute ('ModuleSet')) { qname_module ($src->get_attribute ('ModuleSet'), $Info); } exit} sub normalize_wsp ($;%) { my $s = shift; $s =~ s/\s+/ /g; $s =~ s/^ +//; $s =~ s/ +$//; $s; } sub make_paragraphs ($;%) { my ($para, %opt) = @_; join "\n\n", map { my $s = $_; $s =~ s/\n+$//g; $s =~ s/\n/\n$opt{indent}/g; $opt{indent}.$s; } grep {length} @$para; } sub dot_padding ($%) { my ($s, %opt) = @_; if ($opt{length} - length $s > 0) { return $s . ( ($opt{dot} or q(.)) x ($opt{length} - length $s) ); } else { return $s; } } sub submodule_id_of ($$;%) { my ($src, $Info, %opt) = @_; my $id = $src->get_attribute_value ('ID') || $opt{default}; unless ($id) { die "$0: Submodule identifier not specified"; } $id; } sub xml_datatype_of ($$;%) { my ($src, $Info, %opt) = @_; my $type = $src->get_attribute_value ('XMLType') || $opt{default}; $type =~ s/\s+//g; $type; } sub system_id_of ($$;%) { my ($src, $Info, %opt) = @_; my $sysid = $src->get_attribute_value ('SYSTEM'); if ($sysid =~ /<([^>]+)>/) { return $1; } else { return $opt{base}.($sysid || $opt{default}); } } sub external_id_of ($$;%) { my ($src, $Info, %opt) = @_; my $sysid = system_id_of ($src, $Info, %opt); my $pubid = $src->get_attribute_value ('PUBLIC'); if ($pubid) { if ($sysid) { return qq(PUBLIC "$pubid"\n\t "$sysid"); } else { return qq(PUBLIC "$pubid"); } } else { return qq(SYSTEM "$sysid"); } } sub name_of ($$;%) { my ($src, $Info, %opt) = @_; unless (ref $src) {require Carp; Carp::croak ('$src undefined')} my $name = $src->get_attribute_value ($opt{key} || 'Name'); if ($name =~ /^:(.+)/) { ## Global namespace return $1; } elsif ($name =~ /([^:]+):(.+)/) { ## Named space return $1.($opt{delim}||'.').$2; } else { ## Default namespace return $Info->{ID}.($opt{delim}||'.').$name; } } sub local_name_of ($$;%) { my ($src, $Info, %opt) = @_; my $name = $src->get_attribute_value ($opt{key} || 'Name'); if ($name =~ /^:(.+)/) { ## Global namespace return $1; } elsif ($name =~ /[^:]+:(.+)/) { ## Named space return $1; } else { ## Default namespace return $name; } } sub set_name_of ($$;%) { my ($src, $Info, %opt) = @_; my $name = $src->get_attribute_value ($opt{key} || 'Name'); if ($name =~ /^:.+/) { ## Global namespace return 'XHTML'; } elsif ($name =~ /([^:]+):.+/) { ## Named space return $1; } else { ## Default namespace return $Info->{ID}; } } sub class_name_of ($$;%) { my ($src, $Info, %opt) = @_; my $name = name_of ($src, $Info, %opt); unless ($name =~ /\.(class|mix|content|datatype)$/) { $name .= '.class'; } $name; } sub convert_content_model ($$;%) { my ($src, $Info, %opt) = @_; my $model = $src->get_attribute_value ($opt{key} || 'Content') || $opt{default}; $model =~ s/\s//g; my $nonsymbol = qr/[^%#?,\$;()+*|:]/; $model =~ s/(?get_attribute_value ('Description'); $desc =~ s/\n/\n /g; unless ($desc) { $desc = { load_module => { AttributeModule => q/Common Attributes Module/, DatatypeModule => q/Datatypes Module/, NotationModule => q/Notation Module/, QNameModule => q/QName Module/, }, }->{$opt{context}}->{$opt{id} || $src->get_attribute_value ($opt{id_key}||'ID')}; } $desc = qq(\n) if $desc; $desc; } sub xml_condition_section ($$;%) { my ($condition, $content, %opt) = @_; qq(]]>\n); } sub xml_parameter_ENTITY ($%) { my ($name, %opt) = @_; qq(\n); } sub entity_declaration ($$;%) { my ($src, $Info, %opt) = @_; my $val; if ($src->get_attribute_value ('ID') || $src->get_attribute_value ('SYSTEM') || $src->get_attribute_value ('PUBLIC')) { $val = "\n\t".external_id_of ($src, $Info, default => $src->get_attribute_value ('ID')); } elsif (ref $src->get_attribute ('Declaration')) { $val = "\n\t".sparalit submodule_declarations ($src->get_attribute ('Declaration'), $Info); } else { $val = paralit $src->get_attribute_value ('EntityValue'); } my $s = <get_attribute_value ('Name')]} $val> EOH $s; } sub parameter_entity_declaration ($$%) { my ($src, $Info, %opt) = @_; my $name = name_of $src, $Info, %opt; if (my $sysid = $src->get_attribute_value ('SYSTEM')) { if ($sysid =~ /^\s*<([^<>]+)>\s*$/) { $sysid = $1; $sysid =~ s/([%"])/sprintf '&#x%02X;', ord $1/ge; } elsif ($sysid =~ /^([^:]*):(.*)$/) { my $ns = $1; $sysid = $2; $sysid =~ s/([%"])/sprintf '&#x%02X;', ord $1/ge; $sysid = '%' . ($ns ? $ns . '.' : '') . 'sysid.base;' . $sysid; } else { $sysid = '%XHTML.sysid.base;' . $sysid; } my $r; if (my $pubid = $src->get_attribute_value ('PUBLIC')) { $r = qq{\n} . qq{\n} . qq{\n}; } else { $r = qq{\n} . qq{\n} . qq{\n}; } return < qq(%$name: ), padding_length => 51, padding_dot => q(.), default => qq(%$name)) ]}$r ]]> EOH } else { my $s = get_desc ($src, $Info); $s .= qq{get_attribute_value ('EntityValue'); $s .= ">\n"; return $s; } } sub dtd_driver ($$) { my ($src, $Info) = @_; my $s = ''; my %s; my @module_set; for my $src (@{$src->child_nodes}) { if ($src->local_name eq 'Module') { $s .= dtd_driver_load_module ($src, $Info); } elsif ($src->local_name eq 'DTD') { $s .= dtd_driver_load_dtd ($src, $Info); } elsif ($src->local_name eq 'ModuleSet') { push @module_set, $src; } elsif ($src->local_name =~ /^(?:QName|Attribute|Datatype|Notation)Module/) { $s{$src->local_name} .= dtd_driver_load_module ($src, $Info); } elsif ($src->local_name eq 'IfModuleSet') { my $ms = name_of $src, $Info, key => $src->get_attribute_value ('ID') ? 'ID' : 'ModuleSet'; $s .= qq(]]>\n\n); } elsif ($src->local_name eq 'IfModule') { my $ms = name_of $src, $Info, key => 'ID'; $s .= qq(]]>\n\n); } elsif ($src->local_name eq 'ElementSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'AttributeSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'ModuleSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'Switch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'GeneralEntity') { $s .= entity_declaration ($src, $Info, param => 0); } elsif ($src->local_name eq 'ParameterEntity') { $s .= parameter_entity_declaration ($src, $Info); } } $s{ModelModule} = $src->get_attribute_value ('NoModelModule') ? '' : $Info->{has_model} ? < {ID}-model.module "INCLUDE"> {ID}-model.module;[ {ID}-model.decl 'SYSTEM "$Info->{ID}-model.mod"'> {ID}-model.mod %$Info->{ID}-model.decl;> %$Info->{ID}-model.mod;]]> EOH $s = dtd_driver_module_sets (\@module_set, $Info) . $s{QNameModule}.$s{DatatypeModule}.$s{NotationModule}.$s{AttributeModule} . $s{ModelModule} .$s; make_dtd ($src, $Info, $src->get_attribute_value ('ID'), $s); } sub dtd_driver_module_sets ($$) { my ($srces, $Info) = @_; my @src = map {{src => $_}} @$srces; my $s = qq(\n); for my $module_set (@src) { $module_set->{ID} = $module_set->{src}->get_attribute_value ('ID') || 'XHTML'; $s .= qq({ID}.module "@{[$module_set->{src}->get_attribute_value ('Default') > 0 ? 'INCLUDE' : 'IGNORE']}">\n); } $s .= qq(\n\n); for my $module_set (@src) { $module_set->{ns} = $module_set->{src}->get_attribute ('Namespace'); $s .= qq({ID}.xmlns "@{[$module_set->{ns}->get_attribute_value ('Name')]}">\n); } $s .= qq(\n\n); for my $module_set (@src) { $s .= qq({ID}.sysid.base "@{[$module_set->{src}->get_attribute_value ('BaseURI')]}">\n); } $s .= qq(\n\n); $s .= qq({ns}->get_attribute_value ('UsePrefix') > 0 ? 'INCLUDE' : 'IGNORE']}">\n); for my $module_set (@src) { $s .= qq({ID}.prefix "@{[$module_set->{ns}->get_attribute_value ('DefaultPrefix')]}">\n); $s .= qq({ID}.prefixed "@{[$module_set->{ns}->get_attribute_value ('UsePrefix') > 0 ? 'INCLUDE' : $module_set->{ns}->get_attribute_value ('UsePrefix') < 0 ? 'IGNORE' : '%NS.prefixed;']}">\n); } $s .= qq(\n\n\n); $s .= qq(\n\n); for my $module_set (@src) { $s .= qq({ID}.xmlns.extra.attrib "">\n); } $s .= qq(\n\n); for my $module_set (@src) { $s .= qq({ID}.module;[ {ID}.prefixed;[ {ID}.xmlns.decl.attrib "xmlns:%$module_set->{ID}.prefix; %URI.datatype; #FIXED '%$module_set->{ID}.xmlns;'"> ]]> {ID}.xmlns.decl.attrib "xmlns %URI.datatype; #FIXED '%$module_set->{ID}.xmlns;'"> ]]> {ID}.xmlns.decl.attrib "">\n\n); } $s .= < EOH $s .= qq(\n{ID}.xmlns.decl.attrib;)} @src), map {qq(%$_->{ID}.xmlns.extra.attrib;)} @src) .qq(\n\t%XSI.xmlns.attrib;">\n); $s .= qq(\n); for my $module_set (@src) { $s .= qq({ID}.xmlns.attrib "%NS.decl.attrib;">\n); } $s .= qq(\n\n); $s; } sub dtd_driver_load_module ($$) { my ($src, $Info) = @_; my $module_name = name_of ($src, $Info, key => 'ID'); my $module_hyphen_name = name_of ($src, $Info, key => 'ID', delim => '-'); my $module_set_name = set_name_of ($src, $Info, key => 'ID'); my $module_id = local_name_of ($src, $Info, key => 'ID'); my $s .= < 'load_module', id => $src->local_name)]}get_attribute_value ('Default') >= 0 ? 'INCLUDE' : 'IGNORE']}"> qq($module_hyphen_name.mod), base => qq(%$module_set_name.sysid.base;))]}> %$module_name.mod;]]> ]]> EOH $s; } sub dtd_driver_load_dtd ($$) { my ($src, $Info) = @_; my $module_set_name = $src->get_attribute_value ('ID'); my $s .= < $src->get_attribute_value ('ID').'.dtd', base => qq(%$module_set_name.sysid.base;))]}"> @{[do{ my $pubid = $src->get_attribute_value ('PUBLIC'); if ($pubid) { qq(\n\n); } else { qq(\n\n); } }]} ]]> %$module_set_name.dtd;]]> EOH $s; } sub model_module ($$) { my ($src, $Info) = @_; my $s = ''; for my $src (@{$src->child_nodes}) { if ($src->local_name eq 'Class') { $s .= qq(@{[description ($src, $Info)]}\n\n); } elsif ($src->local_name eq 'Content') { $s .= element_content_def ($src, $Info); } } make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'model'), $s); } sub datatype_module ($$) { my ($src, $Info) = @_; my $s = ''; for my $src (@{$src->child_nodes}) { if ($src->local_name eq 'Type') { $s .= qq(@{[get_desc ($src, $Info)]} 'CDATA')]}">\n\n); } } make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'datatype'), $s); } sub notation_module ($$) { my ($src, $Info) = @_; my $s = ''; for my $src (@{$src->child_nodes}) { if ($src->local_name eq 'Notation') { $s .= qq(@{[get_desc ($src, $Info)]}\n\n); } } make_module ($src, $Info, submodule_id_of ($src, $Info, default => 'notation'), $s); } sub qname_module ($$) { my ($src, $Info) = @_; my $ID = $Info->{ID}; my $ns = $src->get_attribute ('Namespace'); my $s = < get_attribute_value ('UsePrefix')==1? q(INCLUDE):q(IGNORE)]}"> get_attribute_value ('UsePrefix')==1? q(INCLUDE): $ns->get_attribute_value ('UsePrefix')==-1? q(IGNORE): q(%NS.prefixed;)]}"> get_attribute_value ('UsePrefix')==1? q(INCLUDE): $ns->get_attribute_value ('UsePrefix')==-1? q(IGNORE): q(%NS.prefixed;)]}"> get_attribute_value ('Name')]}"> get_attribute_value ('DefaultPrefix')]}"> ]]> %${ID}-qname-extra.mod; ]]> ]]> ]]> %${ID}-qname.redecl; EOH for my $lname (sort keys %{$Info->{QName}}) { $s .= qq({ID}.$lname.qname), length => 15 + length ($Info->{ID}), dot => ' ') . qq( "%$Info->{ID}.pfx;$lname">\n); } $s .= qq(\n); for my $lname (sort keys %{$Info->{QNameA}}) { $s .= qq({ID}.$lname.attrib.qname), length => 15 + length ($Info->{ID}), dot => ' ') . qq( "%$Info->{ID}.prefix;:$lname">\n); } $s .= qq(\n); for my $lname (sort keys %{$Info->{QNameB}}) { $s .= qq({ID}.$lname.attribute.qname), length => 15 + length ($Info->{ID}), dot => ' ') . qq( "%$Info->{ID}.pfx;$lname">\n); } make_module ($src->get_attribute ('QName', make_new_node => 1), $Info, 'qname', $s); } sub get_name ($$;$) { my ($src, $Info, $key) = @_; my $name = $src->get_attribute_value ($key || 'Name'); if ($name =~ /^:(.+)/) { $name = $1; } elsif ($name =~ /([^:]+):(.+)/) { $name = qq($1.$2); } else { $name = qq($Info->{ID}.$name); } $name; } sub get_qname ($$) { my ($src, $Info) = @_; my $name = $src->get_attribute_value ('Name'); if ($name =~ /"([^"]+)"/) { $name = qq($1); } elsif ($name =~ /^:(.+)/) { $name = qq(%$1.qname;); } elsif ($name =~ /([^:]+):(.+)/) { $name = qq(%$1.$2.qname;); } elsif ($name =~ /\{([^{}]+)\}/) { $Info->{QNameB}->{$1} = 1; $name = qq(%$Info->{ID}.$1.attribute.qname;); } else { $Info->{QNameA}->{$name} = 1; $name = qq(%$Info->{ID}.$name.attrib.qname;); } $name; } sub get_atype ($$) { my ($src, $Info) = @_; my $name = $src->get_attribute_value ('Type'); if ($name =~ /^:(.+)/) { $name = qq(%$1.datatype;); } elsif ($name =~ /([^:]+):(.+)/) { $name = qq(%$1.$2.datatype;); } elsif ($name =~ /"([^"]+)"/) { $name = qq($1); } else { $name = qq(%$Info->{ID}.$name.datatype;); } $name; } sub get_adefault ($$) { my ($src, $Info) = @_; my $name = $src->get_attribute_value ('Default'); if (defined $name) { } else { $name = qq(#IMPLIED); } $name; } sub get_desc ($$;%) { my ($src, $Info, %opt) = @_; my $desc = $src->get_attribute_value ('Description'); $desc =~ s/--/- - /g; $desc =~ s/\n/\n /g; if (length $desc) { $desc = qq($opt{prefix}$desc); $desc .= q( ) if $opt{padding_length}; $desc = q(\n); } elsif (length $opt{default}) { $desc = $opt{default}; $desc .= q( ) if $opt{padding_length}; $desc = q(\n); } $desc; } sub attset_def ($$) { my ($src, $Info) = @_; my $name = get_name ($src, $Info); my $s .= qq(@{[get_desc ($src, $Info)]}{ID}.common)) { push @s, qq(%$Info->{ID}.common.extra.attrib;); push @s, qq(%$Info->{ID}.xmlns.attrib;); } for my $src (@{$src->child_nodes}) { ## Attribute Definition if ($src->local_name eq 'Attribute') { push @s, attrib_def ($src, $Info); ## Reference to Attribute Definition } elsif ($src->local_name eq 'ref') { push @s, attrib_ref ($src, $Info); } elsif ($src->local_name eq 'REF') { push @s, attrib_REF ($src, $Info); } } $s .= paralit join "\n\t", @s; $s .= qq(>\n\n); $s; } sub attrib_module ($$) { my ($src, $Info) = @_; my $s = <{ID}.common.extra.attrib ""> EOH my $output_common = 0; for my $src (@{$src->child_nodes}) { ## Attributes Set if ($src->local_name eq 'Attribute' or $src->local_name eq 'AttributeSet') { $s .= attset_def ($src, $Info); $output_common = 1 if get_name ($src, $Info) eq qq($Info->{ID}.common); } } unless ($output_common) { $s .= <{ID}.common.attrib "%$Info->{ID}.common.extra.attrib; %$Info->{ID}.xmlns.attrib;"> EOH } make_module ($src, $Info, ($src->get_attribute_value ('ID') || 'attribs'), $s); } sub attrib_def ($$) { my ($src, $Info) = @_; my $s = qq(@{[get_qname ($src, $Info)]} @{[get_atype ($src, $Info)]} @{[get_adefault ($src, $Info)]}); $s; } sub attrib_ref ($$) { my ($src, $Info) = @_; my $name = $src->value; if ($name =~ /^:(.+)/) { $name = $1; } elsif ($name =~ /([^:]+):(.+)/) { $name = qq($1.$2); } else { $name = qq($Info->{ID}.$name); } qq(%$name.attrib;); } sub attrib_REF ($$) { my ($src, $Info) = @_; { 'xml:base' => q, 'xml:lang' => q, 'xml:space' => q, 'xsi:nil' => q<%XSI.prefix;:nil (true|false|1|0) #IMPLIED>, 'xsi:noNamespaceSchemaLocation' => q<%XSI.prefix;:noNamespaceSchemaLocation CDATA #IMPLIED>, 'xsi:schemaLocation' => q<%XSI.prefix;:schemaLocation CDATA #IMPLIED>, 'xsi:type' => q<%XSI.prefix;:type NMTOKEN #IMPLIED>, }->{$src->value}; } sub submodule ($$) { my ($src, $Info) = @_; local $Info->{elements} = []; my $s = submodule_declarations ($src, $Info); make_module ($src, $Info, $src->get_attribute_value ('ID'), $s); } sub submodule_declarations ($$) { my ($src, $Info) = @_; my $s = ''; for my $src (@{$src->child_nodes}) { if ($src->local_name eq 'Element') { $s .= element_def ($src, $Info); } elsif ($src->local_name eq 'Attribute') { $s .= attlist_def ($src, $Info); } elsif ($src->local_name eq 'AttributeSet') { $s .= attset_def ($src, $Info); } elsif ($src->local_name eq 'Class') { $s .= qq(@{[description ($src, $Info)]}\n\n); } elsif ($src->local_name eq 'Content') { $s .= element_content_def ($src, $Info); } elsif ($src->local_name eq 'IfModuleSet') { my $ms = name_of $src, $Info, key => $src->get_attribute_value ('ID') ? 'ID' : 'ModuleSet'; $s .= qq(]]>\n\n); } elsif ($src->local_name eq 'IfModule') { my $ms = name_of $src, $Info, key => 'ID'; $s .= qq(]]>\n\n); } elsif ($src->local_name eq 'ElementSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'AttributeSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'ModuleSwitch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'Switch') { $s .= qq(get_attribute_value ('Use')>0?'INCLUDE':'IGNORE']}">\n); } elsif ($src->local_name eq 'GeneralEntity') { $s .= entity_declaration ($src, $Info, param => 0); } elsif ($src->local_name eq 'ParameterEntity') { $s .= parameter_entity_declaration ($src, $Info); } elsif ($src->local_name eq 'Module') { $s .= dtd_driver_load_module ($src, $Info); } elsif ($src->local_name eq 'DTD') { $s .= dtd_driver_load_dtd ($src, $Info); } } $s; } sub element_content_def ($$) { my ($src, $Info) = @_; qq( 'ElementType')]}.content @{[paralit convert_content_model ($src, $Info, default => 'EMPTY')]}>\n); } sub element_def ($$) { my ($src, $Info) = @_; my $name = get_name ($src, $Info); my $mname = $name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name); my $short_name = $name; if ($name =~ /^\Q$Info->{ID}\E\.(.+)/) { $Info->{QName}->{$1} = 1; push @{$Info->{elements}}, $1; $short_name = $1; } my $s = get_desc $src, $Info, prefix => qq($short_name: ), padding_length => 51, padding_dot => q(.), default => qq($short_name); $s .= "\n"; $s .= xml_parameter_ENTITY qq($mname.element), value => 'INCLUDE'; my $cm = convert_content_model ($src, $Info, default => 'EMPTY'); $s .= xml_condition_section (qq($mname.element) => xml_parameter_ENTITY (qq($name.content), value => $cm) . xml_parameter_ENTITY (qq($name.qname), value => $short_name) . xml_parameter_ENTITY (qq($name.tagmin.start), value => q<->) . xml_parameter_ENTITY (qq($name.tagmin.end), value => $cm eq 'EMPTY' ? q : q<->) . xml_condition_section (qq(sgml.tag.minimizable) => xml_parameter_ENTITY (qq($name.tagmin), value => qq"%$name.tagmin.start; %$name.tagmin.end;")) . xml_parameter_ENTITY (qq($name.tagmin), value => q"") . qq(\n)); $s .= "\n"; $s .= attlist_def (scalar $src->get_attribute ('Attribute', make_new_node => 1), $Info, $mname); $s; } sub get_model_token ($$) { my ($name, $Info) = @_; my $suffix = '.qname'; if ($name =~ s/^\$//) { $suffix = $name =~ /\.(?:mix|class|content|datatype)$/ ? '' : '.class'; } if ($name =~ /^:(.+)/) { $name = qq(%$1$suffix;); } elsif ($name =~ /([^:]+):(.+)/) { $name = qq(%$1.$2$suffix;); } elsif ($name =~ /"([^"]+)"/) { $name = qq($1); } else { $name = qq(%$Info->{ID}.$name$suffix;); } $name; } sub attlist_def ($$;$) { my ($src, $Info, $name) = @_; $name ||= get_name ($src, $Info, 'ElementType'); my $mname = get_name ($src, $Info); $mname = ($name =~ /^\Q$Info->{ID}.\E/ ? $name : qq($Info->{ID}.$name)) if $mname eq "$Info->{ID}."; $Info->{QName}->{$1} = 1 if $name =~ /^\Q$Info->{ID}\E\.(.+)/; my $s = qq(child_nodes}) { ## Attribute Definition if ($src->local_name eq 'Attribute') { $s .= "\n\t". attrib_def ($src, $Info); ## Reference to Attribute Definition } elsif ($src->local_name eq 'ref') { $s .= "\n\t". attrib_ref ($src, $Info); } elsif ($src->local_name eq 'REF') { $s .= "\n\t". attrib_REF ($src, $Info); } } if ($_[2]) { $s .= qq(\n\t%$Info->{ID}.common.attrib;); } $s .= qq(>\n); qq(@{[description ($src, $Info)]}\n) . xml_condition_section (qq($mname.attlist) => $s) . "\n"; } sub make_module ($$$$;%) { my ($src, $Info, $id, $s, %opt) = @_; my $name = $src->get_attribute_value ('Name') || {arch => q/Base Architecture/, attribs => q/Common Attributes/, blkphras => q/Block Phrasal/, blkpres => q/Block Presentation/, blkstruct => q/Block Structural/, charent => q/Character Entities/, datatype => q/Datatypes/, framework => q/Modular Framework/, inlphras => q/Inline Phrasal/, inlpres => q/Inline Presentation/, inlstruct => q/Inline Structural/, legacy => q/Legacy Markup/, list => q/Lists/, meta => q/Metainformation/, model => q/Document Model/, notations => q/Notations/, pres => q/Presentation/, qname => q/QName (Qualified Name)/, struct => q/Document Structure/, text => q/Text/, }->{$id} || $id; return unless $s; my $r = < EOH ## TODO: Support PUBLIC identifier. ## Module description my @para = ({ arch => (join "\n", q!This optional module includes declarations that enable to be used!, q!as a base architecture according to the 'Architectural Forms Definition!, q!Requirements' (Annex A.3, ISO/IEC 10744, 2nd edition). For more!, q!information on use of architectural forms, see the HyTime web site at!, q!.!), attribs => q/This module declares many of the common attributes./, blkphras => qq/This module declares the element types and their attributes used\n/. q/to support block-level phrasal markup./, blkpres => qq/This module declares the element types and their attributes used\n/. q/to support block-level presentational markup./, blkstruct => qq/This module declares the element types and their attributes used\n/. q/to support block-level structural markup./, charent => q/This module declares the set of character entities./, datatype => q/This module defines containers for the datatypes./, framework => qq/This module imstantiates the modules needed to support\n/. q/the modularization model./, inlphras => qq/This module declares the element types and their attributes used\n/. q/to support inline phrasal markup./, inlpres => qq/This module declares the element types and their attributes used\n/. q/to support inline presentational markup./, inlstruct => qq/This module declares the element types and their attributes used\n/. q/to support inline structural markup./, legacy => q/This module declares additional markup that is considered obsolete./, list => qq/This module declares the list-oriented element types\n/. q/and their attributes./, meta => qq/This module declares the element types and their attributes\n/. q/to support metainformation markup./, model => qq/This model describes the groupings of element types that\n/. q/make up common content models./, pres => qq/This module declares the element types and their attributes used\n/. q/to support presentational markup./, qname => (join "\n", q!This module is contained in two parts, labeled Section 'A' and 'B':!, q!!, q! Section A declares parameter entities to support namespace-qualified!, q! names, namespace declarations, and name prefixing.!, q!!, q! Section B declares parameter entities used to provide namespace-qualified!, q! names for all element types and global attribute names.!), struct => qq/This module defines the major structural element types and\n/. q/their attributes./, }->{$id}, $src->get_attribute_value ('Description')); unshift @para, ' '.join ', ', sort @{$Info->{elements}||[]} if @{$Info->{elements}||[]}; if (@para) { $name = qq($Info->{realname} QName (Qualified Name) Module) if $id eq 'qname'; $r .= < ' ']} --> EOH } $r .= $s; $r .= qq(\n\n); my $file = qq"$Info->{ID}-$id.mod"; open FILE, '>', $file or die "$0: $file: $!"; print FILE $r; close FILE; print STDERR "$0: $file created\n"; } sub make_dtd ($$$$) { my ($src, $Info, $id, $s) = @_; $id = "-$id" if $id; my $r = < EOH $r .= $s; $r .= qq(\n\n); my $file = qq"$Info->{ID}$id.dtd"; open FILE, '>', $file or die "$0: $file: $!"; print FILE $r; close FILE; print STDERR "$0: $file created\n"; } =head1 NAME mkdtds.pl - Modularized XML Document Type Definition (DTD) Generator =head1 DESCRIPTION This script generates XML DTD module implementations and/or DTD drivers, that can be used with modularized XHTML DTDs. =head1 USAGE $ perl mkdtds.pl driver.dds mkdtds.pl: driver.dtd created mkdtds.pl: driver-model.mod created $ perl mkdtds.pl moduleset.dms mkdtds.pl: moduleset-datatype.mod created mkdtds.pl: moduleset-attrib.mod created mkdtds.pl: moduleset-module1.mod created =head1 DTD SOURCE FORMAT (((See examples on ))) =head1 REQUIRED MODULES This script uses C and C. Please retrive it from and put into your C directory. =head1 AUTHOR Wakaba =head1 LICENSE Copyright 2003-2004 Wakaba This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Note that author claims no copyright with regard to DTD modules/drivers generated by this script. Author(s) of DTD modules/drivers should explicily state their license terms in them and their documentation (if any). =cut