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