diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
commit | 316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch) | |
tree | cb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/Pod/Man.pm | |
parent | cd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff) |
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Man.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Pod/Man.pm | 1764 |
1 files changed, 0 insertions, 1764 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Man.pm b/Master/tlpkg/tlperl/lib/Pod/Man.pm deleted file mode 100755 index 9339f835bbc..00000000000 --- a/Master/tlpkg/tlperl/lib/Pod/Man.pm +++ /dev/null @@ -1,1764 +0,0 @@ -# Pod::Man -- Convert POD data to formatted *roff input. -# -# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -# Russ Allbery <rra@stanford.edu> -# Substantial contributions by Sean Burke <sburke@cpan.org> -# -# This program is free software; you may redistribute it and/or modify it -# under the same terms as Perl itself. -# -# This module translates POD documentation into *roff markup using the man -# macro set, and is intended for converting POD documents written as Unix -# manual pages to manual pages that can be read by the man(1) command. It is -# a replacement for the pod2man command distributed with versions of Perl -# prior to 5.6. -# -# Perl core hackers, please note that this module is also separately -# maintained outside of the Perl core as part of the podlators. Please send -# me any patches at the address above in addition to sending them to the -# standard Perl mailing lists. - -############################################################################## -# Modules and declarations -############################################################################## - -package Pod::Man; - -require 5.005; - -use strict; -use subs qw(makespace); -use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); - -use Carp qw(croak); -use Pod::Simple (); - -@ISA = qw(Pod::Simple); - -$VERSION = '2.23'; - -# Set the debugging level. If someone has inserted a debug function into this -# class already, use that. Otherwise, use any Pod::Simple debug function -# that's defined, and failing that, define a debug level of 10. -BEGIN { - my $parent = defined (&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG : undef; - unless (defined &DEBUG) { - *DEBUG = $parent || sub () { 10 }; - } -} - -# Import the ASCII constant from Pod::Simple. This is true iff we're in an -# ASCII-based universe (including such things as ISO 8859-1 and UTF-8), and is -# generally only false for EBCDIC. -BEGIN { *ASCII = \&Pod::Simple::ASCII } - -# Pretty-print a data structure. Only used for debugging. -BEGIN { *pretty = \&Pod::Simple::pretty } - -############################################################################## -# Object initialization -############################################################################## - -# Initialize the object and set various Pod::Simple options that we need. -# Here, we also process any additional options passed to the constructor or -# set up defaults if none were given. Note that all internal object keys are -# in all-caps, reserving all lower-case object keys for Pod::Simple and user -# arguments. -sub new { - my $class = shift; - my $self = $class->SUPER::new; - - # Tell Pod::Simple not to handle S<> by automatically inserting . - $self->nbsp_for_S (1); - - # Tell Pod::Simple to keep whitespace whenever possible. - if ($self->can ('preserve_whitespace')) { - $self->preserve_whitespace (1); - } else { - $self->fullstop_space_harden (1); - } - - # The =for and =begin targets that we accept. - $self->accept_targets (qw/man MAN roff ROFF/); - - # Ensure that contiguous blocks of code are merged together. Otherwise, - # some of the guesswork heuristics don't work right. - $self->merge_text (1); - - # Pod::Simple doesn't do anything useful with our arguments, but we want - # to put them in our object as hash keys and values. This could cause - # problems if we ever clash with Pod::Simple's own internal class - # variables. - %$self = (%$self, @_); - - # Send errors to stderr if requested. - if ($$self{stderr}) { - $self->no_errata_section (1); - $self->complain_stderr (1); - delete $$self{stderr}; - } - - # Initialize various other internal constants based on our arguments. - $self->init_fonts; - $self->init_quotes; - $self->init_page; - - # For right now, default to turning on all of the magic. - $$self{MAGIC_CPP} = 1; - $$self{MAGIC_EMDASH} = 1; - $$self{MAGIC_FUNC} = 1; - $$self{MAGIC_MANREF} = 1; - $$self{MAGIC_SMALLCAPS} = 1; - $$self{MAGIC_VARS} = 1; - - return $self; -} - -# Translate a font string into an escape. -sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } - -# Determine which fonts the user wishes to use and store them in the object. -# Regular, italic, bold, and bold-italic are constants, but the fixed width -# fonts may be set by the user. Sets the internal hash key FONTS which is -# used to map our internal font escapes to actual *roff sequences later. -sub init_fonts { - my ($self) = @_; - - # Figure out the fixed-width font. If user-supplied, make sure that they - # are the right length. - for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { - my $font = $$self{$_}; - if (defined ($font) && (length ($font) < 1 || length ($font) > 2)) { - croak qq(roff font should be 1 or 2 chars, not "$font"); - } - } - - # Set the default fonts. We can't be sure portably across different - # implementations what fixed bold-italic may be called (if it's even - # available), so default to just bold. - $$self{fixed} ||= 'CW'; - $$self{fixedbold} ||= 'CB'; - $$self{fixeditalic} ||= 'CI'; - $$self{fixedbolditalic} ||= 'CB'; - - # Set up a table of font escapes. First number is fixed-width, second is - # bold, third is italic. - $$self{FONTS} = { '000' => '\fR', '001' => '\fI', - '010' => '\fB', '011' => '\f(BI', - '100' => toescape ($$self{fixed}), - '101' => toescape ($$self{fixeditalic}), - '110' => toescape ($$self{fixedbold}), - '111' => toescape ($$self{fixedbolditalic}) }; -} - -# Initialize the quotes that we'll be using for C<> text. This requires some -# special handling, both to parse the user parameter if given and to make sure -# that the quotes will be safe against *roff. Sets the internal hash keys -# LQUOTE and RQUOTE. -sub init_quotes { - my ($self) = (@_); - - $$self{quotes} ||= '"'; - if ($$self{quotes} eq 'none') { - $$self{LQUOTE} = $$self{RQUOTE} = ''; - } elsif (length ($$self{quotes}) == 1) { - $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; - } elsif ($$self{quotes} =~ /^(.)(.)$/ - || $$self{quotes} =~ /^(..)(..)$/) { - $$self{LQUOTE} = $1; - $$self{RQUOTE} = $2; - } else { - croak(qq(Invalid quote specification "$$self{quotes}")) - } - - # Double the first quote; note that this should not be s///g as two double - # quotes is represented in *roff as three double quotes, not four. Weird, - # I know. - $$self{LQUOTE} =~ s/\"/\"\"/; - $$self{RQUOTE} =~ s/\"/\"\"/; -} - -# Initialize the page title information and indentation from our arguments. -sub init_page { - my ($self) = @_; - - # We used to try first to get the version number from a local binary, but - # we shouldn't need that any more. Get the version from the running Perl. - # Work a little magic to handle subversions correctly under both the - # pre-5.6 and the post-5.6 version numbering schemes. - my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); - $version[2] ||= 0; - $version[2] *= 10 ** (3 - length $version[2]); - for (@version) { $_ += 0 } - my $version = join ('.', @version); - - # Set the defaults for page titles and indentation if the user didn't - # override anything. - $$self{center} = 'User Contributed Perl Documentation' - unless defined $$self{center}; - $$self{release} = 'perl v' . $version - unless defined $$self{release}; - $$self{indent} = 4 - unless defined $$self{indent}; - - # Double quotes in things that will be quoted. - for (qw/center release/) { - $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; - } -} - -############################################################################## -# Core parsing -############################################################################## - -# This is the glue that connects the code below with Pod::Simple itself. The -# goal is to convert the event stream coming from the POD parser into method -# calls to handlers once the complete content of a tag has been seen. Each -# paragraph or POD command will have textual content associated with it, and -# as soon as all of a paragraph or POD command has been seen, that content -# will be passed in to the corresponding method for handling that type of -# object. The exceptions are handlers for lists, which have opening tag -# handlers and closing tag handlers that will be called right away. -# -# The internal hash key PENDING is used to store the contents of a tag until -# all of it has been seen. It holds a stack of open tags, each one -# represented by a tuple of the attributes hash for the tag, formatting -# options for the tag (which are inherited), and the contents of the tag. - -# Add a block of text to the contents of the current node, formatting it -# according to the current formatting instructions as we do. -sub _handle_text { - my ($self, $text) = @_; - DEBUG > 3 and print "== $text\n"; - my $tag = $$self{PENDING}[-1]; - $$tag[2] .= $self->format_text ($$tag[1], $text); -} - -# Given an element name, get the corresponding method name. -sub method_for_element { - my ($self, $element) = @_; - $element =~ tr/-/_/; - $element =~ tr/A-Z/a-z/; - $element =~ tr/_a-z0-9//cd; - return $element; -} - -# Handle the start of a new element. If cmd_element is defined, assume that -# we need to collect the entire tree for this element before passing it to the -# element method, and create a new tree into which we'll collect blocks of -# text and nested elements. Otherwise, if start_element is defined, call it. -sub _handle_element_start { - my ($self, $element, $attrs) = @_; - DEBUG > 3 and print "++ $element (<", join ('> <', %$attrs), ">)\n"; - my $method = $self->method_for_element ($element); - - # If we have a command handler, we need to accumulate the contents of the - # tag before calling it. Turn off IN_NAME for any command other than - # <Para> and the formatting codes so that IN_NAME isn't still set for the - # first heading after the NAME heading. - if ($self->can ("cmd_$method")) { - DEBUG > 2 and print "<$element> starts saving a tag\n"; - $$self{IN_NAME} = 0 if ($element ne 'Para' && length ($element) > 1); - - # How we're going to format embedded text blocks depends on the tag - # and also depends on our parent tags. Thankfully, inside tags that - # turn off guesswork and reformatting, nothing else can turn it back - # on, so this can be strictly inherited. - my $formatting = $$self{PENDING}[-1][1]; - $formatting = $self->formatting ($formatting, $element); - push (@{ $$self{PENDING} }, [ $attrs, $formatting, '' ]); - DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; - } elsif ($self->can ("start_$method")) { - my $method = 'start_' . $method; - $self->$method ($attrs, ''); - } else { - DEBUG > 2 and print "No $method start method, skipping\n"; - } -} - -# Handle the end of an element. If we had a cmd_ method for this element, -# this is where we pass along the tree that we built. Otherwise, if we have -# an end_ method for the element, call that. -sub _handle_element_end { - my ($self, $element) = @_; - DEBUG > 3 and print "-- $element\n"; - my $method = $self->method_for_element ($element); - - # If we have a command handler, pull off the pending text and pass it to - # the handler along with the saved attribute hash. - if ($self->can ("cmd_$method")) { - DEBUG > 2 and print "</$element> stops saving a tag\n"; - my $tag = pop @{ $$self{PENDING} }; - DEBUG > 4 and print "Popped: [", pretty ($tag), "]\n"; - DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; - my $method = 'cmd_' . $method; - my $text = $self->$method ($$tag[0], $$tag[2]); - if (defined $text) { - if (@{ $$self{PENDING} } > 1) { - $$self{PENDING}[-1][2] .= $text; - } else { - $self->output ($text); - } - } - } elsif ($self->can ("end_$method")) { - my $method = 'end_' . $method; - $self->$method (); - } else { - DEBUG > 2 and print "No $method end method, skipping\n"; - } -} - -############################################################################## -# General formatting -############################################################################## - -# Return formatting instructions for a new block. Takes the current -# formatting and the new element. Formatting inherits negatively, in the -# sense that if the parent has turned off guesswork, all child elements should -# leave it off. We therefore return a copy of the same formatting -# instructions but possibly with more things turned off depending on the -# element. -sub formatting { - my ($self, $current, $element) = @_; - my %options; - if ($current) { - %options = %$current; - } else { - %options = (guesswork => 1, cleanup => 1, convert => 1); - } - if ($element eq 'Data') { - $options{guesswork} = 0; - $options{cleanup} = 0; - $options{convert} = 0; - } elsif ($element eq 'X') { - $options{guesswork} = 0; - $options{cleanup} = 0; - } elsif ($element eq 'Verbatim' || $element eq 'C') { - $options{guesswork} = 0; - $options{literal} = 1; - } - return \%options; -} - -# Format a text block. Takes a hash of formatting options and the text to -# format. Currently, the only formatting options are guesswork, cleanup, and -# convert, all of which are boolean. -sub format_text { - my ($self, $options, $text) = @_; - my $guesswork = $$options{guesswork} && !$$self{IN_NAME}; - my $cleanup = $$options{cleanup}; - my $convert = $$options{convert}; - my $literal = $$options{literal}; - - # Cleanup just tidies up a few things, telling *roff that the hyphens are - # hard, putting a bit of space between consecutive underscores, and - # escaping backslashes. Be careful not to mangle our character - # translations by doing this before processing character translation. - if ($cleanup) { - $text =~ s/\\/\\e/g; - $text =~ s/-/\\-/g; - $text =~ s/_(?=_)/_\\|/g; - } - - # Normally we do character translation, but we won't even do that in - # <Data> blocks or if UTF-8 output is desired. - if ($convert && !$$self{utf8} && ASCII) { - $text =~ s/([^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg; - } - - # Ensure that *roff doesn't convert literal quotes to UTF-8 single quotes, - # but don't mess up our accept escapes. - if ($literal) { - $text =~ s/(?<!\\\*)\'/\\*\(Aq/g; - $text =~ s/(?<!\\\*)\`/\\\`/g; - } - - # If guesswork is asked for, do that. This involves more substantial - # formatting based on various heuristics that may only be appropriate for - # particular documents. - if ($guesswork) { - $text = $self->guesswork ($text); - } - - return $text; -} - -# Handles C<> text, deciding whether to put \*C` around it or not. This is a -# whole bunch of messy heuristics to try to avoid overquoting, originally from -# Barrie Slaymaker. This largely duplicates similar code in Pod::Text. -sub quote_literal { - my $self = shift; - local $_ = shift; - - # A regex that matches the portion of a variable reference that's the - # array or hash index, separated out just because we want to use it in - # several places in the following regex. - my $index = '(?: \[.*\] | \{.*\} )?'; - - # If in NAME section, just return an ASCII quoted string to avoid - # confusing tools like whatis. - return qq{"$_"} if $$self{IN_NAME}; - - # Check for things that we don't want to quote, and if we find any of - # them, return the string with just a font change and no quoting. - m{ - ^\s* - (?: - ( [\'\`\"] ) .* \1 # already quoted - | \\\*\(Aq .* \\\*\(Aq # quoted and escaped - | \\?\` .* ( \' | \\\*\(Aq ) # `quoted' - | \$+ [\#^]? \S $index # special ($^Foo, $") - | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func - | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call - | [-+]? ( \d[\d.]* | \.\d+ ) (?: [eE][-+]?\d+ )? # a number - | 0x [a-fA-F\d]+ # a hex constant - ) - \s*\z - }xso and return '\f(FS' . $_ . '\f(FE'; - - # If we didn't return, go ahead and quote the text. - return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"; -} - -# Takes a text block to perform guesswork on. Returns the text block with -# formatting codes added. This is the code that marks up various Perl -# constructs and things commonly used in man pages without requiring the user -# to add any explicit markup, and is applied to all non-literal text. We're -# guaranteed that the text we're applying guesswork to does not contain any -# *roff formatting codes. Note that the inserted font sequences must be -# treated later with mapfonts or textmapfonts. -# -# This method is very fragile, both in the regular expressions it uses and in -# the ordering of those modifications. Care and testing is required when -# modifying it. -sub guesswork { - my $self = shift; - local $_ = shift; - DEBUG > 5 and print " Guesswork called on [$_]\n"; - - # By the time we reach this point, all hypens will be escaped by adding a - # backslash. We want to undo that escaping if they're part of regular - # words and there's only a single dash, since that's a real hyphen that - # *roff gets to consider a possible break point. Make sure that a dash - # after the first character of a word stays non-breaking, however. - # - # Note that this is not user-controllable; we pretty much have to do this - # transformation or *roff will mangle the output in unacceptable ways. - s{ - ( (?:\G|^|\s) [\(\"]* [a-zA-Z] ) ( \\- )? - ( (?: [a-zA-Z\']+ \\-)+ ) - ( [a-zA-Z\']+ ) (?= [\)\".?!,;:]* (?:\s|\Z|\\\ ) ) - \b - } { - my ($prefix, $hyphen, $main, $suffix) = ($1, $2, $3, $4); - $hyphen ||= ''; - $main =~ s/\\-/-/g; - $prefix . $hyphen . $main . $suffix; - }egx; - - # Translate "--" into a real em-dash if it's used like one. This means - # that it's either surrounded by whitespace, it follows a regular word, or - # it occurs between two regular words. - if ($$self{MAGIC_EMDASH}) { - s{ (\s) \\-\\- (\s) } { $1 . '\*(--' . $2 }egx; - s{ (\b[a-zA-Z]+) \\-\\- (\s|\Z|[a-zA-Z]+\b) } { $1 . '\*(--' . $2 }egx; - } - - # Make words in all-caps a little bit smaller; they look better that way. - # However, we don't want to change Perl code (like @ARGV), nor do we want - # to fix the MIME in MIME-Version since it looks weird with the - # full-height V. - # - # We change only a string of all caps (2) either at the beginning of the - # line or following regular punctuation (like quotes) or whitespace (1), - # and followed by either similar punctuation, an em-dash, or the end of - # the line (3). - if ($$self{MAGIC_SMALLCAPS}) { - s{ - ( ^ | [\s\(\"\'\`\[\{<>] | \\\ ) # (1) - ( [A-Z] [A-Z] (?: [/A-Z+:\d_\$&] | \\- )* ) # (2) - (?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\\ | $ ) # (3) - } { - $1 . '\s-1' . $2 . '\s0' - }egx; - } - - # Note that from this point forward, we have to adjust for \s-1 and \s-0 - # strings inserted around things that we've made small-caps if later - # transforms should work on those strings. - - # Italize functions in the form func(), including functions that are in - # all capitals, but don't italize if there's anything between the parens. - # The function must start with an alphabetic character or underscore and - # then consist of word characters or colons. - if ($$self{MAGIC_FUNC}) { - s{ - ( \b | \\s-1 ) - ( [A-Za-z_] ([:\w] | \\s-?[01])+ \(\) ) - } { - $1 . '\f(IS' . $2 . '\f(IE' - }egx; - } - - # Change references to manual pages to put the page name in italics but - # the number in the regular font, with a thin space between the name and - # the number. Only recognize func(n) where func starts with an alphabetic - # character or underscore and contains only word characters, periods (for - # configuration file man pages), or colons, and n is a single digit, - # optionally followed by some number of lowercase letters. Note that this - # does not recognize man page references like perl(l) or socket(3SOCKET). - if ($$self{MAGIC_MANREF}) { - s{ - ( \b | \\s-1 ) - ( [A-Za-z_] (?:[.:\w] | \\- | \\s-?[01])+ ) - ( \( \d [a-z]* \) ) - } { - $1 . '\f(IS' . $2 . '\f(IE\|' . $3 - }egx; - } - - # Convert simple Perl variable references to a fixed-width font. Be - # careful not to convert functions, though; there are too many subtleties - # with them to want to perform this transformation. - if ($$self{MAGIC_VARS}) { - s{ - ( ^ | \s+ ) - ( [\$\@%] [\w:]+ ) - (?! \( ) - } { - $1 . '\f(FS' . $2 . '\f(FE' - }egx; - } - - # Fix up double quotes. Unfortunately, we miss this transformation if the - # quoted text contains any code with formatting codes and there's not much - # we can effectively do about that, which makes it somewhat unclear if - # this is really a good idea. - s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx; - - # Make C++ into \*(C+, which is a squinched version. - if ($$self{MAGIC_CPP}) { - s{ \b C\+\+ } {\\*\(C+}gx; - } - - # Done. - DEBUG > 5 and print " Guesswork returning [$_]\n"; - return $_; -} - -############################################################################## -# Output -############################################################################## - -# When building up the *roff code, we don't use real *roff fonts. Instead, we -# embed font codes of the form \f(<font>[SE] where <font> is one of B, I, or -# F, S stands for start, and E stands for end. This method turns these into -# the right start and end codes. -# -# We add this level of complexity because the old pod2man didn't get code like -# B<someI<thing> else> right; after I<> it switched back to normal text rather -# than bold. We take care of this by using variables that state whether bold, -# italic, or fixed are turned on as a combined pointer to our current font -# sequence, and set each to the number of current nestings of start tags for -# that font. -# -# \fP changes to the previous font, but only one previous font is kept. We -# don't know what the outside level font is; normally it's R, but if we're -# inside a heading it could be something else. So arrange things so that the -# outside font is always the "previous" font and end with \fP instead of \fR. -# Idea from Zack Weinberg. -sub mapfonts { - my ($self, $text) = @_; - my ($fixed, $bold, $italic) = (0, 0, 0); - my %magic = (F => \$fixed, B => \$bold, I => \$italic); - my $last = '\fR'; - $text =~ s< - \\f\((.)(.) - > < - my $sequence = ''; - my $f; - if ($last ne '\fR') { $sequence = '\fP' } - ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; - $f = $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; - if ($f eq $last) { - ''; - } else { - if ($f ne '\fR') { $sequence .= $f } - $last = $f; - $sequence; - } - >gxe; - return $text; -} - -# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU -# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather -# than R, presumably because \f(CW doesn't actually do a font change. To work -# around this, use a separate textmapfonts for text blocks where the default -# font is always R and only use the smart mapfonts for headings. -sub textmapfonts { - my ($self, $text) = @_; - my ($fixed, $bold, $italic) = (0, 0, 0); - my %magic = (F => \$fixed, B => \$bold, I => \$italic); - $text =~ s< - \\f\((.)(.) - > < - ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; - $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; - >gxe; - return $text; -} - -# Given a command and a single argument that may or may not contain double -# quotes, handle double-quote formatting for it. If there are no double -# quotes, just return the command followed by the argument in double quotes. -# If there are double quotes, use an if statement to test for nroff, and for -# nroff output the command followed by the argument in double quotes with -# embedded double quotes doubled. For other formatters, remap paired double -# quotes to LQUOTE and RQUOTE. -sub switchquotes { - my ($self, $command, $text, $extra) = @_; - $text =~ s/\\\*\([LR]\"/\"/g; - - # We also have to deal with \*C` and \*C', which are used to add the - # quotes around C<> text, since they may expand to " and if they do this - # confuses the .SH macros and the like no end. Expand them ourselves. - # Also separate troff from nroff if there are any fixed-width fonts in use - # to work around problems with Solaris nroff. - my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); - my $fixedpat = join '|', @{ $$self{FONTS} }{'100', '101', '110', '111'}; - $fixedpat =~ s/\\/\\\\/g; - $fixedpat =~ s/\(/\\\(/g; - if ($text =~ m/\"/ || $text =~ m/$fixedpat/) { - $text =~ s/\"/\"\"/g; - my $nroff = $text; - my $troff = $text; - $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; - if ($c_is_quote and $text =~ m/\\\*\(C[\'\`]/) { - $nroff =~ s/\\\*\(C\`/$$self{LQUOTE}/g; - $nroff =~ s/\\\*\(C\'/$$self{RQUOTE}/g; - $troff =~ s/\\\*\(C[\'\`]//g; - } - $nroff = qq("$nroff") . ($extra ? " $extra" : ''); - $troff = qq("$troff") . ($extra ? " $extra" : ''); - - # Work around the Solaris nroff bug where \f(CW\fP leaves the font set - # to Roman rather than the actual previous font when used in headings. - # troff output may still be broken, but at least we can fix nroff by - # just switching the font changes to the non-fixed versions. - $nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f[PR]/$1/g; - $nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)\\f([PR])/\\fI$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)\\f([PR])/\\fB$1\\f$2/g; - $nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)\\f([PR])/\\f\(BI$1\\f$2/g; - - # Now finally output the command. Bother with .ie only if the nroff - # and troff output aren't the same. - if ($nroff ne $troff) { - return ".ie n $command $nroff\n.el $command $troff\n"; - } else { - return "$command $nroff\n"; - } - } else { - $text = qq("$text") . ($extra ? " $extra" : ''); - return "$command $text\n"; - } -} - -# Protect leading quotes and periods against interpretation as commands. Also -# protect anything starting with a backslash, since it could expand or hide -# something that *roff would interpret as a command. This is overkill, but -# it's much simpler than trying to parse *roff here. -sub protect { - my ($self, $text) = @_; - $text =~ s/^([.\'\\])/\\&$1/mg; - return $text; -} - -# Make vertical whitespace if NEEDSPACE is set, appropriate to the indentation -# level the situation. This function is needed since in *roff one has to -# create vertical whitespace after paragraphs and between some things, but -# other macros create their own whitespace. Also close out a sequence of -# repeated =items, since calling makespace means we're about to begin the item -# body. -sub makespace { - my ($self) = @_; - $self->output (".PD\n") if $$self{ITEMS} > 1; - $$self{ITEMS} = 0; - $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n") - if $$self{NEEDSPACE}; -} - -# Output any pending index entries, and optionally an index entry given as an -# argument. Support multiple index entries in X<> separated by slashes, and -# strip special escapes from index entries. -sub outindex { - my ($self, $section, $index) = @_; - my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; - return unless ($section || @entries); - - # We're about to output all pending entries, so clear our pending queue. - $$self{INDEX} = []; - - # Build the output. Regular index entries are marked Xref, and headings - # pass in their own section. Undo some *roff formatting on headings. - my @output; - if (@entries) { - push @output, [ 'Xref', join (' ', @entries) ]; - } - if ($section) { - $index =~ s/\\-/-/g; - $index =~ s/\\(?:s-?\d|.\(..|.)//g; - push @output, [ $section, $index ]; - } - - # Print out the .IX commands. - for (@output) { - my ($type, $entry) = @$_; - $entry =~ s/\"/\"\"/g; - $entry =~ s/\\/\\\\/g; - $self->output (".IX $type " . '"' . $entry . '"' . "\n"); - } -} - -# Output some text, without any additional changes. -sub output { - my ($self, @text) = @_; - print { $$self{output_fh} } @text; -} - -############################################################################## -# Document initialization -############################################################################## - -# Handle the start of the document. Here we handle empty documents, as well -# as setting up our basic macros in a preamble and building the page title. -sub start_document { - my ($self, $attrs) = @_; - if ($$attrs{contentless} && !$$self{ALWAYS_EMIT_SOMETHING}) { - DEBUG and print "Document is contentless\n"; - $$self{CONTENTLESS} = 1; - return; - } - - # If we were given the utf8 option, set an output encoding on our file - # handle. Wrap in an eval in case we're using a version of Perl too old - # to understand this. - # - # This is evil because it changes the global state of a file handle that - # we may not own. However, we can't just blindly encode all output, since - # there may be a pre-applied output encoding (such as from PERL_UNICODE) - # and then we would double-encode. This seems to be the least bad - # approach. - if ($$self{utf8}) { - eval { binmode ($$self{output_fh}, ':encoding(UTF-8)') }; - } - - # Determine information for the preamble and then output it. - my ($name, $section); - if (defined $$self{name}) { - $name = $$self{name}; - $section = $$self{section} || 1; - } else { - ($name, $section) = $self->devise_title; - } - my $date = $$self{date} || $self->devise_date; - $self->preamble ($name, $section, $date) - unless $self->bare_output or DEBUG > 9; - - # Initialize a few per-document variables. - $$self{INDENT} = 0; # Current indentation level. - $$self{INDENTS} = []; # Stack of indentations. - $$self{INDEX} = []; # Index keys waiting to be printed. - $$self{IN_NAME} = 0; # Whether processing the NAME section. - $$self{ITEMS} = 0; # The number of consecutive =items. - $$self{ITEMTYPES} = []; # Stack of =item types, one per list. - $$self{SHIFTWAIT} = 0; # Whether there is a shift waiting. - $$self{SHIFTS} = []; # Stack of .RS shifts. - $$self{PENDING} = [[]]; # Pending output. -} - -# Handle the end of the document. This does nothing but print out a final -# comment at the end of the document under debugging. -sub end_document { - my ($self) = @_; - return if $self->bare_output; - return if ($$self{CONTENTLESS} && !$$self{ALWAYS_EMIT_SOMETHING}); - $self->output (q(.\" [End document]) . "\n") if DEBUG; -} - -# Try to figure out the name and section from the file name and return them as -# a list, returning an empty name and section 1 if we can't find any better -# information. Uses File::Basename and File::Spec as necessary. -sub devise_title { - my ($self) = @_; - my $name = $self->source_filename || ''; - my $section = $$self{section} || 1; - $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); - $name =~ s/\.p(od|[lm])\z//i; - - # If the section isn't 3, then the name defaults to just the basename of - # the file. Otherwise, assume we're dealing with a module. We want to - # figure out the full module name from the path to the file, but we don't - # want to include too much of the path into the module name. Lose - # anything up to the first off: - # - # */lib/*perl*/ standard or site_perl module - # */*perl*/lib/ from -Dprefix=/opt/perl - # */*perl*/ random module hierarchy - # - # which works. Also strip off a leading site, site_perl, or vendor_perl - # component, any OS-specific component, and any version number component, - # and strip off an initial component of "lib" or "blib/lib" since that's - # what ExtUtils::MakeMaker creates. splitdir requires at least File::Spec - # 0.8. - if ($section !~ /^3/) { - require File::Basename; - $name = uc File::Basename::basename ($name); - } else { - require File::Spec; - my ($volume, $dirs, $file) = File::Spec->splitpath ($name); - my @dirs = File::Spec->splitdir ($dirs); - my $cut = 0; - my $i; - for ($i = 0; $i < @dirs; $i++) { - if ($dirs[$i] =~ /perl/) { - $cut = $i + 1; - $cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib'); - last; - } - } - if ($cut > 0) { - splice (@dirs, 0, $cut); - shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/); - shift @dirs if ($dirs[0] =~ /^[\d.]+$/); - shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/); - } - shift @dirs if $dirs[0] eq 'lib'; - splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib'); - - # Remove empty directories when building the module name; they - # occur too easily on Unix by doubling slashes. - $name = join ('::', (grep { $_ ? $_ : () } @dirs), $file); - } - return ($name, $section); -} - -# Determine the modification date and return that, properly formatted in ISO -# format. If we can't get the modification date of the input, instead use the -# current time. Pod::Simple returns a completely unuseful stringified file -# handle as the source_filename for input from a file handle, so we have to -# deal with that as well. -sub devise_date { - my ($self) = @_; - my $input = $self->source_filename; - my $time; - if ($input) { - $time = (stat $input)[9] || time; - } else { - $time = time; - } - - # Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker - # uses this and it has to work in the core which can't load dynamic - # libraries. - my ($year, $month, $day) = (localtime $time)[5,4,3]; - return sprintf ("%04d-%02d-%02d", $year + 1900, $month + 1, $day); -} - -# Print out the preamble and the title. The meaning of the arguments to .TH -# unfortunately vary by system; some systems consider the fourth argument to -# be a "source" and others use it as a version number. Generally it's just -# presented as the left-side footer, though, so it doesn't matter too much if -# a particular system gives it another interpretation. -# -# The order of date and release used to be reversed in older versions of this -# module, but this order is correct for both Solaris and Linux. -sub preamble { - my ($self, $name, $section, $date) = @_; - my $preamble = $self->preamble_template (!$$self{utf8}); - - # Build the index line and make sure that it will be syntactically valid. - my $index = "$name $section"; - $index =~ s/\"/\"\"/g; - - # If name or section contain spaces, quote them (section really never - # should, but we may as well be cautious). - for ($name, $section) { - if (/\s/) { - s/\"/\"\"/g; - $_ = '"' . $_ . '"'; - } - } - - # Double quotes in date, since it will be quoted. - $date =~ s/\"/\"\"/g; - - # Substitute into the preamble the configuration options. - $preamble =~ s/\@CFONT\@/$$self{fixed}/; - $preamble =~ s/\@LQUOTE\@/$$self{LQUOTE}/; - $preamble =~ s/\@RQUOTE\@/$$self{RQUOTE}/; - chomp $preamble; - - # Get the version information. - my $version = $self->version_report; - - # Finally output everything. - $self->output (<<"----END OF HEADER----"); -.\\" Automatically generated by $version -.\\" -.\\" Standard preamble: -.\\" ======================================================================== -$preamble -.\\" ======================================================================== -.\\" -.IX Title "$index" -.TH $name $section "$date" "$$self{release}" "$$self{center}" -.\\" For nroff, turn off justification. Always turn off hyphenation; it makes -.\\" way too many mistakes in technical documents. -.if n .ad l -.nh -----END OF HEADER---- - $self->output (".\\\" [End of preamble]\n") if DEBUG; -} - -############################################################################## -# Text blocks -############################################################################## - -# Handle a basic block of text. The only tricky part of this is if this is -# the first paragraph of text after an =over, in which case we have to change -# indentations for *roff. -sub cmd_para { - my ($self, $attrs, $text) = @_; - my $line = $$attrs{start_line}; - - # Output the paragraph. We also have to handle =over without =item. If - # there's an =over without =item, SHIFTWAIT will be set, and we need to - # handle creation of the indent here. Add the shift to SHIFTS so that it - # will be cleaned up on =back. - $self->makespace; - if ($$self{SHIFTWAIT}) { - $self->output (".RS $$self{INDENT}\n"); - push (@{ $$self{SHIFTS} }, $$self{INDENT}); - $$self{SHIFTWAIT} = 0; - } - - # Add the line number for debugging, but not in the NAME section just in - # case the comment would confuse apropos. - $self->output (".\\\" [At source line $line]\n") - if defined ($line) && DEBUG && !$$self{IN_NAME}; - - # Force exactly one newline at the end and strip unwanted trailing - # whitespace at the end. - $text =~ s/\s*$/\n/; - - # Output the paragraph. - $self->output ($self->protect ($self->textmapfonts ($text))); - $self->outindex; - $$self{NEEDSPACE} = 1; - return ''; -} - -# Handle a verbatim paragraph. Put a null token at the beginning of each line -# to protect against commands and wrap in .Vb/.Ve (which we define in our -# prelude). -sub cmd_verbatim { - my ($self, $attrs, $text) = @_; - - # Ignore an empty verbatim paragraph. - return unless $text =~ /\S/; - - # Force exactly one newline at the end and strip unwanted trailing - # whitespace at the end. - $text =~ s/\s*$/\n/; - - # Get a count of the number of lines before the first blank line, which - # we'll pass to .Vb as its parameter. This tells *roff to keep that many - # lines together. We don't want to tell *roff to keep huge blocks - # together. - my @lines = split (/\n/, $text); - my $unbroken = 0; - for (@lines) { - last if /^\s*$/; - $unbroken++; - } - $unbroken = 10 if ($unbroken > 12 && !$$self{MAGIC_VNOPAGEBREAK_LIMIT}); - - # Prepend a null token to each line. - $text =~ s/^/\\&/gm; - - # Output the results. - $self->makespace; - $self->output (".Vb $unbroken\n$text.Ve\n"); - $$self{NEEDSPACE} = 1; - return ''; -} - -# Handle literal text (produced by =for and similar constructs). Just output -# it with the minimum of changes. -sub cmd_data { - my ($self, $attrs, $text) = @_; - $text =~ s/^\n+//; - $text =~ s/\n{0,2}$/\n/; - $self->output ($text); - return ''; -} - -############################################################################## -# Headings -############################################################################## - -# Common code for all headings. This is called before the actual heading is -# output. It returns the cleaned up heading text (putting the heading all on -# one line) and may do other things, like closing bad =item blocks. -sub heading_common { - my ($self, $text, $line) = @_; - $text =~ s/\s+$//; - $text =~ s/\s*\n\s*/ /g; - - # This should never happen; it means that we have a heading after =item - # without an intervening =back. But just in case, handle it anyway. - if ($$self{ITEMS} > 1) { - $$self{ITEMS} = 0; - $self->output (".PD\n"); - } - - # Output the current source line. - $self->output ( ".\\\" [At source line $line]\n" ) - if defined ($line) && DEBUG; - return $text; -} - -# First level heading. We can't output .IX in the NAME section due to a bug -# in some versions of catman, so don't output a .IX for that section. .SH -# already uses small caps, so remove \s0 and \s-1. Maintain IN_NAME as -# appropriate. -sub cmd_head1 { - my ($self, $attrs, $text) = @_; - $text =~ s/\\s-?\d//g; - $text = $self->heading_common ($text, $$attrs{start_line}); - my $isname = ($text eq 'NAME' || $text =~ /\(NAME\)/); - $self->output ($self->switchquotes ('.SH', $self->mapfonts ($text))); - $self->outindex ('Header', $text) unless $isname; - $$self{NEEDSPACE} = 0; - $$self{IN_NAME} = $isname; - return ''; -} - -# Second level heading. -sub cmd_head2 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->output ($self->switchquotes ('.SS', $self->mapfonts ($text))); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 0; - return ''; -} - -# Third level heading. *roff doesn't have this concept, so just put the -# heading in italics as a normal paragraph. -sub cmd_head3 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->makespace; - $self->output ($self->textmapfonts ('\f(IS' . $text . '\f(IE') . "\n"); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 1; - return ''; -} - -# Fourth level heading. *roff doesn't have this concept, so just put the -# heading as a normal paragraph. -sub cmd_head4 { - my ($self, $attrs, $text) = @_; - $text = $self->heading_common ($text, $$attrs{start_line}); - $self->makespace; - $self->output ($self->textmapfonts ($text) . "\n"); - $self->outindex ('Subsection', $text); - $$self{NEEDSPACE} = 1; - return ''; -} - -############################################################################## -# Formatting codes -############################################################################## - -# All of the formatting codes that aren't handled internally by the parser, -# other than L<> and X<>. -sub cmd_b { return $_[0]->{IN_NAME} ? $_[2] : '\f(BS' . $_[2] . '\f(BE' } -sub cmd_i { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' } -sub cmd_f { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' } -sub cmd_c { return $_[0]->quote_literal ($_[2]) } - -# Index entries are just added to the pending entries. -sub cmd_x { - my ($self, $attrs, $text) = @_; - push (@{ $$self{INDEX} }, $text); - return ''; -} - -# Links reduce to the text that we're given, wrapped in angle brackets if it's -# a URL. -sub cmd_l { - my ($self, $attrs, $text) = @_; - if ($$attrs{type} eq 'url') { - if (not defined($$attrs{to}) or $$attrs{to} eq $text) { - return "<$text>"; - } else { - return "$text <$$attrs{to}>"; - } - } else { - return $text; - } -} - -############################################################################## -# List handling -############################################################################## - -# Handle the beginning of an =over block. Takes the type of the block as the -# first argument, and then the attr hash. This is called by the handlers for -# the four different types of lists (bullet, number, text, and block). -sub over_common_start { - my ($self, $type, $attrs) = @_; - my $line = $$attrs{start_line}; - my $indent = $$attrs{indent}; - DEBUG > 3 and print " Starting =over $type (line $line, indent ", - ($indent || '?'), "\n"; - - # Find the indentation level. - unless (defined ($indent) && $indent =~ /^[-+]?\d{1,4}\s*$/) { - $indent = $$self{indent}; - } - - # If we've gotten multiple indentations in a row, we need to emit the - # pending indentation for the last level that we saw and haven't acted on - # yet. SHIFTS is the stack of indentations that we've actually emitted - # code for. - if (@{ $$self{SHIFTS} } < @{ $$self{INDENTS} }) { - $self->output (".RS $$self{INDENT}\n"); - push (@{ $$self{SHIFTS} }, $$self{INDENT}); - } - - # Now, do record-keeping. INDENTS is a stack of indentations that we've - # seen so far, and INDENT is the current level of indentation. ITEMTYPES - # is a stack of list types that we've seen. - push (@{ $$self{INDENTS} }, $$self{INDENT}); - push (@{ $$self{ITEMTYPES} }, $type); - $$self{INDENT} = $indent + 0; - $$self{SHIFTWAIT} = 1; -} - -# End an =over block. Takes no options other than the class pointer. -# Normally, once we close a block and therefore remove something from INDENTS, -# INDENTS will now be longer than SHIFTS, indicating that we also need to emit -# *roff code to close the indent. This isn't *always* true, depending on the -# circumstance. If we're still inside an indentation, we need to emit another -# .RE and then a new .RS to unconfuse *roff. -sub over_common_end { - my ($self) = @_; - DEBUG > 3 and print " Ending =over\n"; - $$self{INDENT} = pop @{ $$self{INDENTS} }; - pop @{ $$self{ITEMTYPES} }; - - # If we emitted code for that indentation, end it. - if (@{ $$self{SHIFTS} } > @{ $$self{INDENTS} }) { - $self->output (".RE\n"); - pop @{ $$self{SHIFTS} }; - } - - # If we're still in an indentation, *roff will have now lost track of the - # right depth of that indentation, so fix that. - if (@{ $$self{INDENTS} } > 0) { - $self->output (".RE\n"); - $self->output (".RS $$self{INDENT}\n"); - } - $$self{NEEDSPACE} = 1; - $$self{SHIFTWAIT} = 0; -} - -# Dispatch the start and end calls as appropriate. -sub start_over_bullet { my $s = shift; $s->over_common_start ('bullet', @_) } -sub start_over_number { my $s = shift; $s->over_common_start ('number', @_) } -sub start_over_text { my $s = shift; $s->over_common_start ('text', @_) } -sub start_over_block { my $s = shift; $s->over_common_start ('block', @_) } -sub end_over_bullet { $_[0]->over_common_end } -sub end_over_number { $_[0]->over_common_end } -sub end_over_text { $_[0]->over_common_end } -sub end_over_block { $_[0]->over_common_end } - -# The common handler for all item commands. Takes the type of the item, the -# attributes, and then the text of the item. -# -# Emit an index entry for anything that's interesting, but don't emit index -# entries for things like bullets and numbers. Newlines in an item title are -# turned into spaces since *roff can't handle them embedded. -sub item_common { - my ($self, $type, $attrs, $text) = @_; - my $line = $$attrs{start_line}; - DEBUG > 3 and print " $type item (line $line): $text\n"; - - # Clean up the text. We want to end up with two variables, one ($text) - # which contains any body text after taking out the item portion, and - # another ($item) which contains the actual item text. - $text =~ s/\s+$//; - my ($item, $index); - if ($type eq 'bullet') { - $item = "\\\(bu"; - $text =~ s/\n*$/\n/; - } elsif ($type eq 'number') { - $item = $$attrs{number} . '.'; - } else { - $item = $text; - $item =~ s/\s*\n\s*/ /g; - $text = ''; - $index = $item if ($item =~ /\w/); - } - - # Take care of the indentation. If shifts and indents are equal, close - # the top shift, since we're about to create an indentation with .IP. - # Also output .PD 0 to turn off spacing between items if this item is - # directly following another one. We only have to do that once for a - # whole chain of items so do it for the second item in the change. Note - # that makespace is what undoes this. - if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) { - $self->output (".RE\n"); - pop @{ $$self{SHIFTS} }; - } - $self->output (".PD 0\n") if ($$self{ITEMS} == 1); - - # Now, output the item tag itself. - $item = $self->textmapfonts ($item); - $self->output ($self->switchquotes ('.IP', $item, $$self{INDENT})); - $$self{NEEDSPACE} = 0; - $$self{ITEMS}++; - $$self{SHIFTWAIT} = 0; - - # If body text for this item was included, go ahead and output that now. - if ($text) { - $text =~ s/\s*$/\n/; - $self->makespace; - $self->output ($self->protect ($self->textmapfonts ($text))); - $$self{NEEDSPACE} = 1; - } - $self->outindex ($index ? ('Item', $index) : ()); -} - -# Dispatch the item commands to the appropriate place. -sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) } -sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) } -sub cmd_item_text { my $self = shift; $self->item_common ('text', @_) } -sub cmd_item_block { my $self = shift; $self->item_common ('block', @_) } - -############################################################################## -# Backward compatibility -############################################################################## - -# Reset the underlying Pod::Simple object between calls to parse_from_file so -# that the same object can be reused to convert multiple pages. -sub parse_from_file { - my $self = shift; - $self->reinit; - - # Fake the old cutting option to Pod::Parser. This fiddings with internal - # Pod::Simple state and is quite ugly; we need a better approach. - if (ref ($_[0]) eq 'HASH') { - my $opts = shift @_; - if (defined ($$opts{-cutting}) && !$$opts{-cutting}) { - $$self{in_pod} = 1; - $$self{last_was_blank} = 1; - } - } - - # Do the work. - my $retval = $self->SUPER::parse_from_file (@_); - - # Flush output, since Pod::Simple doesn't do this. Ideally we should also - # close the file descriptor if we had to open one, but we can't easily - # figure this out. - my $fh = $self->output_fh (); - my $oldfh = select $fh; - my $oldflush = $|; - $| = 1; - print $fh ''; - $| = $oldflush; - select $oldfh; - return $retval; -} - -# Pod::Simple failed to provide this backward compatibility function, so -# implement it ourselves. File handles are one of the inputs that -# parse_from_file supports. -sub parse_from_filehandle { - my $self = shift; - $self->parse_from_file (@_); -} - -############################################################################## -# Translation tables -############################################################################## - -# The following table is adapted from Tom Christiansen's pod2man. It assumes -# that the standard preamble has already been printed, since that's what -# defines all of the accent marks. We really want to do something better than -# this when *roff actually supports other character sets itself, since these -# results are pretty poor. -# -# This only works in an ASCII world. What to do in a non-ASCII world is very -# unclear -- hopefully we can assume UTF-8 and just leave well enough alone. -@ESCAPES{0xA0 .. 0xFF} = ( - "\\ ", undef, undef, undef, undef, undef, undef, undef, - undef, undef, undef, undef, undef, "\\%", undef, undef, - - undef, undef, undef, undef, undef, undef, undef, undef, - undef, undef, undef, undef, undef, undef, undef, undef, - - "A\\*`", "A\\*'", "A\\*^", "A\\*~", "A\\*:", "A\\*o", "\\*(AE", "C\\*,", - "E\\*`", "E\\*'", "E\\*^", "E\\*:", "I\\*`", "I\\*'", "I\\*^", "I\\*:", - - "\\*(D-", "N\\*~", "O\\*`", "O\\*'", "O\\*^", "O\\*~", "O\\*:", undef, - "O\\*/", "U\\*`", "U\\*'", "U\\*^", "U\\*:", "Y\\*'", "\\*(Th", "\\*8", - - "a\\*`", "a\\*'", "a\\*^", "a\\*~", "a\\*:", "a\\*o", "\\*(ae", "c\\*,", - "e\\*`", "e\\*'", "e\\*^", "e\\*:", "i\\*`", "i\\*'", "i\\*^", "i\\*:", - - "\\*(d-", "n\\*~", "o\\*`", "o\\*'", "o\\*^", "o\\*~", "o\\*:", undef, - "o\\*/" , "u\\*`", "u\\*'", "u\\*^", "u\\*:", "y\\*'", "\\*(th", "y\\*:", -) if ASCII; - -############################################################################## -# Premable -############################################################################## - -# The following is the static preamble which starts all *roff output we -# generate. Most is static except for the font to use as a fixed-width font, -# which is designed by @CFONT@, and the left and right quotes to use for C<> -# text, designated by @LQOUTE@ and @RQUOTE@. However, the second part, which -# defines the accent marks, is only used if $escapes is set to true. -sub preamble_template { - my ($self, $accents) = @_; - my $preamble = <<'----END OF PREAMBLE----'; -.de Sp \" Vertical space (when we can't use .PP) -.if t .sp .5v -.if n .sp -.. -.de Vb \" Begin verbatim text -.ft @CFONT@ -.nf -.ne \\$1 -.. -.de Ve \" End verbatim text -.ft R -.fi -.. -.\" Set up some character translations and predefined strings. \*(-- will -.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left -.\" double quote, and \*(R" will give a right double quote. \*(C+ will -.\" give a nicer C++. Capital omega is used to do unbreakable dashes and -.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, -.\" nothing in troff, for use with C<>. -.tr \(*W- -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.ie n \{\ -. ds -- \(*W- -. ds PI pi -. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch -. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch -. ds L" "" -. ds R" "" -. ds C` @LQUOTE@ -. ds C' @RQUOTE@ -'br\} -.el\{\ -. ds -- \|\(em\| -. ds PI \(*p -. ds L" `` -. ds R" '' -'br\} -.\" -.\" Escape single quotes in literal strings from groff's Unicode transform. -.ie \n(.g .ds Aq \(aq -.el .ds Aq ' -.\" -.\" If the F register is turned on, we'll generate index entries on stderr for -.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index -.\" entries marked with X<> in POD. Of course, you'll have to process the -.\" output yourself in some meaningful fashion. -.ie \nF \{\ -. de IX -. tm Index:\\$1\t\\n%\t"\\$2" -.. -. nr % 0 -. rr F -.\} -.el \{\ -. de IX -.. -.\} -----END OF PREAMBLE---- - - if ($accents) { - $preamble .= <<'----END OF PREAMBLE----' -.\" -.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). -.\" Fear. Run. Save yourself. No user-serviceable parts. -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds / -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -.\} -.rm #[ #] #H #V #F C -----END OF PREAMBLE---- -#`# for cperl-mode - } - return $preamble; -} - -############################################################################## -# Module return value and documentation -############################################################################## - -1; -__END__ - -=head1 NAME - -Pod::Man - Convert POD data to formatted *roff input - -=for stopwords -en em ALLCAPS teeny fixedbold fixeditalic fixedbolditalic stderr utf8 -UTF-8 Allbery Sean Burke Ossanna Solaris formatters troff uppercased -Christiansen - -=head1 SYNOPSIS - - use Pod::Man; - my $parser = Pod::Man->new (release => $VERSION, section => 8); - - # Read POD from STDIN and write to STDOUT. - $parser->parse_file (\*STDIN); - - # Read POD from file.pod and write to file.1. - $parser->parse_from_file ('file.pod', 'file.1'); - -=head1 DESCRIPTION - -Pod::Man is a module to convert documentation in the POD format (the -preferred language for documenting Perl) into *roff input using the man -macro set. The resulting *roff code is suitable for display on a terminal -using L<nroff(1)>, normally via L<man(1)>, or printing using L<troff(1)>. -It is conventionally invoked using the driver script B<pod2man>, but it can -also be used directly. - -As a derived class from Pod::Simple, Pod::Man supports the same methods and -interfaces. See L<Pod::Simple> for all the details. - -new() can take options, in the form of key/value pairs that control the -behavior of the parser. See below for details. - -If no options are given, Pod::Man uses the name of the input file with any -trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to -section 1 unless the file ended in C<.pm> in which case it defaults to -section 3, to a centered title of "User Contributed Perl Documentation", to -a centered footer of the Perl version it is run with, and to a left-hand -footer of the modification date of its input (or the current date if given -C<STDIN> for input). - -Pod::Man assumes that your *roff formatters have a fixed-width font named -C<CW>. If yours is called something else (like C<CR>), use the C<fixed> -option to specify it. This generally only matters for troff output for -printing. Similarly, you can set the fonts used for bold, italic, and -bold italic fixed-width output. - -Besides the obvious pod conversions, Pod::Man also takes care of -formatting func(), func(3), and simple variable references like $foo or -@bar so you don't have to use code escapes for them; complex expressions -like C<$fred{'stuff'}> will still need to be escaped, though. It also -translates dashes that aren't used as hyphens into en dashes, makes long -dashes--like this--into proper em dashes, fixes "paired quotes," makes C++ -look right, puts a little space between double underscores, makes ALLCAPS -a teeny bit smaller in B<troff>, and escapes stuff that *roff treats as -special so that you don't have to. - -The recognized options to new() are as follows. All options take a single -argument. - -=over 4 - -=item center - -Sets the centered page header to use instead of "User Contributed Perl -Documentation". - -=item date - -Sets the left-hand footer. By default, the modification date of the input -file will be used, or the current date if stat() can't find that file (the -case if the input is from C<STDIN>), and the date will be formatted as -C<YYYY-MM-DD>. - -=item fixed - -The fixed-width font to use for verbatim text and code. Defaults to -C<CW>. Some systems may want C<CR> instead. Only matters for B<troff> -output. - -=item fixedbold - -Bold version of the fixed-width font. Defaults to C<CB>. Only matters -for B<troff> output. - -=item fixeditalic - -Italic version of the fixed-width font (actually, something of a misnomer, -since most fixed-width fonts only have an oblique version, not an italic -version). Defaults to C<CI>. Only matters for B<troff> output. - -=item fixedbolditalic - -Bold italic (probably actually oblique) version of the fixed-width font. -Pod::Man doesn't assume you have this, and defaults to C<CB>. Some -systems (such as Solaris) have this font available as C<CX>. Only matters -for B<troff> output. - -=item name - -Set the name of the manual page. Without this option, the manual name is -set to the uppercased base name of the file being converted unless the -manual section is 3, in which case the path is parsed to see if it is a Perl -module path. If it is, a path like C<.../lib/Pod/Man.pm> is converted into -a name like C<Pod::Man>. This option, if given, overrides any automatic -determination of the name. - -=item quotes - -Sets the quote marks used to surround CE<lt>> text. If the value is a -single character, it is used as both the left and right quote; if it is two -characters, the first character is used as the left quote and the second as -the right quoted; and if it is four characters, the first two are used as -the left quote and the second two as the right quote. - -This may also be set to the special value C<none>, in which case no quote -marks are added around CE<lt>> text (but the font is still changed for troff -output). - -=item release - -Set the centered footer. By default, this is the version of Perl you run -Pod::Man under. Note that some system an macro sets assume that the -centered footer will be a modification date and will prepend something like -"Last modified: "; if this is the case, you may want to set C<release> to -the last modified date and C<date> to the version number. - -=item section - -Set the section for the C<.TH> macro. The standard section numbering -convention is to use 1 for user commands, 2 for system calls, 3 for -functions, 4 for devices, 5 for file formats, 6 for games, 7 for -miscellaneous information, and 8 for administrator commands. There is a lot -of variation here, however; some systems (like Solaris) use 4 for file -formats, 5 for miscellaneous information, and 7 for devices. Still others -use 1m instead of 8, or some mix of both. About the only section numbers -that are reliably consistent are 1, 2, and 3. - -By default, section 1 will be used unless the file ends in C<.pm> in which -case section 3 will be selected. - -=item stderr - -Send error messages about invalid POD to standard error instead of -appending a POD ERRORS section to the generated *roff output. - -=item utf8 - -By default, Pod::Man produces the most conservative possible *roff output -to try to ensure that it will work with as many different *roff -implementations as possible. Many *roff implementations cannot handle -non-ASCII characters, so this means all non-ASCII characters are converted -either to a *roff escape sequence that tries to create a properly accented -character (at least for troff output) or to C<X>. - -If this option is set, Pod::Man will instead output UTF-8. If your *roff -implementation can handle it, this is the best output format to use and -avoids corruption of documents containing non-ASCII characters. However, -be warned that *roff source with literal UTF-8 characters is not supported -by many implementations and may even result in segfaults and other bad -behavior. - -Be aware that, when using this option, the input encoding of your POD -source must be properly declared unless it is US-ASCII or Latin-1. POD -input without an C<=encoding> command will be assumed to be in Latin-1, -and if it's actually in UTF-8, the output will be double-encoded. See -L<perlpod(1)> for more information on the C<=encoding> command. - -=back - -The standard Pod::Simple method parse_file() takes one argument naming the -POD file to read from. By default, the output is sent to C<STDOUT>, but -this can be changed with the output_fd() method. - -The standard Pod::Simple method parse_from_file() takes up to two -arguments, the first being the input file to read POD from and the second -being the file to write the formatted output to. - -You can also call parse_lines() to parse an array of lines or -parse_string_document() to parse a document already in memory. To put the -output into a string instead of a file handle, call the output_string() -method. See L<Pod::Simple> for the specific details. - -=head1 DIAGNOSTICS - -=over 4 - -=item roff font should be 1 or 2 chars, not "%s" - -(F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that -wasn't either one or two characters. Pod::Man doesn't support *roff fonts -longer than two characters, although some *roff extensions do (the canonical -versions of B<nroff> and B<troff> don't either). - -=item Invalid quote specification "%s" - -(F) The quote specification given (the quotes option to the constructor) was -invalid. A quote specification must be one, two, or four characters long. - -=back - -=head1 BUGS - -Encoding handling assumes that PerlIO is available and does not work -properly if it isn't. The C<utf8> option is therefore not supported -unless Perl is built with PerlIO support. - -There is currently no way to turn off the guesswork that tries to format -unmarked text appropriately, and sometimes it isn't wanted (particularly -when using POD to document something other than Perl). Most of the work -toward fixing this has now been done, however, and all that's still needed -is a user interface. - -The NAME section should be recognized specially and index entries emitted -for everything in that section. This would have to be deferred until the -next section, since extraneous things in NAME tends to confuse various man -page processors. Currently, no index entries are emitted for anything in -NAME. - -Pod::Man doesn't handle font names longer than two characters. Neither do -most B<troff> implementations, but GNU troff does as an extension. It would -be nice to support as an option for those who want to use it. - -The preamble added to each output file is rather verbose, and most of it -is only necessary in the presence of non-ASCII characters. It would -ideally be nice if all of those definitions were only output if needed, -perhaps on the fly as the characters are used. - -Pod::Man is excessively slow. - -=head1 CAVEATS - -If Pod::Man is given the C<utf8> option, the encoding of its output file -handle will be forced to UTF-8 if possible, overriding any existing -encoding. This will be done even if the file handle is not created by -Pod::Man and was passed in from outside. This maintains consistency -regardless of PERL_UNICODE and other settings. - -The handling of hyphens and em dashes is somewhat fragile, and one may get -the wrong one under some circumstances. This should only matter for -B<troff> output. - -When and whether to use small caps is somewhat tricky, and Pod::Man doesn't -necessarily get it right. - -Converting neutral double quotes to properly matched double quotes doesn't -work unless there are no formatting codes between the quote marks. This -only matters for troff output. - -=head1 AUTHOR - -Russ Allbery <rra@stanford.edu>, based I<very> heavily on the original -B<pod2man> by Tom Christiansen <tchrist@mox.perl.com>. The modifications to -work with Pod::Simple instead of Pod::Parser were originally contributed by -Sean Burke (but I've since hacked them beyond recognition and all bugs are -mine). - -=head1 COPYRIGHT AND LICENSE - -Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 -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. - -=head1 SEE ALSO - -L<Pod::Simple>, L<perlpod(1)>, L<pod2man(1)>, L<nroff(1)>, L<troff(1)>, -L<man(1)>, L<man(7)> - -Ossanna, Joseph F., and Brian W. Kernighan. "Troff User's Manual," -Computing Science Technical Report No. 54, AT&T Bell Laboratories. This is -the best documentation of standard B<nroff> and B<troff>. At the time of -this writing, it's available at -L<http://www.cs.bell-labs.com/cm/cs/cstr.html>. - -The man page documenting the man macro set may be L<man(5)> instead of -L<man(7)> on your system. Also, please see L<pod2man(1)> for extensive -documentation on writing manual pages if you've not done it before and -aren't familiar with the conventions. - -The current version of this module is always available from its web site at -L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the -Perl core distribution as of 5.6.0. - -=cut |