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";
3 # By Brandon S. Allbery
5 # This library is no longer being maintained, and is included for backward
6 # compatibility with Perl 4 programs which may require it.
7 # This legacy library is deprecated and will be removed in a future
9 # In particular, this should not be used as an example of modern Perl
10 # programming techniques.
12 # Suggested alternative: Cwd
15 # Usage: $cwd = &getcwd;
19 local($dotdots, $cwd, @pst, @cst, $dir, @tst);
21 unless (@cst = stat('.'))
29 $dotdots .= '/' if $dotdots;
32 unless (opendir(getcwd'PARENT, $dotdots)) #'))
34 warn "opendir($dotdots): $!";
37 unless (@cst = stat($dotdots))
39 warn "stat($dotdots): $!";
40 closedir(getcwd'PARENT); #');
43 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
51 unless (defined ($dir = readdir(getcwd'PARENT))) #'))
53 warn "readdir($dotdots): $!";
54 closedir(getcwd'PARENT); #');
57 unless (@tst = lstat("$dotdots/$dir"))
59 # warn "lstat($dotdots/$dir): $!";
60 # closedir(getcwd'PARENT); #');
64 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
68 closedir(getcwd'PARENT); #');