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 6f28088..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,53 +125,6 @@ sub getcwd
     abs_path('.');
 }
 
-# By John Bazik
-#
-# Usage: $cwd = &fastcwd;
-#
-# This is a faster version of getcwd.  It's also more dangerous because
-# you might chdir out of a directory that you can't chdir back into.
-    
-sub fastcwd {
-    my($odev, $oino, $cdev, $cino, $tdev, $tino);
-    my(@path, $path);
-    local(*DIR);
-
-    my($orig_cdev, $orig_cino) = stat('.');
-    ($cdev, $cino) = ($orig_cdev, $orig_cino);
-    for (;;) {
-       my $direntry;
-       ($odev, $oino) = ($cdev, $cino);
-       CORE::chdir('..') || return undef;
-       ($cdev, $cino) = stat('.');
-       last if $odev == $cdev && $oino == $cino;
-       opendir(DIR, '.') || return undef;
-       for (;;) {
-           $direntry = readdir(DIR);
-           last unless defined $direntry;
-           next if $direntry eq '.';
-           next if $direntry eq '..';
-
-           ($tdev, $tino) = lstat($direntry);
-           last unless $tdev != $odev || $tino != $oino;
-       }
-       closedir(DIR);
-       return undef unless defined $direntry; # should never happen
-       unshift(@path, $direntry);
-    }
-    $path = '/' . join('/', @path);
-    if ($^O eq 'apollo') { $path = "/".$path; }
-    # At this point $path may be tainted (if tainting) and chdir would fail.
-    # To be more useful we untaint it then check that we landed where we started.
-    $path = $1 if $path =~ /^(.*)\z/s; # untaint
-    CORE::chdir($path) || return undef;
-    ($cdev, $cino) = stat('.');
-    die "Unstable directory path, current directory changed unexpectedly"
-       if $cdev != $orig_cdev || $cino != $orig_cino;
-    $path;
-}
-
-
 # Keeps track of current working directory in PWD environment var
 # Usage:
 #      use Cwd 'chdir';
@@ -203,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'}
     }
@@ -211,7 +175,7 @@ sub chdir {
        return $ENV{'PWD'} = cwd();
     }
     elsif ($^O eq 'MSWin32') {
-       $ENV{'PWD'} = Win32::GetFullPathName($newdir);
+       $ENV{'PWD'} = $newpwd;
        return 1;
     }
 
@@ -231,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;