From: Gurusamy Sarathy Date: Mon, 6 Mar 2000 15:24:14 +0000 (+0000) Subject: Pod::Man bugfixes (from Russ Allbery) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9abbd5d6e768b3d2c9536a3c39ca67438643c9d;p=p5sagit%2Fp5-mst-13.2.git Pod::Man bugfixes (from Russ Allbery) p4raw-id: //depot/perl@5582 --- diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm index f096c62..898b544 100644 --- a/lib/Pod/Man.pm +++ b/lib/Pod/Man.pm @@ -1,15 +1,21 @@ # Pod::Man -- Convert POD data to formatted *roff input. -# $Id: Man.pm,v 0.8 1999/10/07 09:39:37 eagle Exp $ +# $Id: Man.pm,v 1.0 2000/03/06 10:16:31 eagle Exp $ # -# Copyright 1999 by Russ Allbery +# Copyright 1999, 2000 by Russ Allbery # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # -# This module is intended to be a replacement for pod2man, 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 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. +# +# 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 @@ -28,7 +34,11 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); @ISA = qw(Pod::Parser); -($VERSION = (split (' ', q$Revision: 0.8 $ ))[1]) =~ s/\.(\d)$/.0$1/; +# 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.00; ############################################################################ @@ -254,8 +264,15 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; # Static helper functions ############################################################################ -# Protect leading quotes and periods against interpretation as commands. -sub protect { local $_ = shift; s/^([.\'])/\\&$1/mg; $_ } +# Protect leading quotes and periods against interpretation as commands. A +# leading *roff font escape apparently still leaves a period interpretable +# as a command by some *roff implementations, so look for a period even +# after one of those. +sub protect { + local $_ = shift; + s{ ^ ( (?: \\f(?:.|\(..) )* [.\'] ) } {\\&$1}xmg; + $_; +} # 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 @@ -336,16 +353,20 @@ sub initialize { # 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. + # 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 ($rev, $ver, $sver) = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); - $sver ||= 0; $sver *= 10 ** (3-length($sver)); - $rev += 0; $ver += 0; $sver += 0; - $$self{release} = "perl v$rev.$ver.$sver"; + my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); + $version[2] ||= 0; + $version[2] *= 10 ** (3 - length $version[2]); + for (@version) { $_ += 0 } + $$self{release} = 'perl v' . join ('.', @version); } # Double quotes in things that will be quoted. - for (qw/center date release/) { $$self{$_} =~ s/\"/\"\"/g } + for (qw/center date release/) { + $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; + } $$self{INDENT} = 0; # Current indentation level. $$self{INDENTS} = []; # Stack of indentations. @@ -378,11 +399,11 @@ sub begin_pod { # which works. Should be fixed to use File::Spec. for ($name) { s%//+%/%g; - if ( s%^.*?/lib/[^/]*perl[^/]*/%%is - or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%is) { - s%^site(_perl)?/%%s; # site and site_perl - s%^(.*-$^O|$^O-.*)/%%os; # arch - s%^\d+\.\d+%%s; # version + if ( s%^.*?/lib/[^/]*perl[^/]*/%%si + or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) { + s%^site(_perl)?/%%s; # site and site_perl + s%^(.*-$^O|$^O-.*)/%%so; # arch + s%^\d+\.\d+%%s; # version } s%/%::%g; } @@ -396,7 +417,7 @@ sub begin_pod { my ($day, $month, $year) = (localtime $time)[3,4,5]; $month++; $year += 1900; - $$self{date} = join ('-', $year, $month, $day); + $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day); } # Now, print out the preamble and the title. @@ -469,7 +490,8 @@ sub textblock { # 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. - s{ + my $text = shift; + $text =~ s{ (L< # A link of the form L. / ( @@ -487,25 +509,26 @@ sub textblock { ) } { local $_ = $1; - s{ L< / ([^>]+ ) } {$1}g; + s{ L< / ( [^>]+ ) > } {$1}xg; my @items = split /(?:,?\s+(?:and\s+)?)/; - my $string = "the "; + my $string = 'the '; my $i; for ($i = 0; $i < @items; $i++) { $string .= $items[$i]; - $string .= ", " if @items > 2 && $i != $#items; - $string .= " and " if ($i == $#items - 1); + $string .= ', ' if @items > 2 && $i != $#items; + $string .= ' ' if @items == 2 && $i == 2; + $string .= 'and ' if ($i == $#items - 1); } - $string .= " entries elsewhere in this document"; + $string .= ' entries elsewhere in this document'; $string; }gex; # Parse the tree and output it. collapse knows about references to # scalars as well as scalars and does the right thing with them. - local $_ = $self->parse (@_); - s/\n\s*$/\n/; + $text = $self->parse ($text, @_); + $text =~ s/\n\s*$/\n/; $self->makespace if $$self{NEEDSPACE}; - $self->output (protect $self->mapfonts ($_)); + $self->output (protect $self->mapfonts ($text)); $self->outindex; $$self{NEEDSPACE} = 1; } @@ -520,7 +543,9 @@ sub sequence { # Zero-width characters. if ($command eq 'Z') { - my $v = '\&'; return bless \ $v, 'Pod::Man::String'; + # Workaround to generate a blessable reference, needed by 5.005. + my $tmp = '\&'; + return bless \ "$tmp", 'Pod::Man::String'; } # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. @@ -557,10 +582,9 @@ sub sequence { # Handle links. if ($command eq 'L') { - # XXX bug in lvalue subroutines prevents this from working - #return bless \ ($self->buildlink ($_)), 'Pod::Man::String'; - my $v = $self->buildlink($_); - return bless \$v, 'Pod::Man::String'; + # A bug in lvalue subs in 5.6 requires the temporary variable. + my $tmp = $self->buildlink ($_); + return bless \ "$tmp", 'Pod::Man::String'; } # Whitespace protection replaces whitespace with "\ ". @@ -692,7 +716,6 @@ sub cmd_end { sub cmd_for { my $self = shift; local $_ = shift; - my $line = shift; return unless s/^(?:man|roff)\b[ \t]*\n?//; $self->output ($_); } @@ -842,7 +865,7 @@ sub guesswork { ( ^ | [\s\(\"\'\`\[\{<>] ) ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* ) (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ ) - } { $1 . '\s-1' . $2 . '\s0' . $3 }egx; + } { $1 . '\s-1' . $2 . '\s0' }egx; # Turn PI into a pretty pi. s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx; @@ -1166,11 +1189,6 @@ separators. Pod::Man is excessively slow. -=head1 NOTES - -The intention is for this module and its driver script to eventually replace -B in Perl core. - =head1 SEE ALSO L, perlpod(1), pod2man(1), nroff(1), troff(1),