# Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 1.16 2001/04/09 13:06:02 eagle Exp $
+# $Id: Man.pm,v 1.19 2001/07/10 11:08:09 eagle Exp $
#
# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
-# This program is free software; you can redistribute it and/or modify it
+# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module is intended to be a replacement for the pod2man script
# distributed with versions of Perl prior to 5.6, and attempts to match its
# output except for some specific circumstances where other decisions seemed
-# to produce better output. It uses Pod::Parser and is designed to be easy
-# to subclass.
+# to produce better output. It uses Pod::Parser and is designed to be easy to
+# subclass.
#
# 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;
@ISA = qw(Pod::Parser);
-# Don't use the CVS revision as the version, since this module is also in
-# Perl core and too many things could munge CVS magic revision strings.
-# This number should ideally be the same as the CVS revision in podlators,
-# however.
-$VERSION = 1.16;
+# Don't use the CVS revision as the version, since this module is also in Perl
+# core and too many things could munge CVS magic revision strings. This
+# number should ideally be the same as the CVS revision in podlators, however.
+$VERSION = 1.19;
-############################################################################
+##############################################################################
# Preamble and *roff output tables
-############################################################################
+##############################################################################
# The following is the static preamble which starts all *roff output we
# generate. It's completely 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@.
-# $PREAMBLE should therefore be run through s/\@CFONT\@/<font>/g before
-# output.
+# quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@. $PREAMBLE
+# should therefore be run through s/\@CFONT\@/<font>/g before output.
$PREAMBLE = <<'----END OF PREAMBLE----';
.de Sh \" Subsection heading
.br
.if t .sp .5v
.if n .sp
..
-.de Ip \" List item
-.br
-.ie \\n(.$>=3 .ne \\$3
-.el .ne 3
-.IP "\\$1" \\$2
-..
.de Vb \" Begin verbatim text
.ft @CFONT@
.nf
.\" 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. | will give a
-.\" real vertical bar. \*(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<>
+.\" real vertical bar. \*(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-|\(bv\*(Tr
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds R" ''
'br\}
.\"
-.\" If the F register is turned on, we'll generate index entries on stderr
-.\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and
-.\" index entries marked with X<> in POD. Of course, you'll have to process
-.\" the output yourself in some meaningful fashion.
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
+.\" entries marked with X<> in POD. Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
.if \nF \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
. rr F
.\}
.\"
-.\" For nroff, turn off justification. Always turn off hyphenation; it
-.\" makes way too many mistakes in technical documents.
+.\" For nroff, turn off justification. Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
.hy 0
.if n .na
.\"
);
-############################################################################
+##############################################################################
# Static helper functions
-############################################################################
+##############################################################################
-# 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.
+# 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 {
local $_ = shift;
s/^([.\'\\])/\\&$1/mg;
sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] }
-############################################################################
+##############################################################################
# Initialization
-############################################################################
-
-# Initialize the object. Here, we also process any additional options
-# passed to the constructor or set up defaults if none were given. center
-# is the centered title, release is the version number, and date is the date
-# for the documentation. Note that we can't know what file name we're
-# processing due to the architecture of Pod::Parser, so that *has* to either
-# be passed to the constructor or set separately with Pod::Man::name().
+##############################################################################
+
+# Initialize the object. Here, we also process any additional options passed
+# to the constructor or set up defaults if none were given. center is the
+# centered title, release is the version number, and date is the date for the
+# documentation. Note that we can't know what file name we're processing due
+# to the architecture of Pod::Parser, so that *has* to either be passed to the
+# constructor or set separately with Pod::Man::name().
sub initialize {
my $self = shift;
- # Figure out the fixed-width font. If user-supplied, make sure that
- # they are the right length.
+ # Figure out the fixed-width font. If user-supplied, make sure that they
+ # are the right length.
for (qw/fixed fixedbold fixeditalic fixedbolditalic/) {
if (defined $$self{$_}) {
if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) {
}
}
- # Set the default fonts. We can't be sure what fixed bold-italic is
- # going to be called, so default to just bold.
+ # Set the default fonts. We can't be sure what fixed bold-italic is going
+ # to be called, 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.
+ # 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}),
unless defined $$self{center};
$$self{indent} = 4 unless defined $$self{indent};
- # 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.
+ # 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.
if (!defined $$self{release}) {
my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
$version[2] ||= 0;
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.
+ # 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/\"/\"\"/;
# */lib/*perl* standard or site_perl module
# */*perl*/lib from -D prefix=/opt/perl
# */*perl*/ random module hierarchy
- # which works. Should be fixed to use File::Spec. Also handle
- # a leading lib/ since that's what ExtUtils::MakeMaker creates.
+ # which works. Should be fixed to use File::Spec. Also handle a
+ # leading lib/ since that's what ExtUtils::MakeMaker creates.
for ($name) {
s%//+%/%g;
if ( s%^.*?/lib/[^/]*perl[^/]*/%%si
}
}
- # If $name contains spaces, quote it; this mostly comes up in the case
- # of input from stdin.
+ # If $name contains spaces, quote it; this mostly comes up in the case of
+ # input from stdin.
$name = '"' . $name . '"' if ($name =~ /\s/);
# Modification date header. Try to use the modification time of our
.\\" @{[ scalar localtime ]}
.\\"
.\\" Standard preamble:
-.\\" ======================================================================
+.\\" ========================================================================
$_
-.\\" ======================================================================
+.\\" ========================================================================
.\\"
.IX Title "$name $section"
.TH $name $section "$$self{release}" "$$self{date}" "$$self{center}"
}
-############################################################################
+##############################################################################
# Core overrides
-############################################################################
+##############################################################################
# Called for each command paragraph. Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
my $self = shift;
my $command = shift;
return if $command eq 'pod';
- return if ($$self{EXCLUDE} && $command ne 'end');
+ return if ($$self{EXCLUDE} && $command ne 'end');
if ($self->can ('cmd_' . $command)) {
$command = 'cmd_' . $command;
$self->$command (@_);
- } else {
+ } else {
my ($text, $line, $paragraph) = @_;
my $file;
($file, $line) = $paragraph->file_line;
}
}
-# Called for a verbatim paragraph. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Rofficate backslashes, untabify, put a
-# zero-width character at the beginning of each line to protect against
-# commands, and wrap in .Vb/.Ve.
+# Called for a verbatim paragraph. Gets the paragraph, the line number, and a
+# Pod::Paragraph object. Rofficate backslashes, untabify, put a zero-width
+# character at the beginning of each line to protect against commands, and
+# wrap in .Vb/.Ve.
sub verbatim {
my $self = shift;
return if $$self{EXCLUDE};
$$self{NEEDSPACE} = 0;
}
-# Called for a regular text block. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Perform interpolation and output the results.
+# Called for a regular text block. Gets the paragraph, the line number, and a
+# Pod::Paragraph object. Perform interpolation and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
$self->output ($_[0]), return if $$self{VERBATIM};
- # Perform a little magic to collapse multiple L<> references. We'll
- # just rewrite the whole thing into actual text at this part, bypassing
- # the whole internal sequence parsing thing.
+ # Perform a little magic to collapse multiple L<> references. We'll just
+ # rewrite the whole thing into actual text at this part, bypassing the
+ # whole internal sequence parsing thing.
my $text = shift;
$text =~ s{
(L< # A link of the form L</something>.
# Called for an interior sequence. Takes a Pod::InteriorSequence object and
# returns a reference to a scalar. This scalar is the final formatted text.
-# It's returned as a reference so that other interior sequences above us
-# know that the text has already been processed.
+# It's returned as a reference so that other interior sequences above us know
+# that the text has already been processed.
sub sequence {
my ($self, $seq) = @_;
my $command = $seq->cmd_name;
} elsif ($command eq 'I') {
return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String';
} elsif ($command eq 'C') {
- return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"),
- 'Pod::Man::String';
+ # A bug in lvalue subs in 5.6 requires the temporary variable.
+ my $tmp = $self->quote_literal ($_);
+ return bless \ "$tmp", 'Pod::Man::String';
}
# Handle links.
}
-############################################################################
+##############################################################################
# Command paragraphs
-############################################################################
+##############################################################################
# All command paragraphs take the paragraph and the line number.
# 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 any E<> sequences that would cause
-# them.
+# already uses small caps, so remove any E<> sequences that would cause them.
sub cmd_head1 {
my $self = shift;
local $_ = $self->parse (@_);
# An individual list item. Emit an index entry for anything that's
# interesting, but don't emit index entries for things like bullets and
-# numbers. rofficate bullets too while we're at it (so for nice output, use
-# * for your lists rather than o or . or - or some other thing). Newlines
-# in an item title are turned into spaces since *roff can't handle them
-# embedded.
+# numbers. rofficate bullets too while we're at it (so for nice output, use *
+# for your lists rather than o or . or - or some other thing). Newlines in an
+# item title are turned into spaces since *roff can't handle them embedded.
sub cmd_item {
my $self = shift;
local $_ = $self->parse (@_);
}
$_ = $self->textmapfonts ($_);
$self->output (".PD 0\n") if ($$self{ITEMS} == 1);
- $self->output ($self->switchquotes ('.Ip', $_, $$self{INDENT}));
+ $self->output ($self->switchquotes ('.IP', $_, $$self{INDENT}));
$self->outindex ($index ? ('Item', $index) : ());
$$self{NEEDSPACE} = 0;
$$self{ITEMS}++;
}
-############################################################################
+##############################################################################
# Link handling
-############################################################################
+##############################################################################
# Handle links. We can't actually make real hyperlinks, so this is all to
# figure out what text and formatting we print out.
s/^\s+//;
s/\s+$//;
- # If the argument looks like a URL, return it verbatim. This only
- # handles URLs that use the server syntax.
+ # If the argument looks like a URL, return it verbatim. This only handles
+ # URLs that use the server syntax.
if (m%^[a-z]+://\S+$%) { return $_ }
- # 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)>. Do the same thing to
- # L<manpage(section)> as we would to manpage(section) without the L<>;
- # see guesswork(). If we've added italics, don't add the "manpage"
- # text; markup is sufficient.
+ # 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)>. Do the same to L<manpage(section)> as
+ # we would to manpage(section) without the L<>; see guesswork(). If we've
+ # added italics, don't add the "manpage" text; markup is sufficient.
my ($manpage, $section) = ('', $_);
if (/^"\s*(.*?)\s*"$/) {
$section = '"' . $1 . '"';
}
-############################################################################
+##############################################################################
# Escaping and fontification
-############################################################################
+##############################################################################
# At this point, we'll have embedded font codes of the form \f(<font>[SE]
-# where <font> is one of B, I, or F. Turn those into the right font start
-# or end codes. The old pod2man didn't get B<someI<thing> else> right;
-# after I<> it switched back to normal text rather than bold. We take care
-# of this by using variables as a combined pointer to our current font
-# sequence, and set each to the number of current nestings of start tags for
-# that font. Use them as a vector to look up what font sequence to use.
+# where <font> is one of B, I, or F. Turn those into the right font start or
+# end codes. The old pod2man didn't get B<someI<thing> else> right; after I<>
+# it switched back to normal text rather than bold. We take care of this by
+# using variables as a combined pointer to our current font sequence, and set
+# each to the number of current nestings of start tags for that font. Use
+# them as a vector to look up what font sequence to use.
#
# \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.
+# 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 = shift;
local $_ = shift;
# 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.
+# 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 = shift;
local $_ = shift;
}
-############################################################################
-# *roff-specific parsing
-############################################################################
+##############################################################################
+# *roff-specific parsing and magic
+##############################################################################
# Called instead of parse_text, calls parse_text with the right flags.
sub parse {
}
# Takes a parse tree and a flag saying whether or not to treat it as literal
-# text (not call guesswork on it), and returns the concatenation of all of
-# the text strings in that parse tree. If the literal flag isn't true,
+# text (not call guesswork on it), and returns the concatenation of all of the
+# text strings in that parse tree. If the literal flag isn't true,
# guesswork() will be called on all plain scalars in the parse tree.
-# Otherwise, just escape backslashes in the normal case. If collapse is
-# being called on a C<> sequence, literal is set to 2, and we do some
-# additional cleanup. Assumes that everything in the parse tree is either a
-# scalar or a reference to a scalar.
+# Otherwise, just escape backslashes in the normal case. If collapse is being
+# called on a C<> sequence, literal is set to 2, and we do some additional
+# cleanup. Assumes that everything in the parse tree is either a scalar or a
+# reference to a scalar.
sub collapse {
my ($self, $ptree, $literal) = @_;
if ($literal) {
}
# Takes a text block to perform guesswork on; this is guaranteed not to
-# contain any interior sequences. Returns the text block with remapping
-# done.
+# contain any interior sequences. Returns the text block with remapping done.
sub guesswork {
my $self = shift;
local $_ = shift;
# Ensure double underbars have a tiny space between them.
s/__/_\\|_/g;
- # Make all caps a little smaller. Be careful here, since we don't want
- # to make @ARGV into small caps, nor do we want to fix the MIME in
+ # Make all caps a little smaller. Be careful here, since we don't want to
+ # make @ARGV into small caps, nor do we want to fix the MIME in
# MIME-Version, since it looks weird with the full-height V.
s{
( ^ | [\s\(\"\'\`\[\{<>] )
(?: (?= [\s>\}\]\(\)\'\".?!,;] | -- ) | $ )
} { $1 . '\s-1' . $2 . '\s0' }egx;
- # Turn PI into a pretty pi.
- s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx;
-
# Italize functions in the form func().
s{
( \b | \\s-1 )
$_;
}
+# 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 = '(?: \[.*\] | \{.*\} )?';
+
+ # 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
+ | \` .* \' # `quoted'
+ | \$+ [\#^]? \S $index # special ($^Foo, $")
+ | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func
+ | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
+ | [+-]? [\d.]+ (?: [eE] [+-]? \d+ )? # a number
+ | 0x [a-fA-F\d]+ # a hex constant
+ )
+ \s*\z
+ }xo && return '\f(FS' . $_ . '\f(FE';
+
+ # If we didn't return, go ahead and quote the text.
+ return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE";
+}
+
-############################################################################
+##############################################################################
# Output formatting
-############################################################################
+##############################################################################
# Make vertical whitespace.
sub makespace {
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.
+# 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} };
# 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.
- # If $extra is set, we're dealing with =item, which in most nroff macro
- # sets requires an extra level of quoting of double quotes.
+ # confuses the .SH macros and the like no end. Expand them ourselves. If
+ # $extra is set, we're dealing with =item, which in most nroff macro sets
+ # requires an extra level of quoting of double quotes because it passes
+ # the argument off to .TP.
my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
- if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) {
+ if (/\"/ || /\\f\(CW/) {
s/\"/\"\"/g;
+ my $nroff = $_;
my $troff = $_;
$troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
- s/\\\*\(C\`/$$self{LQUOTE}/g;
- s/\\\*\(C\'/$$self{RQUOTE}/g;
- $troff =~ s/\\\*\(C[\'\`]//g;
- s/\"/\"\"/g if $extra;
- $troff =~ s/\"/\"\"/g if $extra;
- $_ = qq("$_") . ($extra ? " $extra" : '');
+ if ($c_is_quote && /\\\*\(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" : '');
- return ".if n $command $_\n.el $command $troff\n";
+
+ # 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 stripping out the font changes since fixed-width fonts don't
+ # mean anything for nroff. While we're at it, also remove the font
+ # changes for nroff in =item tags, since they're unnecessary.
+ $nroff =~ s/\\f\(CW(.*)\\f[PR]/$1/g;
+
+ # Now finally output the command. Only bother with .if if the nroff
+ # and troff output isn't the same.
+ if ($nroff ne $troff) {
+ return ".if n $command $nroff\n.el $command $troff\n";
+ } else {
+ return "$command $nroff\n";
+ }
} else {
$_ = qq("$_") . ($extra ? " $extra" : '');
return "$command $_\n";
. ds Oe OE
.\}
-############################################################################
+##############################################################################
# Documentation
-############################################################################
+##############################################################################
=head1 NAME
(W) The POD source contained a non-standard interior sequence (something of
the form C<XE<lt>E<gt>>) that Pod::Man didn't know about. It was ignored.
-=item %s: Unknown command paragraph "%s" on line %d.
-
-(W) The POD source contained a non-standard command paragraph (something of
-the form C<=command args>) that Pod::Man didn't know about. It was ignored.
-
=item Unmatched =back
(W) Pod::Man encountered a C<=back> command that didn't correspond to an
Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
original B<pod2man> by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>.
+=head1 COPYRIGHT AND LICENSE
+
+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.
+
=cut
# Pod::Text -- Convert POD data to formatted ASCII text.
-# $Id: Text.pm,v 2.9 2001/04/09 13:00:50 eagle Exp $
+# $Id: Text.pm,v 2.11 2001/07/10 11:08:10 eagle Exp $
#
# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
-# This program is free software; you can redistribute it and/or modify it
+# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
-# This module is intended to be a replacement for Pod::Text, and attempts to
-# match its output except for some specific circumstances where other
-# decisions seemed to produce better output. It uses Pod::Parser and is
-# designed to be very easy to subclass.
+# This module replaces the old Pod::Text that came with versions of Perl prior
+# to 5.6.0, and attempts to match its output except for some specific
+# circumstances where other decisions seemed to produce better output. It
+# uses Pod::Parser and is designed to be very easy to subclass.
+#
+# 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::Text;
use strict;
use vars qw(@ISA @EXPORT %ESCAPES $VERSION);
-# We inherit from Pod::Select instead of Pod::Parser so that we can be used
-# by Pod::Usage.
+# We inherit from Pod::Select instead of Pod::Parser so that we can be used by
+# Pod::Usage.
@ISA = qw(Pod::Select Exporter);
# We have to export pod2text for backward compatibility.
@EXPORT = qw(pod2text);
-# Don't use the CVS revision as the version, since this module is also in
-# Perl core and too many things could munge CVS magic revision strings.
-# This number should ideally be the same as the CVS revision in podlators,
-# however.
-$VERSION = 2.09;
+# Don't use the CVS revision as the version, since this module is also in Perl
+# core and too many things could munge CVS magic revision strings. This
+# number should ideally be the same as the CVS revision in podlators, however.
+$VERSION = 2.11;
-############################################################################
+##############################################################################
# Table of supported E<> escapes
-############################################################################
+##############################################################################
-# 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. :)
-# "iexcl" to "divide" added by Tim Jenness.
+# 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. :) "iexcl" to
+# "divide" added by Tim Jenness.
%ESCAPES = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
);
-############################################################################
+##############################################################################
# Initialization
-############################################################################
+##############################################################################
# Initialize the object. Must be sure to call our parent initializer.
sub initialize {
}
-############################################################################
+##############################################################################
# Core overrides
-############################################################################
+##############################################################################
# Called for each command paragraph. Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
}
}
-# 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.
+# 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->output ($_);
}
-# Called for a regular text block. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Perform interpolation and output the results.
+# Called for a regular text block. Gets the paragraph, the line number, and a
+# Pod::Paragraph object. Perform interpolation and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
# Called for an interior sequence. Gets the command, argument, and a
# Pod::InteriorSequence object and is expected to return the resulting text.
-# Calls code, bold, italic, file, and link to handle those types of
-# sequences, and handles S<>, E<>, X<>, and Z<> directly.
+# Calls code, bold, italic, file, and link to handle those types of sequences,
+# and handles S<>, E<>, X<>, and Z<> directly.
sub interior_sequence {
my $self = shift;
my $command = shift;
}
-############################################################################
+##############################################################################
# Command paragraphs
-############################################################################
+##############################################################################
# All command paragraphs take the paragraph and the line number.
}
-############################################################################
+##############################################################################
# Interior sequences
-############################################################################
+##############################################################################
# The simple formatting ones. These are here mostly so that subclasses can
# override them and do more complicated things.
sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }
+
+# Apply a whole bunch of messy heuristics to not quote things that don't
+# benefit from being quoted. These originally come from Barrie Slaymaker and
+# largely duplicate code in Pod::Man.
sub seq_c {
- return $_[0]{alt} ? "``$_[1]''" : "$_[0]{LQUOTE}$_[1]$_[0]{RQUOTE}"
+ 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 = '(?: \[.*\] | \{.*\} )?';
+
+ # 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
+ | \` .* \' # `quoted'
+ | \$+ [\#^]? \S $index # special ($^Foo, $")
+ | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func
+ | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
+ | [+-]? [\d.]+ (?: [eE] [+-]? \d+ )? # a number
+ | 0x [a-fA-F\d]+ # a hex constant
+ )
+ \s*\z
+ }xo && return $_;
+
+ # If we didn't return, go ahead and quote the text.
+ return $$self{alt} ? "``$_''" : "$$self{LQUOTE}$_$$self{RQUOTE}";
}
# The complicated one. Handle links. Since this is plain text, we can't
s/^\s+//;
s/\s+$//;
- # If the argument looks like a URL, return it verbatim. This only
- # handles URLs that use the server syntax.
+ # If the argument looks like a URL, return it verbatim. This only handles
+ # URLs that use the server syntax.
if (m%^[a-z]+://\S+$%) { return $_ }
- # 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.
+ # 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 (/^"\s*(.*?)\s*"$/) {
$section = '"' . $1 . '"';
}
-############################################################################
+##############################################################################
# List handling
-############################################################################
-
-# 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.
+##############################################################################
+
+# 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;
}
-############################################################################
+##############################################################################
# Output formatting
-############################################################################
+##############################################################################
-# Wrap a line, indenting by the current left margin. We can't use
-# Text::Wrap because it plays games with tabs. We can't use formline, even
-# though we'd really like to, because it screws up non-printing characters.
-# So we have to do the wrapping ourselves.
+# Wrap a line, indenting by the current left margin. We can't use Text::Wrap
+# because it plays games with tabs. We can't use formline, even though we'd
+# really like to, because it screws up non-printing characters. So we have to
+# do the wrapping ourselves.
sub wrap {
my $self = shift;
local $_ = shift;
my $self = shift;
local $_ = shift;
- # If we're trying to preserve two spaces after sentences, do some
- # munging to support that. Otherwise, smash all repeated whitespace.
+ # If we're trying to preserve two spaces after sentences, do some munging
+ # to support that. Otherwise, smash all repeated whitespace.
if ($$self{sentence}) {
s/ +$//mg;
s/\.\n/. \n/g;
sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
-############################################################################
+##############################################################################
# Backwards compatibility
-############################################################################
+##############################################################################
# The old Pod::Text module did everything in a pod2text() function. This
# tries to provide the same interface for legacy applications.
my $parser = Pod::Text->new (@args);
# If two arguments were given, the second argument is going to be a file
- # handle. That means we want to call parse_from_filehandle(), which
- # means we need to turn the first argument into a file handle. Magic
- # open will handle the <&STDIN case automagically.
+ # handle. That means we want to call parse_from_filehandle(), which means
+ # we need to turn the first argument into a file handle. Magic open will
+ # handle the <&STDIN case automagically.
if (defined $_[1]) {
my @fhs = @_;
local *IN;
}
-############################################################################
+##############################################################################
# Module return value and documentation
-############################################################################
+##############################################################################
1;
__END__
its conversion to Pod::Parser by Brad Appleton
E<lt>bradapp@enteract.comE<gt>.
+=head1 COPYRIGHT AND LICENSE
+
+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.
+
=cut
projects / p5sagit/p5-mst-13.2.git / commitdiff