[REPATCH 5.005_61] Re: perldiag.pod omissions

[perl5.git] / pod / pod2man.PL

diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index e7edf1f..20610a8 100644 (file)
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -2,6 +2,7 @@
 
 use Config;
 use File::Basename qw(&basename &dirname);
+use Cwd;
 
 # List explicitly here the variables you want Configure to
 # generate.  Metaconfig only looks for shell variables, so you
@@ -13,6 +14,7 @@ use File::Basename qw(&basename &dirname);
 
 # This forces PL files to create target in same directory as PL file.
 # This is so that make depend always knows where to find PL derivatives.
+$origdir = cwd;
 chdir dirname($0);
 $file = basename($0, '.PL');
 $file .= '.com' if $^O eq 'VMS';
@@ -316,8 +318,12 @@ $cutting = 1;
 # running an installed version of Perl to produce documentation from an
 # uninstalled newer version's pod files.
 if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
-  ($version,$patch) =
-    `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
+  my $perl = (-x './perl' && -f './perl' ) ?
+                 './perl' :
+                 ((-x '../perl' && -f '../perl') ?
+                      '../perl' :
+                      '');
+  ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
 }
 # No luck; we'll just go with the running Perl's version
 ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
@@ -329,6 +335,7 @@ sub makedate {
     my $secs = shift;
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
+    $year += 1900;
     return "$mday/$mname/$year";
 }
 
@@ -415,8 +422,12 @@ $name =~ s-//+-/-g;
 if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
        or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
        or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
-    # Lose ^arch/version/.
-    $name =~ s-^[^/]+/\d+\.\d+/--;
+    # Lose ^site(_perl)?/.
+    $name =~ s-^site(_perl)?/--;
+    # Lose ^arch/.     (XXX should we use Config? Just for archname?)
+    $name =~ s~^(.*-$^O|$^O-.*)/~~o;
+    # Lose ^version/.
+    $name =~ s-^\d+\.\d+/--;
 }
 
 # Translate Getopt/Long to Getopt::Long, etc.
@@ -555,7 +566,7 @@ print <<'END';
 END
 
 print <<"END";
-.TH $name $section "$RP" "$date" "$center"
+.TH $name $section "$date" "$RP" "$center"
 .UC
 END
 
@@ -667,6 +678,25 @@ $indent = 0;
 
 $begun = "";
 
+# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165.
+my $nonest = q{(?x)             # Turn on /x mode.
+              (?:               # Group
+                [^-=A-Z>]*      # Anything that isn't a dash, equal sign or
+                                # closing hook isn't special. Eat as much as
+                                # we can.
+                (?:             # Group.
+                  (?:           # Group.
+                    [-=]        # We want to recognize -> and =>.
+                    (?![A-Z]<)  # So, as long as it isn't followed by markup
+                    [\x00-\xFF] # anything may follow - and =
+                    |
+                    [A-Z]       # Capitals are fine too,
+                    (?!<)       # But not if they start markup.
+                  )             # End of special sequences.
+                  [^-=A-Z>]*    # Followed by zero or more non-special chars. 
+                )*              # And we can repeat this as often as we can.
+              )};               # That's all folks.
+
 while (<>) {
     if ($cutting) {
        next unless /^=/;
@@ -736,7 +766,7 @@ while (<>) {
        # first hide the escapes in case we need to
        # intuit something and get it wrong due to fmting
 
-       1 while s/([A-Z]<[^<>]*>)/noremap($1)/ge;
+       1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
 
        # func() is a reference to a perl function
        s{
@@ -755,7 +785,7 @@ while (<>) {
        } {I<$1>\\|$2}gx;
 
        # convert simple variable references
-       s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
+       s/(\s+)([\$\@%&*][\w:]+)(?!\()/${1}C<$2>/g;
 
        if (m{ (
                    [\-\w]+
@@ -793,13 +823,13 @@ while (<>) {
     while ($maxnest-- && /[A-Z]</) {
 
        # can't do C font here
-       s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
+       s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
 
        # files and filelike refs in italics
-       s/F<([^<>]*)>/I<$1>/g;
+       s/F<($nonest)>/I<$1>/g;
 
        # no break -- usually we want C<> for this
-       s/S<([^<>]*)>/nobreak($1)/eg;
+       s/S<($nonest)>/nobreak($1)/eg;
 
        # LREF: a la HREF L<show this text|man/section>
        s:L<([^|>]+)\|[^>]+>:$1:g;
@@ -853,7 +883,7 @@ while (<>) {
        s/Z<>/\\&/g;
 
        # comes last because not subject to reprocessing
-       s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
+       s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
     }
 
     if (s/^=//) {
@@ -1117,7 +1147,10 @@ sub internal_lrefs {
     }
 
     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
-           .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
+           .  " elsewhere in this document";
+    # terminal space to avoid words running together (pattern used
+    # strips terminal spaces)
+    $retstr .= " " if length $trailing_and;
     $retstr .=  $trailing_and;
 
     return $retstr;
@@ -1201,3 +1234,4 @@ BEGIN {
 close OUT or die "Can't close $file: $!";
 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;