Commit | Line | Data |
---|---|---|
0111154e Z |
1 | warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n"; |
2 | ||
55204971 LW |
3 | # By Brandon S. Allbery |
4 | # | |
a6d71656 GS |
5 | # This library is no longer being maintained, and is included for backward |
6 | # compatibility with Perl 4 programs which may require it. | |
6e373246 S |
7 | # This legacy library is deprecated and will be removed in a future |
8 | # release of perl. | |
a6d71656 GS |
9 | # In particular, this should not be used as an example of modern Perl |
10 | # programming techniques. | |
11 | # | |
12 | # Suggested alternative: Cwd | |
6e373246 | 13 | |
a6d71656 | 14 | # |
55204971 LW |
15 | # Usage: $cwd = &getcwd; |
16 | ||
17 | sub getcwd | |
18 | { | |
19 | local($dotdots, $cwd, @pst, @cst, $dir, @tst); | |
20 | ||
21 | unless (@cst = stat('.')) | |
22 | { | |
23 | warn "stat(.): $!"; | |
24 | return ''; | |
25 | } | |
26 | $cwd = ''; | |
27 | do | |
28 | { | |
29 | $dotdots .= '/' if $dotdots; | |
30 | $dotdots .= '..'; | |
31 | @pst = @cst; | |
32 | unless (opendir(getcwd'PARENT, $dotdots)) #')) | |
33 | { | |
34 | warn "opendir($dotdots): $!"; | |
35 | return ''; | |
36 | } | |
37 | unless (@cst = stat($dotdots)) | |
38 | { | |
39 | warn "stat($dotdots): $!"; | |
40 | closedir(getcwd'PARENT); #'); | |
41 | return ''; | |
42 | } | |
859172fe | 43 | if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) |
55204971 LW |
44 | { |
45 | $dir = ''; | |
46 | } | |
47 | else | |
48 | { | |
49 | do | |
50 | { | |
c2960299 | 51 | unless (defined ($dir = readdir(getcwd'PARENT))) #')) |
55204971 LW |
52 | { |
53 | warn "readdir($dotdots): $!"; | |
54 | closedir(getcwd'PARENT); #'); | |
55 | return ''; | |
56 | } | |
e334a159 | 57 | unless (@tst = lstat("$dotdots/$dir")) |
55204971 | 58 | { |
55497cff | 59 | # warn "lstat($dotdots/$dir): $!"; |
60 | # closedir(getcwd'PARENT); #'); | |
61 | # return ''; | |
55204971 LW |
62 | } |
63 | } | |
859172fe Z |
64 | while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || |
65 | $tst[1] != $pst[1]); | |
55204971 LW |
66 | } |
67 | $cwd = "$dir/$cwd"; | |
68 | closedir(getcwd'PARENT); #'); | |
1f997daf | 69 | } while ($dir ne ''); |
55204971 LW |
70 | chop($cwd); |
71 | $cwd; | |
72 | } | |
73 | ||
74 | 1; |