This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pp_reverse fetch the lexical $_ from the correct pad
[perl5.git] / lib / getcwd.pl
CommitLineData
55204971
LW
1# By Brandon S. Allbery
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.
6e373246
S
5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656
GS
7# In particular, this should not be used as an example of modern Perl
8# programming techniques.
9#
10# Suggested alternative: Cwd
6e373246 11
a6d71656 12#
55204971
LW
13# Usage: $cwd = &getcwd;
14
15sub getcwd
16{
17 local($dotdots, $cwd, @pst, @cst, $dir, @tst);
18
19 unless (@cst = stat('.'))
20 {
21 warn "stat(.): $!";
22 return '';
23 }
24 $cwd = '';
25 do
26 {
27 $dotdots .= '/' if $dotdots;
28 $dotdots .= '..';
29 @pst = @cst;
30 unless (opendir(getcwd'PARENT, $dotdots)) #'))
31 {
32 warn "opendir($dotdots): $!";
33 return '';
34 }
35 unless (@cst = stat($dotdots))
36 {
37 warn "stat($dotdots): $!";
38 closedir(getcwd'PARENT); #');
39 return '';
40 }
859172fe 41 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
55204971
LW
42 {
43 $dir = '';
44 }
45 else
46 {
47 do
48 {
c2960299 49 unless (defined ($dir = readdir(getcwd'PARENT))) #'))
55204971
LW
50 {
51 warn "readdir($dotdots): $!";
52 closedir(getcwd'PARENT); #');
53 return '';
54 }
e334a159 55 unless (@tst = lstat("$dotdots/$dir"))
55204971 56 {
55497cff 57 # warn "lstat($dotdots/$dir): $!";
58 # closedir(getcwd'PARENT); #');
59 # return '';
55204971
LW
60 }
61 }
859172fe
Z
62 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
63 $tst[1] != $pst[1]);
55204971
LW
64 }
65 $cwd = "$dir/$cwd";
66 closedir(getcwd'PARENT); #');
1f997daf 67 } while ($dir ne '');
55204971
LW
68 chop($cwd);
69 $cwd;
70}
71
721;