dtddoc step 4: Perl code - exploring XML

dtddoc step 4: Generating HTML

The Perl solution

#!/usr/bin/perl
use strict;
use SGML::DTD;
sub callback {
  local (*comment) = @_;
  if (my @match = (${*comment} =~ /<(\w*)(\s+(\w+)="[^"]*")?>\s*(.*)(\n[\w\W]*)?/m)) {
    $::comments{"$match[0] $match[2]"} = [htmlify_comment($match[3]), htmlify_comment($match[4])];
  }
}
sub write_overview_page {
  my ($fh, $dtd, %comments) = @_;
  write_header($fh);
  print $fh "<h1>DTD Overview</h1>";
  print $fh "<p>$comments{' '}[0]</p>";
  print $fh "<p>$comments{' '}[1]</p>";
  my @top_elements = $dtd->get_top_elements();
  my $root = shift @top_elements;
  print $fh "<h2>Root element</h2><p><a href=elt-$root.html>$root</a></p>";
  write_footer($fh);
}
sub write_tree_page {
  my ($fh, $dtd, %comments) = @_;
  write_header($fh);
  print $fh "<h1>Element Tree</h1>";
  print $fh "<ul>";
  my @top_elements = $dtd->get_top_elements();
  my $root = shift @top_elements;
  write_tree_element($fh, $dtd, $root, %comments);
  print $fh "</ul>";
  write_footer($fh);
}
sub write_tree_element {
  my ($fh, $dtd, $eltName, %comments) = @_;
  print $fh "<li><a href=elt-$eltName.html>$eltName</a>";
  print $fh " - " . $comments{$eltName . ' '}[0];
  my $first = 1;
  foreach my $item ($dtd->get_base_children($eltName)) {
    next if ((substr $item, 0, 1) eq '#');
    if ($first) {
      print $fh "<ul>";
      $first = 0;
    }
    write_tree_element($fh, $dtd, $item, %comments);
  }
  if (!$first) {
    print $fh "</ul>";
  }
}
sub write_index_page {
  my ($fh, $dtd, %comments) = @_;
  write_header($fh);
  print $fh "<h1>Index</h1>";
  my @index;
  foreach my $elt ($dtd->get_elements()) {
    insert_into_index(\@index, $elt, 'Element', $comments{$elt . ' '}[0]);
    foreach my $att ($dtd->get_elem_attr()) {
      insert_into_index(\@index, "$att ($elt)", 'Attribute', $comments{$elt . ' ' . $att}[0]);
    }
  }
  foreach my $ent ($dtd->get_gen_ents()) {
    insert_into_index(\@index, $ent, 'Entity', 'TODO: ent->value');
  }
#  foreach my $not ($dtd->get_notations()) {
#    insert_into_index(\@index, $not->name, 'Notation', $not->externalID->system);
#  }
  print $fh "<table border=1><tr><th>Name</th><th>Type</th><th>Value</th></tr>";
  foreach my $line (sort {uc($a) cmp uc($b)} @index) {
    print $fh "<tr><td>$line</td></tr>";
  }
  print $fh "</table>";
  write_footer($fh);
}
sub insert_into_index {
  my ($indexref, $name, $type, $value) = @_;
  my $sort = "<!--$name-->";
  $sort .= ($type eq 'Element') ? "<a href=elt-$name.html>$name</a>" : $name;
  push @$indexref, "$sort</td><td>$type</td><td>$value";
}
sub write_notations_page {
  my ($fh, $dtd, %comments) = @_;
  write_header($fh);
  print $fh "<h1>Notations</h1>";
#  if (sizeof($dtd->get_notations()) == 0) {
    print $fh "<p><em>TODO: Not supported by SGML::DTD</em></p>";
#  }
#  else {
#    foreach my $not ($dtd->get_notations()) {
#      print $fh "<li>$not = TODO:$not->externalID->system</li>";
#    }
#  }
  write_footer($fh);
}
sub write_entities_page {
  my ($fh, $dtd, %comments) = @_;
  write_header($fh);
  print $fh "<h1>Entities</h1>";
  if (scalar($dtd->get_gen_ents(1)) == 0) {
    print $fh "<p><em>None</em></p>";
  }
  else {
    print $fh "<ul>";
    foreach my $ent (sort {uc($a) cmp uc($b)} $dtd->get_gen_ents(1)) {
      print $fh "<li>$ent = TODO:ent->value</li>";
    }
    print $fh "</ul>";
  }
  write_footer($fh);
}
sub write_element_page {
  my ($fh, $dtd, $elt, %comments) = @_;
  write_header($fh);
  print $fh "<h1>Element <$elt></h1>";
  print $fh "<p>" . $comments{$elt . ' '}[0] . "</p>";
  my $comment = $comments{$elt . ' '}[1];
  if ($comment) {
    print $fh "<p>$comment</p>";
  }
  print $fh "<h2>Attributes</h2>";
  if (!$dtd->get_elem_attr($elt)) {
    print $fh "<p><em>None</em></p>";
  }
  else {
    print $fh "<dl>";
    my %attrs = $dtd->get_elem_attr($elt);
    foreach my $att (keys %attrs) {
      my $value = join(' ', @{$attrs{$att}});
      print $fh "<dt>$att $value</dt>";
      print $fh "<dd>" . $comments{$elt . ' ' . $att}[0] . "</dd>";
    }
    print $fh "</dl>";
  }
  print $fh "<h2>Content</h2>";
  print $fh "<p>" . htmlify_content(join(' ', $dtd->get_base_children($elt, 1))) . "</p>";
  print $fh "<h2>Parents</h2>";
  my @pars = $dtd->get_parents($elt);
  if (!@pars) {
    print $fh "<p><em>None</em></p>";
  }
  else {
    print $fh "<p>";
    foreach my $parent (@pars) {
      print $fh "<a href=elt-$parent.html>$parent</a> ";
    }
    print $fh "</p>";
  }
  write_footer($fh);
}
sub htmlify_content {
  my ($content) = @_;
  $content =~ s! (\w+) ! <a href=elt-$1.html>$1</a> !g;
  return $content;
}
sub htmlify_comment {
  my ($comment) = @_;
  $comment =~ s!<(\w+)>!<a href=elt-$1.html>$1</a>!g;
  $comment =~ s/html://g;
  return $comment;
}
sub write_header {
  my ($fh) = @_;
  print $fh "<html><body><p>";
  print $fh "<a href=dtd-overview.html>Overview</a> ";
  print $fh "<a href=dtd-tree.html>Tree</a> ";
  print $fh "<a href=dtd-index.html>Index</a> ";
  print $fh "<a href=dtd-notations.html>Notations</a> ";
  print $fh "<a href=dtd-entities.html>Entities</a> ";
  print $fh "</p>";
}
sub write_footer {
  my ($fh) = @_;
  print $fh "</body></html>";
  close $fh;
}
our %comments;
open FH, $ARGV[0];
SGML::DTD->set_comment_callback(\&callback);
my $dtd = new SGML::DTD \*FH;
open FH, ">dtd-overview.html";
write_overview_page(\*FH, $dtd, %comments);
open FH, ">dtd-tree.html";
write_tree_page(\*FH, $dtd, %comments);
open FH, ">dtd-index.html";
write_index_page(\*FH, $dtd, %comments);
open FH, ">dtd-notations.html";
write_notations_page(\*FH, $dtd, %comments);
open FH, ">dtd-entities.html";
write_entities_page(\*FH, $dtd, %comments);
foreach my $elt ($dtd->get_elements()) {
  open FH, ">elt-$elt.html";
  write_element_page(\*FH, $dtd, $elt, %comments);
}

Produced by Michael Claßen

URL: https://www.webreference.com/xml/column68/dtddoc.pl.html
Created: Nov 11, 2002
Revised: Nov 11, 2002