openafs/doc/xml/AdminRef/pod2refentry
chas williams - CONTRACTOR 85bb872e3d doc: generate admin ref from the pod documentation
a bit convoluted but this generates docbook from the pod documentation and
from that pdf, epub and mobi versions.  we are using variablelist.as.block
since that looks prettier on smaller devices/screen.

Change-Id: I5cd51ef10448373960a0aeed15212bbcf6f44039
Change-Id: Ib222dbfa30e3af644b1dbc6738df1d39cc33c92f
Reviewed-on: http://gerrit.openafs.org/5255
Tested-by: BuildBot <buildbot@rampaginggeek.com>
Reviewed-by: Derrick Brashear <shadow@dementix.org>
2011-08-23 09:37:33 -07:00

559 lines
15 KiB
Perl
Executable File

#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
# Pod::RefEntry -- Convert POD data to DocBook RefEntry
#
# Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# based on:
#
# Pod::PlainText -- Convert POD data to formatted ASCII text.
# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
#
# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
package Pod::RefEntry;
require 5.005;
use Carp qw(carp);
use Pod::Select ();
use strict;
use vars qw(@ISA %ESCAPES $VERSION);
# We inherit from Pod::Select instead of Pod::Parser so that we can be used
# by Pod::Usage.
@ISA = qw(Pod::Select);
$VERSION = '0.06';
# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
# which got it near verbatim from the original Pod::Text. It is therefore
# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
%ESCAPES = (
'amp' => '&amp;', # ampersand
'lt' => '&lt;', # left chevron, less-than
'gt' => '&gt;', # right chevron, greater-than
'quot' => '"', # double quote
);
# Initialize the object. Must be sure to call our parent initializer.
sub initialize {
my $self = shift;
$$self{hlevel} = 0 unless defined $$self{hlevel};
$$self{ltype} = 0 unless defined $$self{ltype};
$$self{lopen} = 0 unless defined $$self{lopen};
$$self{indent} = 2 unless defined $$self{indent};
$$self{width} = 76 unless defined $$self{width};
$$self{refnamediv} = 0;
$$self{LSTATE} = [];
$$self{MARGIN} = 0; # Current left margin in spaces.
$self->SUPER::initialize;
}
sub begin_pod {
my $self = shift;
$self->output ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
}
sub end_pod {
my $self = shift;
my $i;
for($i = 4; $i > 0; --$i) {
if ($$self{hlevel} >= $i) {
$self->{MARGIN} -= 2;
#$self->output ("</refsection>\n");
$self->output (sprintf "</refsect%d>\n", $i);
};
};
$self->{MARGIN} -= 2;
$self->output ("</refentry>\n");
}
# Called for each command paragraph. Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
# the command to a method named the same as the command. =cut is handled
# internally by Pod::Parser.
sub command {
my $self = shift;
my $command = shift;
return if $command eq 'pod';
return if ($$self{EXCLUDE} && $command ne 'end');
$self->item ("\n") if defined $$self{ITEM};
$command = 'cmd_' . $command;
$self->$command (@_);
}
# Called for a verbatim paragraph. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
# to spaces.
sub verbatim {
my $self = shift;
return if $$self{EXCLUDE};
$self->item if defined $$self{ITEM};
local $_ = shift;
return if /^\s*$/;
$$self{MARGIN} += 2;
s/&/&amp;/g; # do &amp; first to avoid "fixing" the & in &lt;
s/</&lt;/g;
s/>/&gt;/g;
my $saved = $$self{MARGIN};
$$self{MARGIN} = 0;
$self->output ("<programlisting>\n");
$self->output ($_);
$self->output ("</programlisting>\n");
$$self{MARGIN} = $saved;
}
sub escapes {
(undef, local $_) = @_;
s/(&)/\&amp;/g;
s/(<)/\&lt;/g;
s/(>)/\&gt;/g;
$_;
}
# Called for interior sequences. Gets a Pod::InteriorSequence object
# and is expected to return the resulting text.
sub sequence {
my ($self, $seq) = @_;
my $cmd_name = $seq->cmd_name;
$seq->left_delimiter( '' );
$seq->right_delimiter( '' );
$seq->cmd_name( '' );
$_ = $seq->raw_text;
if ($cmd_name eq 'B') {
$_ = sprintf "<emphasis role=\"bold\">%s</emphasis>", $_;
} elsif ($cmd_name eq 'C') {
$_ = sprintf "<computeroutput>%s</computeroutput>", $_;
} elsif ($cmd_name eq 'F') {
$_ = sprintf "<replaceable>%s</replaceable>", $_;
} elsif ($cmd_name eq 'I') {
$_ = sprintf "<emphasis>%s</emphasis>", $_;
} elsif ($cmd_name eq 'S') {
# perhaps translate ' ' to &nbsp;
$_ = sprintf "%s", $_;
} elsif ($cmd_name eq 'L') {
$_ = $self->seq_l ($seq);
} elsif ($cmd_name eq 'E') {
if (defined $ESCAPES{$_}) {
$_ = $ESCAPES{$_} if defined $ESCAPES{$_};
} else {
carp "Unknown escape: E<$_>";
}
} else {
carp "\nUnknown sequence $cmd_name<$_>\n";
}
my $parent = $seq->nested;
if (defined $parent) {
if ($parent->cmd_name eq 'B') {
$_ = sprintf "</emphasis>%s<emphasis role=\"bold\">", $_;
} elsif ($parent->cmd_name eq 'C') {
$_ = sprintf "</computeroutput>%s<computeroutput>", $_;
} elsif ($parent->cmd_name eq 'F') {
$_ = sprintf "</replaceable>%s<replaceable>", $_;
} elsif ($parent->cmd_name eq 'I') {
$_ = sprintf "</emphasis>%s<emphasis>", $_;
}
}
return $_;
}
# Called for a regular text block. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Perform parse_text and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
$self->output ($_[0]), return if $$self{VERBATIM};
local $_ = shift;
my $line = shift;
my $name;
my $purpose;
# /<http:.*>/ && do {
# s/<http:([^>]+)\>/<ulink url=\"http:\1\">http:\1<\/ulink>/;
# };
#
# /<.*@.*>/ && do {
# s/<([^>]+@[^>]+)>/<email>\1<\/email>/g;
# };
$_ = $self->parse_text(
{ -expand_text => q(escapes),
-expand_seq => q(sequence) },
$_, $line ) -> raw_text();
if (defined $$self{ITEM}) {
$self->item ($_ . "\n");
} elsif ($self->{refnamediv}) {
($name, $purpose) = /(.+)\s+\-\s+(.+)/;
my $id = $name;
$id =~ s/,.*$//; # only reference by first entry?
$id =~ s/[ \.,\(\)]/_/g;
if (defined $$self{section}) {
$id = sprintf "%s%d", $id, $$self{section};
}
$self->output ("<refentry id=\"$id\">\n");
$self->{MARGIN} += 2;
if (defined $$self{section}) {
$self->output ("<refmeta>\n");
$self->{MARGIN} += 2;
$self->output (sprintf "<refentrytitle>%s</refentrytitle>\n", $name);
$self->output (sprintf "<manvolnum>%d</manvolnum>\n", $$self{section});
$self->{MARGIN} -= 2;
$self->output ("</refmeta>\n");
}
$self->output ("<refnamediv>\n");
$self->{MARGIN} += 2;
$self->output ("<refname>$name</refname>\n");
$self->output ("<refpurpose>$purpose</refpurpose>\n");
$self->{MARGIN} -= 2;
$self->output ("</refnamediv>\n");
$self->{refnamediv} = 0;
} else {
s/\n+$//;
$self->output ("<para>" . $_ . "<\/para>" . "\n\n");
}
}
# Level headings.
sub cmd_head {
my $self = shift;
local $_ = shift;
my $line = shift;
my $level = $self->{level};
my $i;
for($i = 4; $i > 0; --$i) {
if ($level <= $i) {
if ($$self{hlevel} >= $i) {
$$self{MARGIN} -= 2;
#$self->output (sprintf "</refsection>\n", $i);
$self->output (sprintf "</refsect%d>\n", $i);
}
}
}
# special, output next <para> as <refnamediv>
if ($level == 1 && $_ =~ /NAME/) {
$self->{refnamediv} = 1;
return;
}
#$self->output (sprintf "<refsection>\n", $level);
$self->output (sprintf "<refsect%d>\n", $level);
$$self{MARGIN} += 2;
s/\s+$//;
$_ = $self->parse_text(
{ -expand_text => q(escapes),
-expand_seq => q(sequence) },
$_, $line ) -> raw_text();
if (/^[A-Z ]+$/) {
s/(\w+)/\u\L$1/g if $level == 1; # kill capitalization
}
$self->output ("<title>" . $_ . "<\/title>" . "\n");
$$self{hlevel} = $level;
}
# First level heading.
sub cmd_head1 {
my $self = shift;
$self->{level} = 1;
$self->cmd_head (@_);
}
# Second level heading.
sub cmd_head2 {
my $self = shift;
$self->{level} = 2;
$self->cmd_head (@_);
}
# Third level heading.
sub cmd_head3 {
my $self = shift;
$self->{level} = 3;
$self->cmd_head (@_);
}
sub cmd_head4 {
my $self = shift;
# <refsect4> doesnt exist -- we would use <refsection>
# when it becomes available in 4.4
printf STDERR "=head4 being rendered as <refsect3>\n";
$self->{level} = 3;
$self->cmd_head (@_);
}
# Start a list.
sub cmd_over {
my $self = shift;
local $_ = shift;
unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
push (@{ $$self{LSTATE} }, $$self{lopen});
push (@{ $$self{LSTATE} }, $$self{ltype});
undef $self->{ltype};
$$self{lopen} = 0;
}
# End a list.
sub cmd_back {
my $self = shift;
if ($self->{ltype} == 2) {
$self->{MARGIN} -= 2;
$self->output ("</listitem>\n");
$self->{MARGIN} -= 2;
$self->output ("</orderedlist>\n");
} elsif ($self->{ltype} == 1) {
$self->{MARGIN} -= 2;
$self->output ("</listitem>\n");
$self->{MARGIN} -= 2;
$self->output ("</itemizedlist>\n");
} else {
$self->{MARGIN} -= 2;
$self->output ("</listitem>\n");
$self->{MARGIN} -= 2;
$self->output ("</varlistentry>\n");
$self->{MARGIN} -= 2;
$self->output ("</variablelist>\n");
}
$$self{ltype} = pop @{ $$self{LSTATE} };
$$self{lopen} = pop @{ $$self{LSTATE} };
unless (defined $$self{LSTATE}) {
carp "Unmatched =back";
$$self{MARGIN} = $$self{indent};
}
}
# An individual list item.
sub cmd_item {
my $self = shift;
if (defined $$self{ITEM}) { $self->item }
local $_ = shift;
my $line = shift;
s/\s+$//;
$$self{ITEM} = $self->parse_text(
{ -expand_text => q(escapes),
-expand_seq => q(sequence) },
$_, $line ) -> raw_text();
}
# Begin a block for a particular translator. Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
my $self = shift;
local $_ = shift;
my ($kind) = /^(\S+)/ or return;
if ($kind eq 'text') {
$$self{VERBATIM} = 1;
} else {
$$self{EXCLUDE} = 1;
}
}
# End a block for a particular translator. We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
my $self = shift;
$$self{EXCLUDE} = 0;
$$self{VERBATIM} = 0;
}
# One paragraph for a particular translator. Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
my $self = shift;
local $_ = shift;
my $line = shift;
return unless s/^text\b[ \t]*\n?//;
$self->verbatim ($_, $line);
}
# The complicated one. Handle links. Since this is plain text, we can't
# actually make any real links, so this is all to figure out what text we
# print out.
sub seq_l {
my ($self, $seq) = @_;
s/>$//; # remove trailing >
# Smash whitespace in case we were split across multiple lines.
s/\s+/ /g;
# If we were given any explicit text, just output it.
if (/^([^|]+)\|/) { return $1 }
# Okay, leading and trailing whitespace isn't important; get rid of it.
s/^\s+//;
s/\s+$//;
# Default to using the whole content of the link entry as a section
# name. Note that L<manpage/> forces a manpage interpretation, as does
# something looking like L<manpage(section)>. The latter is an
# enhancement over the original Pod::Text.
my ($manpage, $section) = ('', $_);
if (/^(?:https?|ftp|news):/) {
# a URL
return $_;
} elsif (/^"\s*(.*?)\s*"$/) {
$section = '"' . $1 . '"';
} elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
($manpage, $section) = ($_, '');
} elsif (m%/%) {
($manpage, $section) = split (/\s*\/\s*/, $_, 2);
}
$seq->cmd_name("");
# Now build the actual output text.
if (length $section) {
$section =~ s/^\"\s*//;
$section =~ s/\s*\"$//;
$_ = $section;
$_ .= " in $manpage" if length $manpage;
}
if (length $manpage) {
my $linkend = $manpage;
$linkend =~ s/[\(\)]//g;
$linkend =~ s/[ ,\.]/_/g; # this needs to match <refentry id=
$seq->prepend("<link linkend=\"$linkend\">");
$seq->append("</link>");
return $seq;
} else {
return $_;
}
}
# This method is called whenever an =item command is complete (in other
# words, we've seen its associated paragraph or know for certain that it
# doesn't have one). It gets the paragraph associated with the item as an
# argument. If that argument is empty, just output the item tag; if it
# contains a newline, output the item tag followed by the newline.
# Otherwise, see if there's enough room for us to output the item tag in the
# margin of the text or if we have to put it on a separate line.
sub item {
my $self = shift;
local $_ = shift;
my $tag = $$self{ITEM};
unless (defined $tag) {
carp "item called without tag";
return;
}
undef $$self{ITEM};
if ($$self{lopen}) {
if ($self->{ltype} == 1 || $self->{ltype} == 2) {
$self->{MARGIN} -= 2;
$self->output ("</listitem>\n");
} else {
$self->{MARGIN} -= 2;
$self->output ("</listitem>\n");
$self->{MARGIN} -= 2;
$self->output ("</varlistentry>\n");
}
}
my $output = $_;
$output =~ s/\n*$/\n/;
if (!defined $self->{ltype}) {
if ($tag =~ /[0-9]+\./) {
$self->{ltype} = 2;
$self->output ("<orderedlist>\n");
} elsif ($tag =~ /^\*$/) {
$self->{ltype} = 1;
$self->output ("<itemizedlist>\n");
} else {
$self->{ltype} = 0;
$self->output ("<variablelist>\n");
}
$self->{MARGIN} += 2;
}
if ($self->{ltype} == 1 || $self->{ltype} == 2) {
$self->output ("<listitem>\n");
$self->{MARGIN} += 2;
s/\n+$//;
$self->output ("<para>" . $_ . "<\/para>" . "\n\n");
} else {
$self->output ("<varlistentry>\n");
$self->{MARGIN} += 2;
$self->output ("<term>" . $tag . "</term>" . "\n");
$self->output ("<listitem>\n");
$self->{MARGIN} += 2;
s/\n+$//;
$self->output ("<para>" . $_ . "<\/para>" . "\n\n");
}
$$self{lopen} = 1;
}
# Output text to the output device.
sub output {
my $self = shift;
local $_ = shift;
s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
print { $self->output_handle } $_;
}
1;
# pod2refentry -- Convert POD data to DocBook RefEntry
#
# Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# based on:
#
# pod2text -- Convert POD data to formatted ASCII text.
#
# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
package main;
require 5.004;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use strict;
# Silence -w warnings.
use vars qw($running_under_some_shell);
# Insert -- into @ARGV before any single dash argument to hide it from
# Getopt::Long; we want to interpret it as meaning stdin (which Pod::Parser
# does correctly).
my $stdin;
@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
# Parse our options.
my %options;
GetOptions (\%options, 'help|h', 'indent|i=i', 'section|s=i' ) or exit 1;
pod2usage (1) if $options{help};
# Initialize and run the formatter.
my $parser = Pod::RefEntry->new (%options);
$parser->parse_from_file (@ARGV);