This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
untodo the no-longer-failing todo test for rgs' patch
[perl5.git] / lib / fastcwd.pl
CommitLineData
99b89507
LW
1# By John Bazik
2#
a6d71656
GS
3# This library is no longer being maintained, and is included for backward
4# compatibility with Perl 4 programs which may require it.
2f8d2bfa
S
5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656
GS
7#
8# In particular, this should not be used as an example of modern Perl
9# programming techniques.
10#
11# Suggested alternative: Cwd
2f8d2bfa
S
12
13warn( "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
99b89507
LW
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
22sub 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}
491;