From: Gurusamy Sarathy Date: Tue, 25 Apr 2000 18:41:11 +0000 (+0000) Subject: make perldoc use the pod2man from the same version (from X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=14178d348d5e4cc1291b5c8895bf9f630e485832;p=p5sagit%2Fp5-mst-13.2.git make perldoc use the pod2man from the same version (from M.J.T. Guy) p4raw-id: //depot/perl@5949 --- diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 32421d7..297250c 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -38,6 +38,7 @@ INIT { eval { umask(0077) } } # doubtless someone has no mask my \@pagers = (); push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}"; +my \$bindir = "$Config{installscript}"; !GROK!THIS! @@ -48,6 +49,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 @@ -223,7 +225,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 +239,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 +304,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 +327,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 +364,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; @@ -425,8 +427,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 () {