lib/fastcwd.pl

   1 # By John Bazik
   2 #
   3 # This library is no longer being maintained, and is included for backward
   4 # compatibility with Perl 4 programs which may require it.
   5 # This legacy library is deprecated and will be removed in a future
   6 # release of perl.
   7 #
   8 # In particular, this should not be used as an example of modern Perl
   9 # programming techniques.
  10 #
  11 # Suggested alternative: Cwd
  12
  13 # Usage: $cwd = &fastcwd;
  14 #
  15 # This is a faster version of getcwd.  It's also more dangerous because
  16 # you might chdir out of a directory that you can't chdir back into.
  17
  18 sub fastcwd {
  19         local($odev, $oino, $cdev, $cino, $tdev, $tino);
  20         local(@path, $path);
  21         local(*DIR);
  22
  23         ($cdev, $cino) = stat('.');
  24         for (;;) {
  25                 ($odev, $oino) = ($cdev, $cino);
  26                 chdir('..');
  27                 ($cdev, $cino) = stat('.');
  28                 last if $odev == $cdev && $oino == $cino;
  29                 opendir(DIR, '.');
  30                 for (;;) {
  31                         $_ = readdir(DIR);
  32                         next if $_ eq '.';
  33                         next if $_ eq '..';
  34
  35                         last unless $_;
  36                         ($tdev, $tino) = lstat($_);
  37                         last unless $tdev != $odev || $tino != $oino;
  38                 }
  39                 closedir(DIR);
  40                 unshift(@path, $_);
  41         }
  42         chdir($path = '/' . join('/', @path));
  43         $path;
  44 }
  45 1;