diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/pwd.pl | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/pwd.pl')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/pwd.pl | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/pwd.pl b/Master/tlpkg/tlperl/lib/pwd.pl new file mode 100755 index 00000000000..6b429eb5a68 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/pwd.pl @@ -0,0 +1,67 @@ +;# pwd.pl - keeps track of current working directory in PWD environment var +;# +# +# 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 +# +;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $ +;# +;# $Log: pwd.pl,v $ +;# +;# Usage: +;# require "pwd.pl"; +;# &initpwd; +;# ... +;# &chdir($newdir); + +package pwd; + +sub main'initpwd { + if ($ENV{'PWD'}) { + local($dd,$di) = stat('.'); + local($pd,$pi) = stat($ENV{'PWD'}); + if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { + chop($ENV{'PWD'} = `pwd`); + } + } + else { + chop($ENV{'PWD'} = `pwd`); + } + if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) { + local($pd,$pi) = stat($2); + local($dd,$di) = stat($1); + if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { + $ENV{'PWD'}="$2$3"; + } + } +} + +sub main'chdir { + local($newdir) = shift; + $newdir =~ s|/{2,}|/|g; + if (chdir $newdir) { + if ($newdir =~ m#^/#) { + $ENV{'PWD'} = $newdir; + } + else { + local(@curdir) = split(m#/#,$ENV{'PWD'}); + @curdir = '' unless @curdir; + foreach $component (split(m#/#, $newdir)) { + next if $component eq '.'; + pop(@curdir),next if $component eq '..'; + push(@curdir,$component); + } + $ENV{'PWD'} = join('/',@curdir) || '/'; + } + } + else { + 0; + } +} + +1; |