Win32 pacifying from mjd.
[perl.git] / 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;