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 #
   6 # In particular, this should not be used as an example of modern Perl
   7 # programming techniques.
   8 #
   9 # Suggested alternative: Cwd
  10 #
  11 # Usage: $cwd = &fastcwd;
  12 #
  13 # This is a faster version of getcwd.  It's also more dangerous because
  14 # you might chdir out of a directory that you can't chdir back into.
  15
  16 sub fastcwd {
  17         local($odev, $oino, $cdev, $cino, $tdev, $tino);
  18         local(@path, $path);
  19         local(*DIR);
  20
  21         ($cdev, $cino) = stat('.');
  22         for (;;) {
  23                 ($odev, $oino) = ($cdev, $cino);
  24                 chdir('..');
  25                 ($cdev, $cino) = stat('.');
  26                 last if $odev == $cdev && $oino == $cino;
  27                 opendir(DIR, '.');
  28                 for (;;) {
  29                         $_ = readdir(DIR);
  30                         next if $_ eq '.';
  31                         next if $_ eq '..';
  32
  33                         last unless $_;
  34                         ($tdev, $tino) = lstat($_);
  35                         last unless $tdev != $odev || $tino != $oino;
  36                 }
  37                 closedir(DIR);
  38                 unshift(@path, $_);
  39         }
  40         chdir($path = '/' . join('/', @path));
  41         $path;
  42 }
  43 1;