1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
3 ;# pwd.pl - keeps track of current working directory in PWD environment var
6 # This library is no longer being maintained, and is included for backward
7 # compatibility with Perl 4 programs which may require it.
8 # This legacy library is deprecated and will be removed in a future
11 # In particular, this should not be used as an example of modern Perl
12 # programming techniques.
14 # Suggested alternative: Cwd
16 ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
30 local($dd,$di) = stat('.');
31 local($pd,$pi) = stat($ENV{'PWD'});
32 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
33 chop($ENV{'PWD'} = `pwd`);
37 chop($ENV{'PWD'} = `pwd`);
39 if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
40 local($pd,$pi) = stat($2);
41 local($dd,$di) = stat($1);
42 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
49 local($newdir) = shift;
50 $newdir =~ s|/{2,}|/|g;
52 if ($newdir =~ m#^/#) {
53 $ENV{'PWD'} = $newdir;
56 local(@curdir) = split(m#/#,$ENV{'PWD'});
57 @curdir = '' unless @curdir;
58 foreach $component (split(m#/#, $newdir)) {
59 next if $component eq '.';
60 pop(@curdir),next if $component eq '..';
61 push(@curdir,$component);
63 $ENV{'PWD'} = join('/',@curdir) || '/';