Rename tied_handle_method() to tied_method(), and make it non-static.
[perl.git] / lib / pwd.pl
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";
2
3 ;# pwd.pl - keeps track of current working directory in PWD environment var
4 ;#
5 #
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
9 # release of perl.
10 #
11 # In particular, this should not be used as an example of modern Perl
12 # programming techniques.
13 #
14 # Suggested alternative: Cwd
15
16 ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
17 ;#
18 ;# $Log:        pwd.pl,v $
19 ;#
20 ;# Usage:
21 ;#      require "pwd.pl";
22 ;#      &initpwd;
23 ;#      ...
24 ;#      &chdir($newdir);
25
26 package pwd;
27
28 sub main'initpwd {
29     if ($ENV{'PWD'}) {
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`);
34         }
35     }
36     else {
37         chop($ENV{'PWD'} = `pwd`);
38     }
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) {
43             $ENV{'PWD'}="$2$3";
44         }
45     }
46 }
47
48 sub main'chdir {
49     local($newdir) = shift;
50     $newdir =~ s|/{2,}|/|g;
51     if (chdir $newdir) {
52         if ($newdir =~ m#^/#) {
53             $ENV{'PWD'} = $newdir;
54         }
55         else {
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);
62             }
63             $ENV{'PWD'} = join('/',@curdir) || '/';
64         }
65     }
66     else {
67         0;
68     }
69 }
70
71 1;