home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / fastcwd.pl < prev    next >
Text File  |  1997-11-25  |  754b  |  36 lines
  1. # By John Bazik
  2. #
  3. # Usage: $cwd = &fastcwd;
  4. #
  5. # This is a faster version of getcwd.  It's also more dangerous because
  6. # you might chdir out of a directory that you can't chdir back into.
  7.  
  8. sub fastcwd {
  9.     local($odev, $oino, $cdev, $cino, $tdev, $tino);
  10.     local(@path, $path);
  11.     local(*DIR);
  12.  
  13.     ($cdev, $cino) = stat('.');
  14.     for (;;) {
  15.         ($odev, $oino) = ($cdev, $cino);
  16.         chdir('..');
  17.         ($cdev, $cino) = stat('.');
  18.         last if $odev == $cdev && $oino == $cino;
  19.         opendir(DIR, '.');
  20.         for (;;) {
  21.             $_ = readdir(DIR);
  22.             next if $_ eq '.';
  23.             next if $_ eq '..';
  24.  
  25.             last unless $_;
  26.             ($tdev, $tino) = lstat($_);
  27.             last unless $tdev != $odev || $tino != $oino;
  28.         }
  29.         closedir(DIR);
  30.         unshift(@path, $_);
  31.     }
  32.     chdir($path = '/' . join('/', @path));
  33.     $path;
  34. }
  35. 1;
  36.