Server : Apache System : Linux indy02.toastserver.com 3.10.0-962.3.2.lve1.5.85.el7.x86_64 #1 SMP Thu Apr 18 15:18:36 UTC 2024 x86_64 User : palandch ( 1163) PHP Version : 7.1.33 Disable Function : NONE Directory : /usr/share/perl5/vendor_perl/ |
# By Brandon S. Allbery # # This library is no longer being maintained, and is included for backward # compatibility with Perl 4 programs which may require it. # # In particular, this should not be used as an example of modern Perl # programming techniques. # # Suggested alternative: Cwd # # # 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[0] == $cst[0] && $pst[1] == $cst[1]) { $dir = ''; } else { do { unless (defined ($dir = readdir(getcwd'PARENT))) #')) { warn "readdir($dotdots): $!"; closedir(getcwd'PARENT); #'); return ''; } unless (@tst = lstat("$dotdots/$dir")) { # warn "lstat($dotdots/$dir): $!"; # closedir(getcwd'PARENT); #'); # return ''; } } while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || $tst[1] != $pst[1]); } $cwd = "$dir/$cwd"; closedir(getcwd'PARENT); #'); } while ($dir ne ''); chop($cwd); $cwd; } 1;