diff options
Diffstat (limited to 'lib/Cwd.pm')
| -rw-r--r-- | lib/Cwd.pm | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/lib/Cwd.pm b/lib/Cwd.pm index b27e088847..20b175c81d 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -1,18 +1,30 @@ package Cwd; require 5.000; require Exporter; +use Config; @ISA = qw(Exporter); @EXPORT = qw(getcwd fastcwd); @EXPORT_OK = qw(chdir); +# VMS: $ENV{'DEFAULT'} points to default directory at all times +# 08-Dec-1994 Charles Bailey bailey@genetics.upenn.edu +# Note: Use of Cwd::getcwd() or Cwd::chdir() (but not Cwd::fastcwd()) +# causes the logical name PWD to be defined in the process +# logical name table as the default device and directory +# seen by Perl. This may not be the same as the default device +# and directory seen by DCL after Perl exits, since the effects +# the CRTL chdir() function persist only until Perl exits. + # By Brandon S. Allbery # # Usage: $cwd = getcwd(); sub getcwd { + if($Config{'osname'} eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } + my($dotdots, $cwd, @pst, @cst, $dir, @tst); unless (@cst = stat('.')) @@ -79,6 +91,8 @@ sub getcwd # you might chdir out of a directory that you can't chdir back into. sub fastcwd { + if($Config{'osname'} eq 'VMS') { return $ENV{'DEFAULT'} } + my($odev, $oino, $cdev, $cino, $tdev, $tino); my(@path, $path); local(*DIR); @@ -143,8 +157,11 @@ sub chdir_init{ sub chdir { my($newdir) = shift; + $newdir =~ s|/{2,}|/|g; chdir_init() unless $chdir_init; return 0 unless (CORE::chdir $newdir); + if ($Config{'osname'} eq 'VMS') { return $ENV{PWD} = $ENV{DEFAULT} } + if ($newdir =~ m#^/#) { $ENV{'PWD'} = $newdir; }else{ |