summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/getcwd.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/getcwd.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/getcwd.pl72
1 files changed, 72 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/getcwd.pl b/Master/tlpkg/tlperl/lib/getcwd.pl
new file mode 100644
index 00000000000..fcca2ced80d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/getcwd.pl
@@ -0,0 +1,72 @@
+# 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.
+# This legacy library is deprecated and will be removed in a future
+# release of perl.
+# 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[$[] == $cst[$[] && $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[$[] != $pst[$[] ||
+ $tst[$[ + 1] != $pst[$[ + 1]);
+ }
+ $cwd = "$dir/$cwd";
+ closedir(getcwd'PARENT); #');
+ } while ($dir ne '');
+ chop($cwd);
+ $cwd;
+}
+
+1;