More VERSION tuning: to avoid unnecessary Perl upgrades

[p5sagit/p5-mst-13.2.git] / lib / Cwd.pm

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 385f972..27a3105 100644 (file)
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -85,6 +85,10 @@ use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
+eval {
+    require XSLoader;
+    XSLoader::load('Cwd');
+};
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 
@@ -121,20 +125,6 @@ sub getcwd
     abs_path('.');
 }
 
-# Now a callout to an XSUB.  We have to delay booting of the XSUB
-# until the first time fastcwd is called since Cwd::cwd is needed in the
-# building of perl when dynamic loading may be unavailable
-my $booted = 0;
-sub fastcwd {
-    unless ($booted) {
-       require XSLoader;
-        XSLoader::load("Cwd");
-       ++$booted;
-    }
-    return &Cwd::_fastcwd;
-}
-
-
 # Keeps track of current working directory in PWD environment var
 # Usage:
 #      use Cwd 'chdir';
@@ -170,7 +160,14 @@ sub chdir {
     my $newdir = @_ ? shift : '';      # allow for no arg (chdir to HOME dir)
     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
     chdir_init() unless $chdir_init;
+    my $newpwd;
+    if ($^O eq 'MSWin32') {
+       # get the full path name *before* the chdir()
+       $newpwd = Win32::GetFullPathName($newdir);
+    }
+
     return 0 unless CORE::chdir $newdir;
+
     if ($^O eq 'VMS') {
        return $ENV{'PWD'} = $ENV{'DEFAULT'}
     }
@@ -178,7 +175,7 @@ sub chdir {
        return $ENV{'PWD'} = cwd();
     }
     elsif ($^O eq 'MSWin32') {
-       $ENV{'PWD'} = Win32::GetFullPathName($newdir);
+       $ENV{'PWD'} = $newpwd;
        return 1;
     }
 
@@ -198,63 +195,6 @@ sub chdir {
     1;
 }
 
-# Taken from Cwd.pm It is really getcwd with an optional
-# parameter instead of '.'
-#
-
-sub abs_path
-{
-    my $start = @_ ? shift : '.';
-    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
-
-    unless (@cst = stat( $start ))
-    {
-       carp "stat($start): $!";
-       return '';
-    }
-    $cwd = '';
-    $dotdots = $start;
-    do
-    {
-       $dotdots .= '/..';
-       @pst = @cst;
-       unless (opendir(PARENT, $dotdots))
-       {
-           carp "opendir($dotdots): $!";
-           return '';
-       }
-       unless (@cst = stat($dotdots))
-       {
-           carp "stat($dotdots): $!";
-           closedir(PARENT);
-           return '';
-       }
-       if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
-       {
-           $dir = undef;
-       }
-       else
-       {
-           do
-           {
-               unless (defined ($dir = readdir(PARENT)))
-               {
-                   carp "readdir($dotdots): $!";
-                   closedir(PARENT);
-                   return '';
-               }
-               $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
-           }
-           while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
-                  $tst[1] != $pst[1]);
-       }
-       $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
-       closedir(PARENT);
-    } while (defined $dir);
-    chop($cwd) unless $cwd eq '/'; # drop the trailing /
-    $cwd;
-}
-
 # added function alias for those of us more
 # used to the libc function.  --tchrist 27-Jan-00
 *realpath = \&abs_path;