DTDs like much of XML is extremely useful, but not particularly easy to read. In fact they tend to as much hide information as order it. But since they are tightly defined by W3C, it isn't particularly difficult to suck the juice out of them and present their contents in a more legible format. "...not particularly difficult..." thanks to PM fellow traveler jenda that is.

His module XML::DTDParser made this task simple and straight forward, I highly recommend it! These days it's my job to convert 'stuff' of various kinds into hopefully useful documentation. My primary weapons are HTML and LaTeX---which pretty much covers both targets of screen and manual. So without further babble I present to you, dtd2htm.pl and dtd2tex.pl, neither particularly sophisticated, rather more in the line of skeletons suitable for further fleshing out or embroidery depending on your tastes!

dtd2htm.pl

#!/perl/bin/perl
#
# dtd2htm.pl -- simple approach to convert .dtd to .html.
use strict;
use warnings;
use diagnostics;
use XML::DTDParser qw(ParseDTD);                           
use Data::Dumper;

open DTD, $ARGV[0] or die "Cannot open $ARGV[0] : $!\n";
my $DTDtext;                                               
{ local $/;                                                
      $DTDtext = <DTD>                                     
}                                                          
close DTD;                                                 
my $DTD = ParseDTD $DTDtext;
if ($ARGV[1]) {
    print Dumper($DTD);
    exit;
}
print <<BP;
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>$ARGV[0]</title>
<style>
TABLE {
    background-color: #FFFFCC;
    border: 1px solid black;
}
TD {
    border: 1px solid black;
    padding-left: .5em;
    padding-right: .5em;
}
.DTD {
    font-family: ARIAL;
    font-weight: bold;
    font-size: 10pt;
}
.header {
    font-family: ARIAL;
    font-weight: bold;
    background-color: #6600CC;
    color: white;
}
.cardinal {
    font-family: ARIAL;
    font-weight: bold;
    color: red;
}
.arial {
    font-family: ARIAL;
    font-weight: bold;
}
</style>
</head>
<body>
<h1>$ARGV[0]</h1>
<h2>Table of Contents</h2>
<table>
<tr>
  <td class="header">Name</td>
</tr>
BP
for (sort keys %$DTD) {
    print "<tr>\n";
    print "  <td><a href=\"#$_\">$_</a></td>\n";
    print "</tr>\n";
}
print <<BP;
</table>
<br/>
<table>
  <tr>
    <td colspan="2" class="header">Legend</td>
  </tr>
  <tr>
    <td>&nbsp;</td>
    <td class="arial">The absence of a cardinality operator character 
+indicates that one, and only one, instance of the child element is al
+lowed (and is <em>required</em>).</td>
  <tr>
    <td class="cardinal">?</td>
    <td class="arial">Zero or one instance&mdash;optional singular ele
+ment</td>
  </tr>
  <tr>
    <td class="cardinal">*</td>
    <td class="arial">Zero or more instances&mdash;optional element(s)
+</td>
  </tr>
  <tr>
    <td class="cardinal">+</td>
    <td class="arial">One or more instances&mdash;required element(s)<
+/td>
  </tr>
</table>
<br/>
BP
for (sort keys %$DTD) {
    my $ref = $$DTD{$_};
print <<BP;
<hr><a name="$_"/><br/>
<h2>$_</h2>
<table>
<tr>
  <td class="header">Name</td>
  <td colspan="5" class="header">Content Category/Model</td>
</tr>
BP
    if ($$ref{'childrenSTR'}) {
        print "<tr>\n";
        print "  <td>$_</td>\n";
        if (exists($$ref{'children'})) {
            my $children = $$ref{'children'};
            print "  <td colspan=\"5\">A List of:</td>\n";
            print "</tr>\n";
            my $rows = scalar(keys %$children) + 1;
print <<BP;
<tr>
  <td rowspan="$rows">&nbsp;</td>
  <td class="header" colspan="5">Name</td>
</tr>
BP
            for (sort keys %$children) {
                my $cardinality = $$children{$_};
                print "<tr>\n";
                if ($cardinality ne '!') {
                    print "  <td colspan=\"5\"><a href=\"\#$_\">$_</a>
+<span class=\"cardinal\">$cardinality</span></td>\n";
                }
                else {
                    print "  <td colspan=\"5\"><a href=\"\#$_\">$_</a>
+</td>\n";
                }
                print "</tr>\n";
            }
        }
        else {
            print "  <td colspan=\"5\">$$ref{'childrenSTR'}</td>\n";
        }
        print "</tr>\n";
    }
    else {
        print "<tr>\n";
        print "  <td>$_</td>\n";
        print "  <td class=\"DTD\" colspan=\"5\">EMPTY</td>\n";
        print "</tr>\n";
    }
    if ($$ref{'attributes'}) {
        my $list = $$ref{'attributes'};
        my $rows = scalar(keys %$list) + 1;
print <<BP;
<tr>
  <td rowspan="$rows">&nbsp;</td>
  <td class="header">Name</td>
  <td class="header">Type</td>
  <td class="header">Values</td>
  <td class="header">Presence</td>
  <td class="header">Default</td>
</tr>
BP
        for (keys %{$list}) {
            print "<tr>\n";
            print "  <td><em>$_</em></td>\n";
            my $arrayref = $$list{$_};
            if ($$arrayref[0] =~ /\|/) {
                print "  <td>&nbsp;</td>\n";
                print "  <td>$$arrayref[0]</td>\n";
            }
            else {
                print "  <td class=\"DTD\">$$arrayref[0]</td>\n";
                print "  <td>&nbsp;</td>\n";
            }            
            if ($$arrayref[1]) {
                print "  <td class=\"DTD\">$$arrayref[1]</td>\n";
            }
            else {
                print "  <td>&nbsp;</td>\n";
            }
            if ($$arrayref[2]) {
                print "  <td>$$arrayref[2]</td>\n";
            }
            else {
                print "  <td>&nbsp;</td>\n";
            }
            print "</tr>\n";
        }
    }
    if ($$ref{'parent'}) {
        print "<tr>\n";
        print "  <td colspan=\"6\" class=\"header\">Parents (Used by)<
+/td>\n";
        print "</tr>\n";
        my $list = $$ref{'parent'};
        for (@$list) {
            print "<tr>\n";
            print "<td colspan=\"6\" ><a href=\"#$_\">$_</a></td>\n";
            print "</tr>\n";
        }
    }
    print "</table>\n";
    print "<br/>\n";
}
print <<BP;
</body>
</html>
BP

