diff options
Diffstat (limited to 'utils/perldoc.PL')
| -rw-r--r-- | utils/perldoc.PL | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 129d985882..38ea9ee5ca 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -56,6 +56,8 @@ EOF } use Getopt::Std; +use Config '%Config'; + $Is_VMS = $^O eq 'VMS'; $Is_MSWin32 = $^O eq 'MSWin32'; @@ -132,17 +134,16 @@ sub containspod { return 0; } - sub minus_f_nocase { +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 : ''; + } local *DIR; local($")="/"; my(@p,$p,$cip); foreach $p (split(/\//, $file)){ - if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) { - # VMSish filesystems don't begin at '/' - push(@p,$p); - next; - } if (-d ("@p/$p")){ push @p, $p; } elsif (-f ("@p/$p")) { @@ -152,7 +153,6 @@ sub containspod { my $lcp = lc $p; opendir DIR, "@p"; while ($cip=readdir(DIR)) { - $cip =~ s/\.dir$// if $Is_VMS; if (lc $cip eq $lcp){ $found++; last; @@ -184,7 +184,9 @@ sub containspod { or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret)) or ( $Is_VMS and $ret = minus_f_nocase "$dir/$s.com" and containspod($ret)) - or ( $Is_MSWin32 and + or ( $^O eq 'os2' and + $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret)) + 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))) @@ -215,10 +217,9 @@ 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'}))); + push(@searchdirs, grep(-d, split($Config{path_sep}, + $ENV{'PATH'}))); } @files= searchfor(0,$_,@searchdirs); } @@ -259,7 +260,12 @@ if ($Is_MSWin32) { $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$; push @pagers, qw( most more less type/page ); } else { - $tmp = "/tmp/perldoc1.$$"; + if ($^O eq 'os2') { + require POSIX; + $tmp = POSIX::tmpnam(); + } else { + $tmp = "/tmp/perldoc1.$$"; + } push @pagers, qw( more less pg view cat ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } |