doc/man-pages/generate-pod

   1 #!/usr/bin/perl -w
   2 #
   3 # Convert the HTML pages of the Administrator's Reference into POD man pages.
   4 # This script was written by Chas Williams and Russ Allbery, based on work by
   5 # Alf Wachsmann and Elizabeth Cassell.  It just does a first pass; it's
   6 # expected that the results will require further hand-editing.
   7
   8 use strict;
   9 use HTML::Parser ();
  10
  11 my @ignore_tags = qw(meta head comment html body);
  12 my @ignore_elements = qw(script style);
  13
  14 my %INLINES = ('b'    => 'B<',
  15                '/b'   => '>',
  16                'i'    => 'I<',
  17                '/i'   => '>',
  18                'var'  => 'I<',
  19                '/var' => '>',
  20                'tt'   => 'C<',
  21                '/tt'  => '>',
  22                'a'    => 'L<',
  23                '/a'   => '(1)>',
  24                'sup'  => '',
  25                '/sup' => '');
  26
  27 my %CDATA = ('dd'     => 1,
  28              'dt'     => 1,
  29              'h2'     => 1,
  30              'a'      => 1,
  31              'li'     => 1,
  32              'p'      => 1,
  33              'pre'    => 1,
  34              'strong' => 1);
  35
  36 # Global state of the conversion.
  37 my $command = "";
  38 my $output = 0;
  39 my $emit = 0;
  40 my $pre = 0;
  41 my $buffer = "";
  42 my $inpara = 0;
  43 my $lasttag = "";
  44 my $open = "";
  45 my $cdata = "";
  46 my $result = "";
  47
  48 # Output some data.  Accumulate this into $results so that we can do some
  49 # post-filtering at the end.
  50 sub output {
  51     my ($format, @args) = @_;
  52     $result .= sprintf($format, @args);
  53 }
  54
  55 # Handle a single element.
  56 sub element {
  57     if ($output) {
  58         $buffer =~ s/^\s+\n/\n/m;
  59         $buffer =~ s/\n+$/\n/g;
  60
  61         if ($lasttag eq "h2") {
  62             $command = $buffer;
  63             $command =~ s/^L<//;
  64             $command =~ s/\(1\)>$//;
  65         } elsif ($lasttag eq "strong") {
  66             if ($buffer eq 'Related Information') {
  67                 $buffer = 'SEE ALSO';
  68             } else {
  69                 $buffer = uc $buffer;
  70             }
  71             if ($buffer eq 'PURPOSE') {
  72                 output "=head1 NAME\n\n%s - ", $command;
  73             } else {
  74                 output "=head1 %s\n\n", $buffer;
  75             }
  76         } elsif ($lasttag eq "h5") {
  77             output "=head2 %s\n\n", $buffer;
  78         } elsif ($lasttag eq "h6") {
  79             output "=head3 %s\n\n", $buffer;
  80         } elsif ($lasttag eq "p") {
  81             $buffer =~ s/\n+$//g;
  82             output "%s\n\n", $buffer if $buffer ne "";
  83         } elsif ($lasttag eq "pre") {
  84             $buffer =~ s/\n+$//;
  85             output "%s\n\n", $buffer if $buffer ne "";
  86         } elsif ($lasttag eq "ul" || $lasttag eq "dl") {
  87             output "=over 4\n\n";
  88         } elsif ($lasttag eq "li") {
  89             output "=item *\n\n%s\n\n", $buffer;
  90         } elsif ($lasttag eq "dt") {
  91             output "=item %s\n\n", $buffer;
  92         } elsif ($lasttag eq "dd") {
  93             output "%s\n", $buffer;
  94         } elsif ($lasttag eq "/ul" || $lasttag eq "/dl") {
  95             output "=back\n\n";
  96         } else {
  97             if ($buffer ne "") {
  98                 printf ">>>%s:%s<<<", $lasttag, $buffer;
  99             }
 100         }
 101     }
 102     $buffer = "";
 103 }
 104
 105 # Handle a single tag.
 106 sub tag {
 107     my $self = shift;
 108     local $_ = shift;
 109     my $tag = shift;
 110     my $attr = shift;
 111
 112     $output = 1 if ($tag eq "h2");
 113     $output = 0 if ($tag eq "hr");
 114
 115     if (defined $INLINES{$tag}) {
 116         if (defined $open && $open eq $tag) {
 117             printf STDERR "duplicate tag <%s>\n", $tag;
 118             return;
 119         }
 120         if ($tag =~ /^\//) {
 121             undef $open;
 122         } else {
 123             $open = $tag;
 124         }
 125
 126         &text(sprintf "%s", $INLINES{$tag});
 127         return;
 128     }
 129
 130     $cdata = 0;
 131     $cdata = 1 if defined $CDATA{$tag};
 132
 133     &element;
 134     $lasttag = $tag;
 135 }
 136
 137 # Do text conversion, mostly undoing SGML escapes.
 138 sub text {
 139     local $_ = shift;
 140
 141     if ($cdata) {
 142         s/&amp;/&/g;
 143         s/&nbsp;/ /g;
 144         s/&gt;/>/g;
 145         s/&lt;/</g;
 146
 147         s/\n$//g if defined $open;      # in inline seq, remove \n
 148         s/L<(\S+) (\S+\(1\))>/L<${1}_${2}>/g;
 149         $buffer = $buffer . $_;
 150     }
 151 }
 152
 153 my $file = shift @ARGV;
 154
 155 my $p = HTML::Parser->new(api_version     => 3,
 156                           start_h         => [\&tag, "self, text, tag, attr"],
 157                           end_h           => [\&tag, "self, text, tag, attr"],
 158                           process_h       => ["", ""],
 159                           comment_h       => ["", ""],
 160                           declaration_h   => ["", ""],
 161                           default_h       => [\&text, "text"],
 162
 163                           ignore_tags     => \@ignore_tags,
 164                           ignore_elements => \@ignore_elements,
 165                           unbroken_text   => 1);
 166
 167 $p->parse_file($file) || die "Can't open file: $!\n";
 168
 169 # Fix up a few last things.
 170 $result =~ s/L<(\S+) (\S+\(1\))>/L<${1}_${2}>/g;
 171 $result =~ s/^(L<[^>]+>)\n\n(?=L<)/$1,\n/mg;
 172 $result =~ s/^(\s+.*)B<([^>]+)>/$1$2/mg;
 173
 174 # Append a stock copyright statement.
 175 $result .= <<'EOC';
 176 =head1 COPYRIGHT
 177
 178 IBM Corporation 2000. <http://www.ibm.com/> All Rights Reserved.
 179
 180 This documentation is covered by the IBM Public License Version 1.0.  It was
 181 converted from HTML to POD by software written by Chas Williams and Russ
 182 Allbery, based on work by Alf Wachsmann and Elizabeth Cassell.
 183 EOC
 184
 185 # Output the results.
 186 print $result;