This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove stale code from Thread.xs.
[perl5.git] / lib / getcwd.pl
CommitLineData
55204971
LW
1# By Brandon S. Allbery
2#
3# Usage: $cwd = &getcwd;
4
5sub getcwd
6{
7 local($dotdots, $cwd, @pst, @cst, $dir, @tst);
8
9 unless (@cst = stat('.'))
10 {
11 warn "stat(.): $!";
12 return '';
13 }
14 $cwd = '';
15 do
16 {
17 $dotdots .= '/' if $dotdots;
18 $dotdots .= '..';
19 @pst = @cst;
20 unless (opendir(getcwd'PARENT, $dotdots)) #'))
21 {
22 warn "opendir($dotdots): $!";
23 return '';
24 }
25 unless (@cst = stat($dotdots))
26 {
27 warn "stat($dotdots): $!";
28 closedir(getcwd'PARENT); #');
29 return '';
30 }
31 if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
32 {
33 $dir = '';
34 }
35 else
36 {
37 do
38 {
c2960299 39 unless (defined ($dir = readdir(getcwd'PARENT))) #'))
55204971
LW
40 {
41 warn "readdir($dotdots): $!";
42 closedir(getcwd'PARENT); #');
43 return '';
44 }
e334a159 45 unless (@tst = lstat("$dotdots/$dir"))
55204971 46 {
55497cff 47 # warn "lstat($dotdots/$dir): $!";
48 # closedir(getcwd'PARENT); #');
49 # return '';
55204971
LW
50 }
51 }
52 while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
53 $tst[$[ + 1] != $pst[$[ + 1]);
54 }
55 $cwd = "$dir/$cwd";
56 closedir(getcwd'PARENT); #');
1f997daf 57 } while ($dir ne '');
55204971
LW
58 chop($cwd);
59 $cwd;
60}
61
621;