Upgrade to Pod-Simple-3.08
[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 # 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;