summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/fastcwd.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/fastcwd.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/fastcwd.pl45
1 files changed, 45 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/fastcwd.pl b/Master/tlpkg/tlperl/lib/fastcwd.pl
new file mode 100644
index 00000000000..34b60f71a08
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/fastcwd.pl
@@ -0,0 +1,45 @@
+# By John Bazik
+#
+# 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 = &fastcwd;
+#
+# This is a faster version of getcwd. It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+ local($odev, $oino, $cdev, $cino, $tdev, $tino);
+ local(@path, $path);
+ local(*DIR);
+
+ ($cdev, $cino) = stat('.');
+ for (;;) {
+ ($odev, $oino) = ($cdev, $cino);
+ chdir('..');
+ ($cdev, $cino) = stat('.');
+ last if $odev == $cdev && $oino == $cino;
+ opendir(DIR, '.');
+ for (;;) {
+ $_ = readdir(DIR);
+ next if $_ eq '.';
+ next if $_ eq '..';
+
+ last unless $_;
+ ($tdev, $tino) = lstat($_);
+ last unless $tdev != $odev || $tino != $oino;
+ }
+ closedir(DIR);
+ unshift(@path, $_);
+ }
+ chdir($path = '/' . join('/', @path));
+ $path;
+}
+1;