openafs/doc/man-pages/generate-pod

#!/usr/bin/perl -w
#
# Convert the HTML pages of the Administrator's Reference into POD man pages.
# This script was written by Chas Williams and Russ Allbery, based on work by
# Alf Wachsmann and Elizabeth Cassell.  It just does a first pass; it's
# expected that the results will require further hand-editing.

use strict;
use HTML::Parser ();

my @ignore_tags = qw(meta head comment html body);
my @ignore_elements = qw(script style);

my %INLINES = ('b'    => 'B<',
               '/b'   => '>',
               'i'    => 'I<',
               '/i'   => '>',
               'var'  => 'I<',
               '/var' => '>',
               'tt'   => 'C<',
               '/tt'  => '>',
               'a'    => 'L<',
               '/a'   => '(1)>',
               'sup'  => '',
               '/sup' => '');

my %CDATA = ('dd'     => 1,
             'dt'     => 1,
             'h2'     => 1,
             'a'      => 1,
             'li'     => 1,
             'p'      => 1,
             'pre'    => 1,
             'strong' => 1);

# Global state of the conversion.
my $command = "";
my $output = 0;
my $emit = 0;
my $pre = 0;
my $buffer = "";
my $inpara = 0;
my $lasttag = "";
my $open = "";
my $cdata = "";
my $result = "";

# Output some data.  Accumulate this into $results so that we can do some
# post-filtering at the end.
sub output {
    my ($format, @args) = @_;
    $result .= sprintf($format, @args);
}

# Handle a single element.
sub element {
    if ($output) {
        $buffer =~ s/^\s+\n/\n/m;
        $buffer =~ s/\n+$/\n/g;

        if ($lasttag eq "h2") {
            $command = $buffer;
            $command =~ s/^L<//;
            $command =~ s/\(1\)>$//;
        } elsif ($lasttag eq "strong") {
            if ($buffer eq 'Related Information') {
                $buffer = 'SEE ALSO';
            } else {
                $buffer = uc $buffer;
            }
            if ($buffer eq 'PURPOSE') {
                output "=head1 NAME\n\n%s - ", $command;
            } else {
                output "=head1 %s\n\n", $buffer;
            }
        } elsif ($lasttag eq "h5") {
            output "=head2 %s\n\n", $buffer;
        } elsif ($lasttag eq "h6") {
            output "=head3 %s\n\n", $buffer;
        } elsif ($lasttag eq "p") {
            $buffer =~ s/\n+$//g;
            output "%s\n\n", $buffer if $buffer ne "";
        } elsif ($lasttag eq "pre") {
            $buffer =~ s/\n+$//;
            output "%s\n\n", $buffer if $buffer ne "";
        } elsif ($lasttag eq "ul" || $lasttag eq "dl") {
            output "=over 4\n\n";
        } elsif ($lasttag eq "li") {
            output "=item *\n\n%s\n\n", $buffer;
        } elsif ($lasttag eq "dt") {
            output "=item %s\n\n", $buffer;
        } elsif ($lasttag eq "dd") {
            output "%s\n", $buffer;
        } elsif ($lasttag eq "/ul" || $lasttag eq "/dl") {
            output "=back\n\n";
        } else {
            if ($buffer ne "") {
                printf ">>>%s:%s<<<", $lasttag, $buffer;
            }
        }
    }
    $buffer = "";
}

# Handle a single tag.
sub tag {
    my $self = shift;
    local $_ = shift;
    my $tag = shift;
    my $attr = shift;

    $output = 1 if ($tag eq "h2");
    $output = 0 if ($tag eq "hr");

    if (defined $INLINES{$tag}) {
        if (defined $open && $open eq $tag) {
            printf STDERR "duplicate tag <%s>\n", $tag;
            return;
        }
        if ($tag =~ /^\//) {
            undef $open;
        } else {
            $open = $tag;
        }

        &text(sprintf "%s", $INLINES{$tag});
        return;
    }

    $cdata = 0;
    $cdata = 1 if defined $CDATA{$tag};

    &element;
    $lasttag = $tag;
}

# Do text conversion, mostly undoing SGML escapes.
sub text {
    local $_ = shift;

    if ($cdata) {
        s/&amp;/&/g;
        s/&nbsp;/ /g;
        s/&gt;/>/g;
        s/&lt;/</g;

        s/\n$//g if defined $open;	# in inline seq, remove \n
        s/L<(\S+) (\S+\(1\))>/L<${1}_${2}>/g;
        $buffer = $buffer . $_;
    }
}

my $file = shift @ARGV;

my $p = HTML::Parser->new(api_version     => 3,
			  start_h         => [\&tag, "self, text, tag, attr"],
			  end_h           => [\&tag, "self, text, tag, attr"],
			  process_h       => ["", ""],
			  comment_h       => ["", ""],
			  declaration_h   => ["", ""],
			  default_h       => [\&text, "text"],

			  ignore_tags     => \@ignore_tags,
			  ignore_elements => \@ignore_elements,
			  unbroken_text   => 1);

$p->parse_file($file) || die "Can't open file: $!\n";

# Fix up a few last things.
$result =~ s/L<(\S+) (\S+\(1\))>/L<${1}_${2}>/g;
$result =~ s/^(L<[^>]+>)\n\n(?=L<)/$1,\n/mg;
$result =~ s/^(\s+.*)B<([^>]+)>/$1$2/mg;

# Append a stock copyright statement.
$result .= <<'EOC';
=head1 COPYRIGHT

IBM Corporation 2000. <http://www.ibm.com/> All Rights Reserved.

This documentation is covered by the IBM Public License Version 1.0.  It was
converted from HTML to POD by software written by Chas Williams and Russ
Allbery, based on work by Alf Wachsmann and Elizabeth Cassell.
EOC

# Output the results.
print $result;