diff options
author | Larry Wall <lwall@netlabs.com> | 1991-11-05 09:55:53 +0000 |
---|---|---|
committer | Larry Wall <lwall@netlabs.com> | 1991-11-05 09:55:53 +0000 |
commit | 55204971972392ce5a252fbbd6d78b1c48ed70e3 (patch) | |
tree | a0fc0fa7a40dae3b455667572b9aac94b020c246 /lib/getcwd.pl | |
parent | de3bb51191e884300caf98892ecfcc0ca3ebc09c (diff) | |
download | perl-55204971972392ce5a252fbbd6d78b1c48ed70e3.tar.gz |
perl 4.0 patch 18: patch #11, continued
See patch #11.
Diffstat (limited to 'lib/getcwd.pl')
-rw-r--r-- | lib/getcwd.pl | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/lib/getcwd.pl b/lib/getcwd.pl new file mode 100644 index 0000000000..114e8905c6 --- /dev/null +++ b/lib/getcwd.pl @@ -0,0 +1,62 @@ +# By Brandon S. Allbery +# +# Usage: $cwd = &getcwd; + +sub getcwd +{ + local($dotdots, $cwd, @pst, @cst, $dir, @tst); + + unless (@cst = stat('.')) + { + warn "stat(.): $!"; + return ''; + } + $cwd = ''; + do + { + $dotdots .= '/' if $dotdots; + $dotdots .= '..'; + @pst = @cst; + unless (opendir(getcwd'PARENT, $dotdots)) #')) + { + warn "opendir($dotdots): $!"; + return ''; + } + unless (@cst = stat($dotdots)) + { + warn "stat($dotdots): $!"; + closedir(getcwd'PARENT); #'); + return ''; + } + if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1]) + { + $dir = ''; + } + else + { + do + { + unless ($dir = readdir(getcwd'PARENT)) #')) + { + warn "readdir($dotdots): $!"; + closedir(getcwd'PARENT); #'); + return ''; + } + unless (@tst = stat("$dotdots/$dir")) + { + warn "stat($dotdots/$dir): $!"; + closedir(getcwd'PARENT); #'); + return ''; + } + } + while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] || + $tst[$[ + 1] != $pst[$[ + 1]); + } + $cwd = "$dir/$cwd"; + closedir(getcwd'PARENT); #'); + } while ($dir); + chop($cwd); + $cwd; +} + +1; |