Pod::Man bugfixes (from Russ Allbery)
Gurusamy Sarathy [Mon, 6 Mar 2000 15:24:14 +0000 (15:24 +0000)]
p4raw-id: //depot/perl@5582

lib/Pod/Man.pm

index f096c62..898b544 100644 (file)
@@ -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 <rra@stanford.edu>
+# Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu>
 #
 # This program is free software; you can redistribute it and/or modify it
 # under the same terms as Perl itself.
 #
-# 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</something>.
               /
               (
@@ -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<pod2man> in Perl core.
-
 =head1 SEE ALSO
 
 L<Pod::Parser|Pod::Parser>, perlpod(1), pod2man(1), nroff(1), troff(1),