File Coverage

blib/lib/fastcwd.pl
Criterion Covered Total %
statement 0 21 0.0
branch 0 10 0.0
condition 0 6 0.0
subroutine 0 1 0.0
pod n/a
total 0 38 0.0


line stmt bran cond sub pod time code
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 0     0     local($odev, $oino, $cdev, $cino, $tdev, $tino);
18 0           local(@path, $path);
19 0           local(*DIR);
20              
21 0           ($cdev, $cino) = stat('.');
22 0           for (;;) {
23 0           ($odev, $oino) = ($cdev, $cino);
24 0           chdir('..');
25 0           ($cdev, $cino) = stat('.');
26 0 0 0       last if $odev == $cdev && $oino == $cino;
27 0           opendir(DIR, '.');
28 0           for (;;) {
29 0           $_ = readdir(DIR);
30 0 0         next if $_ eq '.';
31 0 0         next if $_ eq '..';
32              
33 0 0         last unless $_;
34 0           ($tdev, $tino) = lstat($_);
35 0 0 0       last unless $tdev != $odev || $tino != $oino;
36             }
37 0           closedir(DIR);
38 0           unshift(@path, $_);
39             }
40 0           chdir($path = '/' . join('/', @path));
41 0           $path;
42             }
43             1;