diff options
Diffstat (limited to 'contrib/perl5/utils/perldoc.PL')
| -rw-r--r-- | contrib/perl5/utils/perldoc.PL | 57 |
1 files changed, 38 insertions, 19 deletions
diff --git a/contrib/perl5/utils/perldoc.PL b/contrib/perl5/utils/perldoc.PL index 32421d7..cfb773e 100644 --- a/contrib/perl5/utils/perldoc.PL +++ b/contrib/perl5/utils/perldoc.PL @@ -36,8 +36,15 @@ use strict; # make sure creat()s are neither too much nor too little INIT { eval { umask(0077) } } # doubtless someone has no mask +(my \$pager = <<'/../') =~ s/\\s*\\z//; +$Config{pager} +/../ my \@pagers = (); -push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}"; +push \@pagers, \$pager if -x \$pager; + +(my \$bindir = <<'/../') =~ s/\\s*\\z//; +$Config{scriptdir} +/../ !GROK!THIS! @@ -48,6 +55,7 @@ print OUT <<'!NO!SUBS!'; use Fcntl; # for sysopen use Getopt::Std; use Config '%Config'; +use File::Spec::Functions qw(catfile splitdir); # # Perldoc revision #1 -- look up a piece of documentation in .pod format that @@ -79,6 +87,7 @@ my $global_target = ""; my $Is_VMS = $^O eq 'VMS'; my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_Dos = $^O eq 'dos'; +my $Is_OS2 = $^O eq 'os2'; sub usage{ warn "@_\n" if @_; @@ -147,7 +156,7 @@ usage if $opt_h; # refuse to run if we should be tainting and aren't # (but regular users deserve protection too, though!) -if (!($Is_VMS || $Is_MSWin32 || $Is_Dos) && ($> == 0 || $< == 0) +if (!($Is_VMS || $Is_MSWin32 || $Is_Dos || $Is_OS2) && ($> == 0 || $< == 0) && !am_taint_checking()) {{ if ($opt_U) { @@ -201,8 +210,9 @@ if (-f "Makefile.PL") { eval q{ use lib qw(. lib); 1; } or die; # don't add if superuser - if ($< && $>) { # don't be looking too hard now! - eval q{ use blib; 1 } or die; + if ($< && $> && -f "blib") { # don't be looking too hard now! + eval q{ use blib; 1 }; + warn $@ if $@ && $opt_v; } } @@ -223,7 +233,7 @@ sub containspod { sub minus_f_nocase { my($dir,$file) = @_; - my $path = join('/',$dir,$file); # XXX: dirseps + my $path = catfile($dir,$file); return $path if -f $path and -r _; if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') { # on a case-forgiving file system or if case is important @@ -237,13 +247,13 @@ sub minus_f_nocase { local($")="/"; my @p = ($dir); my($p,$cip); - foreach $p (split(m!/!, $file)){ # XXX: dirseps - my $try = "@p/$p"; + foreach $p (splitdir $file){ + my $try = catfile @p, $p; stat $try; if (-d _) { push @p, $p; if ( $p eq $global_target) { - my $tmp_path = join ('/', @p); # XXX: dirseps + my $tmp_path = catfile @p; my $path_f = 0; for (@global_found) { $path_f = 1 if $_ eq $tmp_path; @@ -302,7 +312,7 @@ sub searchfor { my $ret; my $i; my $dir; - $global_target = (split(m!/!, $s))[-1]; # XXX: dirseps + $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename? for ($i=0; $i<@dirs; $i++) { $dir = $dirs[$i]; ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS; @@ -325,10 +335,10 @@ sub searchfor { if ($recurse) { opendir(D,$dir) or die "Can't opendir $dir: $!"; - my @newdirs = map "$dir/$_", grep { # XXX: dirseps + my @newdirs = map catfile($dir, $_), grep { not /^\.\.?\z/s and not /^auto\z/s and # save time! don't search auto dirs - -d "$dir/$_" # XXX: dirseps + -d catfile($dir, $_) } readdir D; closedir(D) or die "Can't closedir $dir: $!"; next unless @newdirs; @@ -362,7 +372,7 @@ sub printout { close OUT or die "can't close $tmp: $!"; } elsif (not $opt_u) { - my $cmd = "pod2man --lax $file | $opt_n -man"; + my $cmd = catfile($bindir, 'pod2man') . " --lax $file | $opt_n -man"; $cmd .= " | col -x" if $^O =~ /hpux/; my $rslt = `$cmd`; $rslt = filter_nroff($rslt) if $filter; @@ -406,7 +416,11 @@ sub page { } else { foreach my $pager (@pagers) { - last if system("$pager $tmp") == 0; + if ($Is_VMS) { + last if system("$pager $tmp") == 0; # quoting prevents logical expansion + } else { + last if system("$pager \"$tmp\"") == 0; + } } } } @@ -425,8 +439,7 @@ sub cleanup { my @found; foreach (@pages) { if ($podidx && open(PODIDX, $podidx)) { - my $searchfor = $_; - $searchfor =~ s,::,/,g; # XXX: dirseps + my $searchfor = catfile split '::'; print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v; local $_; while (<PODIDX>) { @@ -437,9 +450,9 @@ foreach (@pages) { next; } print STDERR "Searching for $_\n" if $opt_v; - # We must look both in @INC for library modules and in PATH + # We must look both in @INC for library modules and in $bindir # for executables, like h2xs or perldoc itself. - my @searchdirs = @INC; + my @searchdirs = ($bindir, @INC); if ($opt_F) { next unless -r; push @found, $_ if $opt_m or containspod($_); @@ -553,7 +566,10 @@ eval q{ sub END { cleanup($tmp, $buffer) } 1; } || die; -eval q{ use sigtrap qw(die INT TERM HUP QUIT) }; + +# exit/die in a windows sighandler is dangerous, so let it do the +# default thing, which is to exit +eval q{ use sigtrap qw(die INT TERM HUP QUIT) } unless $^O eq 'MSWin32'; if ($opt_m) { foreach my $pager (@pagers) { @@ -790,7 +806,7 @@ One useful value for C<PERLDOC_PAGER> is C<less -+C -E>. =head1 VERSION -This is perldoc v2.01. +This is perldoc v2.03. =head1 AUTHOR @@ -802,6 +818,9 @@ and others. =cut # +# Version 2.03: Sun Apr 23 16:56:34 BST 2000 +# Hugo van der Sanden <hv@crypt0.demon.co.uk> +# don't die when 'use blib' fails # Version 2.02: Mon Mar 13 18:03:04 MST 2000 # Tom Christiansen <tchrist@perl.com> # Added -U insecurity option |
