Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # By Brandon S. Allbery |
2 | # | |
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 | # | |
12 | # Usage: $cwd = &getcwd; | |
13 | ||
14 | sub 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 | { | |
48 | unless (defined ($dir = readdir(getcwd'PARENT))) #')) | |
49 | { | |
50 | warn "readdir($dotdots): $!"; | |
51 | closedir(getcwd'PARENT); #'); | |
52 | return ''; | |
53 | } | |
54 | unless (@tst = lstat("$dotdots/$dir")) | |
55 | { | |
56 | # warn "lstat($dotdots/$dir): $!"; | |
57 | # closedir(getcwd'PARENT); #'); | |
58 | # return ''; | |
59 | } | |
60 | } | |
61 | while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] || | |
62 | $tst[$[ + 1] != $pst[$[ + 1]); | |
63 | } | |
64 | $cwd = "$dir/$cwd"; | |
65 | closedir(getcwd'PARENT); #'); | |
66 | } while ($dir ne ''); | |
67 | chop($cwd); | |
68 | $cwd; | |
69 | } | |
70 | ||
71 | 1; |