[download]

dtd2tex.pl

#!/perl/bin/perl
#
# dtd2tex.pl -- simple approach to convert .dtd to LaTeX.
use strict;
use warnings;
use diagnostics;
use XML::DTDParser qw(ParseDTD);                           
use Data::Dumper;

open DTD, $ARGV[0] or die "Cannot open $ARGV[0] : $!\n";
my $DTDtext;                                               
{ local $/;                                                
      $DTDtext = <DTD>                                     
}                                                          
close DTD;                                                 
my $DTD = ParseDTD $DTDtext;
if ($ARGV[1]) {
    print Dumper($DTD);
    exit;
}
print <<BP;
% $ARGV[0].tex -- DTD to LaTeX conversion of $ARGV[0].
\\documentclass{report}
\\usepackage{palatino}
\\usepackage{colortbl}
\\usepackage{longtable}
%
\\begin{document}
\\setlength\\minrowclearance{2pt}%
\\setlength{\\extrarowheight}{1pt}%
\\setlength{\\tabcolsep}{2mm}%
\\newcolumntype{H}{>{\\columncolor[gray]{.7}[.95\\tabcolsep]}{l}}%
\\newcommand{\\textbsc}[1]{%
 \\textsc{\\textbf{\#1}}%
}
BP
for (sort keys %$DTD) {
    my $ref = $$DTD{$_};
    print "\\section{$_}\n";
    print "\\begin{tabular}{|l|l|l|l|l|l|}\\hline\n";
    print "\\multicolumn{1}{|H|}{\\textbf{Name}}%\n";
    print "&\\multicolumn{5}{H|}{\\textbf{Content Category/Model}}\\\\
+\n";
    print "\\hline\n";
    if ($$ref{'childrenSTR'}) {
        print "\\multicolumn{1}{|l|}{$_} ";
        if (exists($$ref{'children'})) {
            print "& \\multicolumn{5}{l|}{A list of:}\\\\ \\hline\n";
            print "& \\multicolumn{5}{H|}{Name}\\\\ \\hline\n";
            my $children = $$ref{'children'};
            for (sort keys %$children) {
                my $cardinality = $$children{$_};
                if ($cardinality ne '!') {
                    print "& \\multicolumn{5}{l|}{$_$cardinality}\\\\ 
+\\hline\n";
                }
                else {
                    print "& \\multicolumn{5}{l|}{$_}\\\\ \\hline\n";
                }
            }
        }
        else {
            print "& \\multicolumn{5}{l|}{",latexsafe($$ref{'childrenS
+TR'}),"}\\\\ \\hline\n";
        }
    }
    else {
        print "\\multicolumn{1}{|l|}{$_} & \\multicolumn{5}{l|}{EMPTY}
+\\\\ \\hline\n";
    }
    if ($$ref{'attributes'}) {
        my $list = $$ref{'attributes'};
        print "&\\multicolumn{1}{H|}{\\textbf{Name}}%\n";
        print "&\\multicolumn{1}{H|}{\\textbf{Type}}%\n";
        print "&\\multicolumn{1}{H|}{\\textbf{Values}}%\n";
        print "&\\multicolumn{1}{H|}{\\textbf{Presence}}%\n";
        print "&\\multicolumn{1}{H|}{\\textbf{Default}}%\n";
        print "\\\\ \\hline\n";
        for (keys %$list) {
            print "&\\textit{$_}";
            my $arrayref = $$list{$_};
            if ($$arrayref[0] =~ /\|/) {
                print "& &",latexsafe($$arrayref[0]);
            }
            else {
                print "&\\textbsc{",latexsafe(lc($$arrayref[0])),"}& "
+;
            }
            if ($$arrayref[1]) {
                print "&\\textbsc{",latexsafe(lc($$arrayref[1])),"}";
            }
            else {
                print "& ";
            }
            if ($$arrayref[2]) {
                print "&",latexsafe($$arrayref[2]);
            }
            else {
                print "& ";
            }
            print " \\\\ \\hline\n"
        }
    }
    if ($$ref{'parent'}) {
        my $list = $$ref{'parent'};
        print "\\multicolumn{6}{|H|}{\\textbf{Parents (Used by)}} \\\\
+ \\hline\n";
        for (@$list) {
            print "\\multicolumn{6}{|l|}{$_} \\\\ \\hline\n";
        }
    }
    print "\\end{tabular}\n";
}
print <<BP;
\\end{document}
BP

sub latexsafe {
    my $s = shift;
    $s =~ s/\#/\\#/g;
    return $s;
}

[download]

--hsm

"Never try to teach a pig to sing...it wastes your time and it annoys the pig."

Replies are listed 'Best First'.
Re: DTDs, HTML, LaTeX and Perl
by joe++ (Friar) on Jan 09, 2003 at 08:47 UTC
[reply]

Back to Cool Uses for Perl