This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
sv_2pv_flags and ROK and UTF8 flags
[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.
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#
55204971
LW
12# Usage: $cwd = &getcwd;
13
14sub getcwd
15{
16 local($dotdots, $cwd, @pst, @cst, $dir, @tst);
17
18 unless (@cst = stat('.'))
19 {
20 warn "stat(.): $!";
21 return '';
22 }
23 $cwd = '';
24 do
25 {
26 $dotdots .= '/' if $dotdots;
27 $dotdots .= '..';
28 @pst = @cst;
29 unless (opendir(getcwd'PARENT, $dotdots)) #'))
30 {
31 warn "opendir($dotdots): $!";
32 return '';
33 }
34 unless (@cst = stat($dotdots))
35 {
36 warn "stat($dotdots): $!";
37 closedir(getcwd'PARENT); #');
38 return '';
39 }
40 if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
41 {
42 $dir = '';
43 }
44 else
45 {
46 do
47 {
c2960299 48 unless (defined ($dir = readdir(getcwd'PARENT))) #'))
55204971
LW
49 {
50 warn "readdir($dotdots): $!";
51 closedir(getcwd'PARENT); #');
52 return '';
53 }
e334a159 54 unless (@tst = lstat("$dotdots/$dir"))
55204971 55 {
55497cff 56 # warn "lstat($dotdots/$dir): $!";
57 # closedir(getcwd'PARENT); #');
58 # return '';
55204971
LW
59 }
60 }
61 while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
62 $tst[$[ + 1] != $pst[$[ + 1]);
63 }
64 $cwd = "$dir/$cwd";
65 closedir(getcwd'PARENT); #');
1f997daf 66 } while ($dir ne '');
55204971
LW
67 chop($cwd);
68 $cwd;
69}
70
711;