Commit | Line | Data |
55204971 |
1 | # By Brandon S. Allbery |
2 | # |
a6d71656 |
3 | # This library is no longer being maintained, and is included for backward |
4 | # compatibility with Perl 4 programs which may require it. |
6e373246 |
5 | # This legacy library is deprecated and will be removed in a future |
6 | # release of perl. |
a6d71656 |
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 |
13 | # Usage: $cwd = &getcwd; |
14 | |
15 | sub 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 | } |
41 | if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1]) |
42 | { |
43 | $dir = ''; |
44 | } |
45 | else |
46 | { |
47 | do |
48 | { |
c2960299 |
49 | unless (defined ($dir = readdir(getcwd'PARENT))) #')) |
55204971 |
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 |
60 | } |
61 | } |
62 | while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] || |
63 | $tst[$[ + 1] != $pst[$[ + 1]); |
64 | } |
65 | $cwd = "$dir/$cwd"; |
66 | closedir(getcwd'PARENT); #'); |
1f997daf |
67 | } while ($dir ne ''); |
55204971 |
68 | chop($cwd); |
69 | $cwd; |
70 | } |
71 | |
72 | 1; |