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 warn( "The 'fastcwd.pl' legacy library is deprecated and will be"
  14       . " removed in the next major release of perl. Please use the"
  15       . " Cwd module instead." );
  16
  17 # Usage: $cwd = &fastcwd;
  18 #
  19 # This is a faster version of getcwd.  It's also more dangerous because
  20 # you might chdir out of a directory that you can't chdir back into.
  21
  22 sub fastcwd {
  23         local($odev, $oino, $cdev, $cino, $tdev, $tino);
  24         local(@path, $path);
  25         local(*DIR);
  26
  27         ($cdev, $cino) = stat('.');
  28         for (;;) {
  29                 ($odev, $oino) = ($cdev, $cino);
  30                 chdir('..');
  31                 ($cdev, $cino) = stat('.');
  32                 last if $odev == $cdev && $oino == $cino;
  33                 opendir(DIR, '.');
  34                 for (;;) {
  35                         $_ = readdir(DIR);
  36                         next if $_ eq '.';
  37                         next if $_ eq '..';
  38
  39                         last unless $_;
  40                         ($tdev, $tino) = lstat($_);
  41                         last unless $tdev != $odev || $tino != $oino;
  42                 }
  43                 closedir(DIR);
  44                 unshift(@path, $_);
  45         }
  46         chdir($path = '/' . join('/', @path));
  47         $path;
  48 }
  49 1;