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;
|
---|