Update ExtUtils-Install to 1.51

[perl5.git] / lib / Cwd.pm

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index d5a6db8..3bf704f 100644 (file)
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -35,7 +35,8 @@ absolute path of the current working directory.
 
 Returns the current working directory.
 
-Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
+Exposes the POSIX function getcwd(3) or re-implements it if it's not
+available.
 
 =item cwd
 
@@ -170,7 +171,9 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.14';
+$VERSION = '3.29';
+my $xs_version = $VERSION;
+$VERSION = eval $VERSION;
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -203,11 +206,11 @@ if ($^O eq 'os2') {
 eval {
   if ( $] >= 5.006 ) {
     require XSLoader;
-    XSLoader::load( __PACKAGE__, $VERSION );
+    XSLoader::load( __PACKAGE__, $xs_version);
   } else {
     require DynaLoader;
     push @ISA, 'DynaLoader';
-    __PACKAGE__->bootstrap( $VERSION );
+    __PACKAGE__->bootstrap( $xs_version );
   }
 };
 
@@ -302,6 +305,7 @@ foreach my $try ('/bin/pwd',
         last;
     }
 }
+my $found_pwd_cmd = defined($pwd_cmd);
 unless ($pwd_cmd) {
     # Isn't this wrong?  _backtick_pwd() will fail if somenone has
     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
@@ -334,9 +338,19 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     # The pwd command is not available in some chroot(2)'ed environments
     my $sep = $Config::Config{path_sep} || ':';
     my $os = $^O;  # Protect $^O from tainting
-    if( $os eq 'MacOS' || (defined $ENV{PATH} &&
-                          $os ne 'MSWin32' &&  # no pwd on Windows
-                          grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
+
+
+    # Try again to find a pwd, this time searching the whole PATH.
+    if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
+       my @candidates = split($sep, $ENV{PATH});
+       while (!$found_pwd_cmd and @candidates) {
+           my $candidate = shift @candidates;
+           $found_pwd_cmd = 1 if -x "$candidate/pwd";
+       }
+    }
+
+    # MacOS has some special magic to make `pwd` work.
+    if( $os eq 'MacOS' || $found_pwd_cmd )
     {
        *cwd = \&_backtick_pwd;
     }
@@ -345,20 +359,26 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     }
 }
 
+if ($^O eq 'cygwin') {
+  # We need to make sure cwd() is called with no args, because it's
+  # got an arg-less prototype and will die if args are present.
+  local $^W = 0;
+  my $orig_cwd = \&cwd;
+  *cwd = sub { &$orig_cwd() }
+}
+
+
 # set a reasonable (and very safe) default for fastgetcwd, in case it
 # isn't redefined later (20001212 rspier)
 *fastgetcwd = \&cwd;
 
-# By Brandon S. Allbery
-#
-# Usage: $cwd = getcwd();
-
-sub getcwd
+# A non-XS version of getcwd() - also used to bootstrap the perl build
+# process, when miniperl is running and no XS loading happens.
+sub _perl_getcwd
 {
     abs_path('.');
 }
 
-
 # By John Bazik
 #
 # Usage: $cwd = &fastcwd;
@@ -461,7 +481,9 @@ sub chdir {
        return 1;
     }
 
-    if ($newdir =~ m#^/#s) {
+    if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
+       $ENV{'PWD'} = cwd();
+    } elsif ($newdir =~ m#^/#s) {
        $ENV{'PWD'} = $newdir;
     } else {
        my @curdir = split(m#/#,$ENV{'PWD'});
@@ -520,8 +542,8 @@ sub _perl_abs_path
        local *PARENT;
        unless (opendir(PARENT, $dotdots))
        {
-           _carp("opendir($dotdots): $!");
-           return '';
+           # probably a permissions issue.  Try the native command.
+           return File::Spec->rel2abs( $start, _backtick_pwd() );
        }
        unless (@cst = stat($dotdots))
        {
@@ -624,11 +646,38 @@ sub _vms_cwd {
 
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
+    my $path = shift;
 
-    # may need to turn foo.dir into [.foo]
-    my $path = VMS::Filespec::pathify($_[0]);
-    $path = $_[0] unless defined $path;
+    if (-l $path) {
+        my $link_target = readlink($path);
+        die "Can't resolve link $path: $!" unless defined $link_target;
+           
+        return _vms_abs_path($link_target);
+    }
+
+    if (defined &VMS::Filespec::vms_realpath) {
+        my $path = $_[0];
+        if ($path =~ m#(?<=\^)/# ) {
+            # Unix format
+            return VMS::Filespec::vms_realpath($path);
+        }
 
+       # VMS format
+
+       my $new_path = VMS::Filespec::vms_realname($path); 
+
+       # Perl expects directories to be in directory format
+       $new_path = VMS::Filespec::pathify($new_path) if -d $path;
+       return $new_path;
+    }
+
+    # Fallback to older algorithm if correct ones are not
+    # available.
+
+    # may need to turn foo.dir into [.foo]
+    my $pathified = VMS::Filespec::pathify($path);
+    $path = $pathified if defined $pathified;
+       
     return VMS::Filespec::rmsexpand($path);
 }
 
@@ -640,7 +689,12 @@ sub _os2_cwd {
 }
 
 sub _win32_cwd {
-    $ENV{'PWD'} = Win32::GetCwd();
+    if (defined &DynaLoader::boot_DynaLoader) {
+       $ENV{'PWD'} = Win32::GetCwd();
+    }
+    else { # miniperl
+       chomp($ENV{'PWD'} = `cd`);
+    }
     $ENV{'PWD'} =~ s:\\:/:g ;
     return $ENV{'PWD'};
 }
@@ -702,6 +756,7 @@ if (exists $METHOD_MAP{$^O}) {
 
 # In case the XS version doesn't load.
 *abs_path = \&_perl_abs_path unless defined &abs_path;
+*getcwd = \&_perl_getcwd unless defined &getcwd;
 
 # added function alias for those of us more
 # used to the libc function.  --tchrist 27-Jan-00