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 14sub 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[0] == $cst[0] && $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[0] != $pst[0] || 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 711; 72