1;# pwd.pl - keeps track of current working directory in PWD environment var 2;# 3# 4# This library is no longer being maintained, and is included for backward 5# compatibility with Perl 4 programs which may require it. 6# 7# In particular, this should not be used as an example of modern Perl 8# programming techniques. 9# 10# Suggested alternative: Cwd 11# 12;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $ 13;# 14;# $Log: pwd.pl,v $ 15;# 16;# Usage: 17;# require "pwd.pl"; 18;# &initpwd; 19;# ... 20;# &chdir($newdir); 21 22package pwd; 23 24sub main'initpwd { 25 if ($ENV{'PWD'}) { 26 local($dd,$di) = stat('.'); 27 local($pd,$pi) = stat($ENV{'PWD'}); 28 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { 29 chop($ENV{'PWD'} = `pwd`); 30 } 31 } 32 else { 33 chop($ENV{'PWD'} = `pwd`); 34 } 35 if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) { 36 local($pd,$pi) = stat($2); 37 local($dd,$di) = stat($1); 38 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { 39 $ENV{'PWD'}="$2$3"; 40 } 41 } 42} 43 44sub main'chdir { 45 local($newdir) = shift; 46 $newdir =~ s|/{2,}|/|g; 47 if (chdir $newdir) { 48 if ($newdir =~ m#^/#) { 49 $ENV{'PWD'} = $newdir; 50 } 51 else { 52 local(@curdir) = split(m#/#,$ENV{'PWD'}); 53 @curdir = '' unless @curdir; 54 foreach $component (split(m#/#, $newdir)) { 55 next if $component eq '.'; 56 pop(@curdir),next if $component eq '..'; 57 push(@curdir,$component); 58 } 59 $ENV{'PWD'} = join('/',@curdir) || '/'; 60 } 61 } 62 else { 63 0; 64 } 65} 66 671; 68