[inseparable changes from patch to perl 5.004_04]perl-5.004_04

[editor's note: this one imported like a charm!]

 TESTS  -

Subject: Improve pragma/locale test 102 - and don't fail, just warn
From: Jarkko Hietaniemi <jhi@anna.in-berlin.de>
Files: t/pragma/locale.t

Subject: Invalid test output in t/op/taint.t in trial 1
From: Dan Sugalski <sugalsd@lbcc.cc.or.us>
Files: t/op/taint.t

    t/op/taint.t prints out invalid ok messages for tests it skips.
    Rather than printing "ok 136" it prints "136 ok".
    
    p5p-msgid: 3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us

 UTILITIES  -

Subject: Perldoc tiny patch to avoid $0
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: utils/perldoc.PL
Msg-ID: 199709122141.RAA16846@monk.mps.ohio-state.edu

    (applied based on p5p patch as commit 0b166b6635cf199f072db516b2a523ee659394d5)

Subject: h2ph broken in 5.004_02
From: David Mazieres <dm@reeducation-labor.lcs.mit.edu>
Files: utils/h2ph.PL
Msg-ID: 199708201700.KAA02621@www.chapin.edu

    (applied based on p5p patch as commit 4a8e146e38ec2045f1f817a7cb578e1b1f80f39f)

Subject: add key_t caddr_t to h2ph
From: Tony Sanders <sanders@bsdi.com>
Files: eg/sysvipc/ipcsem utils/h2ph.PL
Msg-ID: 199708272301.RAA12803@austin.bsdi.com

    (applied based on p5p patch as commit 0806a92ffc3a74ca70aa81051cdf2a306cd0a8af)

Subject: perldoc search ., lib and blib/* if -f 'Makefile.PL'
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc finds wrong pod2man
    
    (from perldoc source)
    
        # We must look both in @INC for library modules and in PATH
        # for executables, like h2xs or perldoc itself.
    
    Unfortunately, searching PATH for installed perl executables like
    pod2man is INCORRECT.  perldoc should start by searching the
    directory it was executed from, which might not be in the PATH
    at all.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199708251732.KAA19299@gadget.cscaper.com

Subject: 5.004m4t1: perlbug: NIS domainname gets into wrong places
From: Andreas J. Koenig <koenig@anna.mind.de>
Files: utils/perlbug.PL
Msg-ID: sfcg1qy38as.fsf@anna.in-berlin.de

    (applied based on p5p patch as commit 41f926b844140b7f7eaa9302113e45df3a9f9ff4)

Subject: add better local patch info to perlbug
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perlbug.PL

Subject: perldoc - suggest modules if requested module not found
From: Anthony David <adavid@netinfo.com.au>
Files: utils/perldoc.PL

    private-msgid: 3439CD83.6969@netinfo.com.au

Subject: perldoc mail::foo tries to read binary /usr/ucb/mail
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

    Subject: perldoc weirdness
    
    perldoc mail::imap yields:
    
    {joseph}:79% perldoc mail::foo
    can't open /usr/ucb/mail: Permission denied at ./pod2man line 362.
    
    Credited: Joseph "Moof-in'" Hall <joseph@cscaper.com>
    
    p5p-msgid: 199710082014.NAA00808@gadget.cscaper.com

Subject: perldoc -f setpwent (for example) returns no descriptive text
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Files: utils/perldoc.PL

Subject: perldoc diffs: don't search auto - much faster
From: "Joseph N. Hall" <joseph@5sigma.com>
Files: utils/perldoc.PL
Msg-ID: MailDrop1.2d7dPPC.971012211957@screechy.cscaper.com

    (applied based on p5p patch as commit 62b753c6ae4ab9bf22fbb6ec7ceac820bcef8fe4)

3 files changed, 152 insertions, 79 deletions

diff --git a/utils/h2ph.PL b/utils/h2ph.PL
index d48571f00f..1b469daab8 100644
--- a/utils/h2ph.PL
+++ b/utils/h2ph.PL
@@ -50,7 +50,7 @@ die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
 	short	ushort	u_short
 	int	uint	u_int
 	long	ulong	u_long
-	FILE
+	FILE	key_t	caddr_t
 END
 
 @isatype{@isatype} = (1) x @isatype;
@@ -132,7 +132,7 @@ foreach $file (@ARGV) {
                       print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
 		    }
 		    else {
-                      print OUT $t,"unless(defined(\&$name) {\nsub $name () {",$new,";}\n}\n";
+                      print OUT $t,"unless(defined(\&$name)) {\nsub $name () {",$new,";}\n}\n";
 		    }
 		}
 	    }
@@ -191,9 +191,10 @@ exit $Exit;
 
 sub expr {
     while ($_ ne '') {
+	s/^\&//;		# hack for things that take the address of
 	s/^(\s+)//		&& do {$new .= ' '; next;};
 	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
-	s/^(\d+)[LlUu]*//	&& do {$new .= $1; next;};
+	s/^(\d+)\s*[LlUu]*//	&& do {$new .= $1; next;};
 	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
 	s/^'((\\"|[^"])*)'//	&& do {
 	    if ($curargs{$1}) {
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 6b670fc46b..724df6b449 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -26,18 +26,22 @@ open PATCH_LEVEL, "<../patchlevel.h" or die "Can't open patchlevel.h: $!";
 my $patchlevel_date = (stat PATCH_LEVEL)[9];
 
 while (<PATCH_LEVEL>) {
-    last if index($_, "static\tchar\t*local_patches[] = {") >= 0;
+    last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
 };
 
-my $patches;
+my @patches;
 while (<PATCH_LEVEL>) {
-    last if /^}/;
+    last if /^\s*}/;
     chomp;
     s/^\s+,?"?//;
     s/"?,?$//;
     s/(['\\])/\\$1/g;
-    $patches .= "'$_',\n" unless $_ eq 'NULL';
+    push @patches, $_ unless $_ eq 'NULL';
 };
+my $patch_desc = "'" . join("',\n\t'", @patches) . "'";
+my @patch_tags = map { my $p=$_; $p=~s/\s.*//; $p } @patches;
+my $patch_tags = join " ", map { "+$_" } @patch_tags;
+$patch_tags .= " " if $patch_tags;
 
 close PATCH_LEVEL;
 
@@ -56,8 +60,13 @@ $Config{startperl}
     eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
 	if \$running_under_some_shell;
 
+my \$config_tag1 = '$] - $Config{cf_time}';
+
 my \$patchlevel_date = $patchlevel_date;
-my \@patches = ( $patches );
+my \$patch_tags = '$patch_tags';
+my \@patches = (
+	$patch_desc
+);
 !GROK!THIS!
 
 # In the following, perl variables are not expanded during extraction.
@@ -80,7 +89,7 @@ use strict;
 sub paraprint;
 
 
-my($Version) = "1.19";
+my($Version) = "1.20";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -104,6 +113,7 @@ my($Version) = "1.19";
 # Changed in 1.19 '-ok' default not '-v'
 #                 add local patch information
 #                 warn on '-ok' if this is an old system; add '-okay'
+# Changed in 1.20 Added patchlevel.h reading and version/config checks
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is 
@@ -114,6 +124,8 @@ my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
     $subject, $from, $verbose, $ed, 
     $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 
+my $config_tag2 = "$] - $Config{cf_time}";
+
 Init();
 
 if($::opt_h) { Help(); exit; }
@@ -204,8 +216,8 @@ EOF
 		$::opt_S = 1; # don't prompt for send
 		$::opt_C = 1; # don't send a copy to the local admin
 		$::opt_s = 1;
-		$subject = "OK: perl $] on"
-			  ." $::Config{'osname'} $::Config{'osvers'} $subject";
+		$subject = "OK: perl $] ${patch_tags}on"
+			  ." $::Config{'archname'} $::Config{'osvers'} $subject";
 		$::opt_b = 1;
 		$body    = "Perl reported to build OK on this system.\n";
 		$ok = 1;
@@ -292,12 +304,9 @@ EOF
 			$domain = Mail::Util::maildomain();
 		} elsif ($Is_MSWin32) {
 			$domain = $ENV{'USERDOMAIN'};
-		} elsif ($Is_VMS) {
+		} else {
 			require Sys::Hostname;
 			$domain = Sys::Hostname::hostname();
-		} else {
-			$domain = `hostname`.".".`domainname`;
-			$domain =~ s/[\r\n]+//g;
 		}
 	    
 	    my($guess);
@@ -534,9 +543,13 @@ EOF
 sub Dump {
 	local(*OUT) = @_;
 	
-	print OUT <<EOF;
+	print REP "\n---\n";
 
----
+	print REP "This perlbug was built using Perl $config_tag1\n",
+		  "It is being executed now by  Perl $config_tag2.\n\n"
+	    if $config_tag2 ne $config_tag1;
+
+	print OUT <<EOF;
 Site configuration information for perl $]:
 
 EOF
@@ -548,7 +561,7 @@ EOF
 	print OUT Config::myconfig;
 
 	if (@patches) {
-		print OUT join "\n\t", "\nLocally applied patches:", @patches;
+		print OUT join "\n\t", "Locally applied patches:", @patches;
                 print OUT "\n";
         };
 
@@ -878,8 +891,9 @@ Options:
         This prints out your configuration data, without mailing
         anything. You can use this with -v to get more complete data.
   -ok   Report successful build on this system to perl porters
-        (use alone or with -v).
-  -okay As -ok but also report on older systems.
+        (use alone or with -v). Only use -ok if *everything* was ok.
+        If there were *any* problems at all then don't use -ok.
+  -okay As -ok but allow report from old builds.
   -h    Print this help message. 
   
 EOF
diff --git a/utils/perldoc.PL b/utils/perldoc.PL
index 38ea9ee5ca..d223a9aaf9 100644
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -45,10 +45,11 @@ print OUT <<'!NO!SUBS!';
 # the perl manuals, though it too is written in perl.
 
 if(@ARGV<1) {
-        $0 =~ s,.*/,,;
+	$me = $0;		# Editing $0 is unportable
+	$me =~ s,.*/,,;
 	die <<EOF;
-Usage: $0 [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
-       $0 -f PerlFunc
+Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
+       $me -f PerlFunc
 
 We suggest you use "perldoc perldoc" to get aquainted 
 with the system.
@@ -58,6 +59,9 @@ EOF
 use Getopt::Std;
 use Config '%Config';
 
+@global_found = ();
+$global_target = "";
+
 $Is_VMS = $^O eq 'VMS';
 $Is_MSWin32 = $^O eq 'MSWin32';
 
@@ -118,36 +122,60 @@ if ($opt_f) {
    @pages = @ARGV;
 }
 
+# Does this look like a module or extension directory?
+if (-f "Makefile.PL") {
+	# Add ., lib and blib/* libs to @INC (if they exist)
+	unshift(@INC, '.');
+	unshift(@INC, 'lib') if -d 'lib';
+	require ExtUtils::testlib;
+}
+
 
 
 sub containspod {
-	my($file) = @_;
-	local($_);
-	open(TEST,"<$file");
-	while(<TEST>) {
-		if(/^=head/) {
-			close(TEST);
-			return 1;
-		}
+    my($file, $readit) = @_;
+    return 1 if !$readit && $file =~ /\.pod$/i;
+    local($_);
+    open(TEST,"<$file");
+    while(<TEST>) {
+	if(/^=head/) {
+	    close(TEST);
+	    return 1;
 	}
-	close(TEST);
-	return 0;
+    }
+    close(TEST);
+    return 0;
 }
 
 sub minus_f_nocase {
      my($file) = @_;
      # on a case-forgiving file system we can simply use -f $file
      if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') {
-        return ( -f $file ) ? $file : '';
+        return $file if -f $file and -r _;
+	warn "Ignored $file: unreadable\n" unless -r _;
+	return '';
      }
      local *DIR;
      local($")="/";
      my(@p,$p,$cip);
      foreach $p (split(/\//, $file)){
- 	if (-d ("@p/$p")){
+	my $try = "@p/$p";
+	stat $try;
+ 	if (-d _){
  	    push @p, $p;
- 	} elsif (-f ("@p/$p")) {
- 	    return "@p/$p";
+	    if ( $p eq $global_target) {
+		$tmp_path = join ('/', @p);
+		my $path_f = 0;
+		for (@global_found) {
+		    $path_f = 1 if $_ eq $tmp_path;
+		}
+		push (@global_found, $tmp_path) unless $path_f;
+		print STDERR "Found as @p but directory\n" if $opt_v;
+	    }
+ 	} elsif (-f _ && -r _) {
+ 	    return $try;
+ 	} elsif (-f _) {
+	    warn "Ignored $try: unreadable\n";
  	} else {
  	    my $found=0;
  	    my $lcp = lc $p;
@@ -161,49 +189,64 @@ sub minus_f_nocase {
  	    closedir DIR;
  	    return "" unless $found;
  	    push @p, $cip;
- 	    return "@p" if -f "@p";
+ 	    return "@p" if -f "@p" and -r _;
+	    warn "Ignored $file: unreadable\n" if -f _;
  	}
      }
      return; # is not a file
- }
+}
  
-  sub searchfor {
-  	my($recurse,$s,@dirs) = @_;
-  	$s =~ s!::!/!g;
-  	$s = VMS::Filespec::unixify($s) if $Is_VMS;
-	return $s if -f $s && containspod($s);
-  	printf STDERR "looking for $s in @dirs\n" if $opt_v;
- 	my $ret;
- 	my $i;
- 	my $dir;
-  	for ($i=0;$i<@dirs;$i++) {
-  		$dir = $dirs[$i];
-  		($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
- 	    if ((    $ret = minus_f_nocase "$dir/$s.pod")
- 		or ( $ret = minus_f_nocase "$dir/$s.pm"  and containspod($ret))
- 		or ( $ret = minus_f_nocase "$dir/$s"     and containspod($ret))
-  		or ( $Is_VMS and 
- 		     $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
+
+sub check_file {
+    my($file) = @_;
+    return minus_f_nocase($file) && containspod($file) ? $file : "";
+}
+
+
+sub searchfor {
+    my($recurse,$s,@dirs) = @_;
+    $s =~ s!::!/!g;
+    $s = VMS::Filespec::unixify($s) if $Is_VMS;
+    return $s if -f $s && containspod($s);
+    printf STDERR "Looking for $s in @dirs\n" if $opt_v;
+    my $ret;
+    my $i;
+    my $dir;
+    $global_target = (split('/', $s))[-1];
+    for ($i=0; $i<@dirs; $i++) {
+	$dir = $dirs[$i];
+	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
+	if (       ( $ret = check_file "$dir/$s.pod")
+		or ( $ret = check_file "$dir/$s.pm")
+		or ( $ret = check_file "$dir/$s")
+		or ( $Is_VMS and
+		     $ret = check_file "$dir/$s.com")
 		or ( $^O eq 'os2' and 
- 		     $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret))
+		     $ret = check_file "$dir/$s.cmd")
 		or ( ($Is_MSWin32 or $^O eq 'os2') and 
- 		     $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret))
- 		or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
- 		or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
- 		{ return $ret; }
- 		
- 		if($recurse) {
-			opendir(D,$dir);
-			my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
-			closedir(D);
-			@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
-			next unless @newdirs;
-			print STDERR "Also looking in @newdirs\n" if $opt_v;
-			push(@dirs,@newdirs);
- 		}
- 	}
-  	return ();
-  }
+		     $ret = check_file "$dir/$s.bat")
+		or ( $ret = check_file "$dir/pod/$s.pod")
+		or ( $ret = check_file "$dir/pod/$s")
+	) {
+	    return $ret;
+	}
+	
+	if ($recurse) {
+	    opendir(D,$dir);
+	    my @newdirs = map "$dir/$_", grep {
+		not /^\.\.?$/ and
+		not /^auto$/  and   # save time! don't search auto dirs
+		-d  "$dir/$_"
+	    } readdir D;
+	    closedir(D);
+	    next unless @newdirs;
+	    @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
+	    print STDERR "Also looking in @newdirs\n" if $opt_v;
+	    push(@dirs,@newdirs);
+	}
+    }
+    return ();
+}
 
 
 foreach (@pages) {
@@ -230,12 +273,24 @@ foreach (@pages) {
 		
 		@searchdirs = grep(!/^\.$/,@INC);
 		
-		
 		@files= searchfor(1,$_,@searchdirs);
 		if( @files ) {
 			print STDERR "Loosely found as @files\n" if $opt_v;
 		} else {
-			print STDERR "No documentation found for '$_'\n";
+			print STDERR "No documentation found for \"$_\".\n";
+			if (@global_found) {
+			    print STDERR "However, try\n";
+			    my $dir = $file = "";
+			    for $dir (@global_found) {
+				opendir(DIR, $dir) or die "$!";
+				while ($file = readdir(DIR)) {
+				    next if ($file =~ /^\./);
+				    $file =~ s/\.(pm|pod)$//;
+				    print STDERR "\tperldoc $_\::$file\n";
+				}
+				closedir DIR;
+			    }
+			}
 		}
 	}
 	push(@found,@files);
@@ -290,13 +345,16 @@ if ($opt_f) {
 
    # Look for our function
    my $found = 0;
+   my @pod;
    while (<PFUNC>) {
        if (/^=item\s+\Q$opt_f\E\b/o)  {
-	   $found++;
+	   $found = 1;
        } elsif (/^=item/) {
-	   last if $found;
+	   last if $found > 1;
        }
-       push(@pod, $_) if $found;
+       next unless $found;
+       push @pod, $_;
+       ++$found if /^\w/;	# found descriptive text
    }
    if (@pod) {
        if ($opt_t) {