X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/31bdbec1d6f429e8532f3bb66cddf8b47418f4fa..4dcba7838f3fd83292ddf7d8be7a7a2e8a4f9854:/utils/perldoc.PL

diff --git a/utils/perldoc.PL b/utils/perldoc.PL
index b6f8bf9..129d985 100644
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -57,23 +57,24 @@ EOF
 
 use Getopt::Std;
 $Is_VMS = $^O eq 'VMS';
+$Is_MSWin32 = $^O eq 'MSWin32';
 
 sub usage{
-        warn "@_\n" if @_;
-    # Make sure exit status is success under VMS, so shell doesn't
-    # display error messages left over from startup.
-    ($! = 0, $^E = 1) if $^O eq 'VMS';
+    warn "@_\n" if @_;
+    # Erase evidence of previous errors (if any), so exit status is simple.
+    $! = 0;
     die <<EOF;
 perldoc [options] PageName|ModuleName|ProgramName...
 perldoc [options] -f BuiltinFunction
 
 Options:
-    -h   Display this help message.
-    -t   Display pod using pod2text instead of pod2man and nroff.
+    -h   Display this help message
+    -t   Display pod using pod2text instead of pod2man and nroff
+             (-t is the default on win32)
     -u	 Display unformatted pod text
     -m   Display modules file in its entirety
     -l   Display the modules file name
-    -v	 Verbosely describe what's going on.
+    -v	 Verbosely describe what's going on
 
 PageName|ModuleName...
          is the name of a piece of documentation that you want to look at. You 
@@ -101,7 +102,11 @@ getopts("mhtluvf:") || usage;
 
 usage if $opt_h || $opt_h; # avoid -w warning
 
-usage("only one of -t, -u, -m or -l") if $opt_t + $opt_u + $opt_m + $opt_l > 1;
+if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
+    usage("only one of -t, -u, -m or -l")
+} elsif ($Is_MSWin32) {
+    $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
+}
 
 if ($opt_t) { require Pod::Text; import Pod::Text; }
 
@@ -133,7 +138,7 @@ sub containspod {
      local($")="/";
      my(@p,$p,$cip);
      foreach $p (split(/\//, $file)){
-	if (($Is_VMS or $^O eq 'os2') and not scalar @p) {
+	if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) {
 	    # VMSish filesystems don't begin at '/'
 	    push(@p,$p);
 	    next;
@@ -177,8 +182,10 @@ sub containspod {
  	    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 
+  		or ( $Is_VMS and 
  		     $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
+		or ( $Is_MSWin32 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; }
@@ -208,6 +215,8 @@ foreach (@pages) {
 		for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
 		    push(@searchdirs,$trn);
 		}
+	    } elsif ($Is_MSWin32) {
+	        push(@searchdirs, grep(-d, split(';', $ENV{'PATH'})));
 	    } else {
 		    push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
 	    }
@@ -242,22 +251,26 @@ if ($opt_l) {
 
 if( ! -t STDOUT ) { $no_tty = 1 }
 
-unless($Is_VMS) {
-	$tmp = "/tmp/perldoc1.$$";
-	push @pagers, qw( more less pg view cat );
+if ($Is_MSWin32) {
+	$tmp = "$ENV{TEMP}\\perldoc1.$$";
+	push @pagers, qw( more< less notepad );
 	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
-} else {
+} elsif ($Is_VMS) {
 	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
 	push @pagers, qw( most more less type/page );
+} else {
+	$tmp = "/tmp/perldoc1.$$";
+	push @pagers, qw( more less pg view cat );
+	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
 }
 unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
 
 if ($opt_m) {
-    foreach $pager (@pagers) {
-	my($sts) = system("$pager @found");
-	exit 0 if ($Is_VMS ? ($sts & 1) : !$sts);
-    }
-    exit $Is_VMS ? $sts : 1;
+	foreach $pager (@pagers) {
+		system("$pager @found") or exit;
+	}
+	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
+	exit 1;
 } 
 
 if ($opt_f) {
@@ -290,7 +303,7 @@ if ($opt_f) {
 	   print @pod;
        }
    } else {
-       die "No documentation for perl function `$func' found\n";
+       die "No documentation for perl function `$opt_f' found\n";
    }
    exit;
 }
@@ -302,16 +315,14 @@ foreach (@found) {
 		Pod::Text::pod2text($_,*TMP);
 		close(TMP);
 	} elsif(not $opt_u) {
-		open(TMP,">>$tmp");
-		if($^O =~ /hpux/) {
-			$rslt = `pod2man $_ | nroff -man | col -x`;
-		} else {
-			$rslt = `pod2man $_ | nroff -man`;
+		my $cmd = "pod2man --lax $_ | nroff -man";
+		$cmd .= " | col -x" if $^O =~ /hpux/;
+		$rslt = `$cmd`;
+		unless(($err = $?)) {
+			open(TMP,">>$tmp");
+			print TMP $rslt;
+			close TMP;
 		}
-		if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
-		else      { $err = $?; }
-		print TMP $rslt unless $err;
-		close TMP;
 	}
 	                                                
 	if( $opt_u or $err or -z $tmp) {
@@ -334,9 +345,7 @@ if( $no_tty ) {
 	close(TMP);
 } else {
 	foreach $pager (@pagers) {
-		$sts = system("$pager $tmp");
-		last if $Is_VMS && ($sts & 1);
-		last unless $sts;
+		system("$pager $tmp") or last;
 	}
 }
 
@@ -433,6 +442,9 @@ Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
 =cut
 
 #
+# Version 1.12: Sat Apr 12 22:41:09 EST 1997
+#       Gurusamy Sarathy <gsar@umich.edu>
+#	-various fixes for win32
 # Version 1.11: Tue Dec 26 09:54:33 EST 1995
 #       Kenneth Albanowski <kjahds@kjahds.com>
 #   -added Charles Bailey's further VMS patches, and -u switch