develooper Front page | perl.perl5.porters | Postings from March 2000

[PATCH] Pod::Man bug fixes (for 5.6)

From:
Russ Allbery
Date:
March 6, 2000 02:23
Subject:
[PATCH] Pod::Man bug fixes (for 5.6)
Message ID:
ylem9ojt24.fsf@windlord.stanford.edu
The following patch will form the core of the next podlators release, but
I may not get that out before 5.6 ships.  These are all bug fixes of
various types, some of them relatively severe (Z<> wasn't working at all,
although that may be a problem with older Perls and not with 5.6).

I also re-synchronized against the copy in 5.5.670, so there are some
modifications to some tweaks that were put directly into the copy in Perl
core and hadn't been in podlators.  This patch also includes the Pod::Man
portion of the regex fixes for filenames containing newlines, although
Pod::Man still doesn't completely do the right thing there.

2000-03-06  Russ Allbery  <rra@stanford.edu>

	* lib/Pod/Man.pm: Set version number to 1.00, change references to
	pod2roff to pod2man in the documentation, and remove the note about
	this module replacing pod2man in Perl core.

	* lib/Pod/Man.pm (initialize): Use "perl v5.6.0" instead of "perl
	5.6, patch 0" for the default release string, handle both pre-5.6
	and post-5.6 version numbering schemes.
	(protect): Allow for two-character fonts.
	(begin_pod): Zero-pad the month and day in the modification date.
	(sequence): Add a temporary variable for L<> text rather than
	blessing the sub return to work around a 5.6 bug.
	(guesswork): $3 no longer used in small-caps regex, remove to
	avoid warnings under -w.

2000-03-05  Russ Allbery  <rra@stanford.edu>

	* lib/Pod/Man.pm (protect): Protect leading periods following font
	escapes as well.
	(initialize): Avoid warnings when center, date, or release aren't
	set.
	(begin_pod): Make filename munging safe even when $* is set and
	the filenames contain embedded newlines.
	(textblock): Use a temporary variable for paragraph text, fix the
	regex to concatenate multiple L<> section links and fix whitespace
	handling for it around "and".
	(sequence): Add a temporary variable workaround so that Z<> works
	correctly with current Perl.
	(cmd_for): Don't extract the line number when we don't use it.

--- perl-5.5.670/lib/Pod/Man.pm.orig	Mon Mar  6 01:36:40 2000
+++ perl-5.5.670/lib/Pod/Man.pm	Mon Mar  6 02:16:31 2000
@@ -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 @@
 
 @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 @@
 # 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 @@
 
     # 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.
@@ -365,8 +386,8 @@
     my $name = $$self{name};
     if (!defined $name) {
         $name = $self->input_file;
-        $section = 3 if (!$$self{section} && $name =~ /\.pm$/i);
-        $name =~ s/\.p(od|[lm])$//i;
+        $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i);
+        $name =~ s/\.p(od|[lm])\z//i;
         if ($section =~ /^1/) {
             require File::Basename;
             $name = uc File::Basename::basename ($name);
@@ -378,11 +399,11 @@
             # which works.  Should be fixed to use File::Spec.
             for ($name) {
                 s%//+%/%g;
-                if (     s%^.*?/lib/[^/]*perl[^/]*/%%i
-                      or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%i) {
-                    s%^site(_perl)?/%%;       # site and site_perl
-                    s%^(.*-$^O|$^O-.*)/%%o;   # arch
-                    s%^\d+\.\d+%%;            # 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 @@
         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 @@
     # 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 @@
         )
     } {
         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 @@
 
     # 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 @@
 
     # 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_for {
     my $self = shift;
     local $_ = shift;
-    my $line = shift;
     return unless s/^(?:man|roff)\b[ \t]*\n?//;
     $self->output ($_);
 }
@@ -842,7 +865,7 @@
         ( ^ | [\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;
@@ -1165,11 +1188,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
 

-- 
Russ Allbery (rra@stanford.edu)             <http://www.eyrie.org/~eagle/>



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About