I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / pwd.pl
CommitLineData
00bf170e 1;# pwd.pl - keeps track of current working directory in PWD environment var
2;#
a6d71656 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#
79072805 12;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
00bf170e 13;#
14;# $Log: pwd.pl,v $
00bf170e 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'});
d5c3ff09 28 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
32c2e4fb 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);
d5c3ff09 38 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
32c2e4fb 39 $ENV{'PWD'}="$2$3";
40 }
00bf170e 41 }
00bf170e 42}
43
44sub main'chdir {
45 local($newdir) = shift;
748a9306 46 $newdir =~ s|/{2,}|/|g;
00bf170e 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
27e2fb84 671;