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