Time::Local in blead has diverged from CPAN. Update the version number to a dev release
[perl.git] / lib / pwd.pl
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 # This legacy library is deprecated and will be removed in a future
7 # release of perl.
8 #
9 # In particular, this should not be used as an example of modern Perl
10 # programming techniques.
11 #
12 # Suggested alternative: Cwd
13
14 warn( "The 'pwd.pl' legacy library is deprecated and will be"
15       . " removed in the next major release of perl. Please use the"
16       . " Cwd module instead." );
17
18 ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
19 ;#
20 ;# $Log:        pwd.pl,v $
21 ;#
22 ;# Usage:
23 ;#      require "pwd.pl";
24 ;#      &initpwd;
25 ;#      ...
26 ;#      &chdir($newdir);
27
28 package pwd;
29
30 sub main'initpwd {
31     if ($ENV{'PWD'}) {
32         local($dd,$di) = stat('.');
33         local($pd,$pi) = stat($ENV{'PWD'});
34         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
35             chop($ENV{'PWD'} = `pwd`);
36         }
37     }
38     else {
39         chop($ENV{'PWD'} = `pwd`);
40     }
41     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
42         local($pd,$pi) = stat($2);
43         local($dd,$di) = stat($1);
44         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
45             $ENV{'PWD'}="$2$3";
46         }
47     }
48 }
49
50 sub main'chdir {
51     local($newdir) = shift;
52     $newdir =~ s|/{2,}|/|g;
53     if (chdir $newdir) {
54         if ($newdir =~ m#^/#) {
55             $ENV{'PWD'} = $newdir;
56         }
57         else {
58             local(@curdir) = split(m#/#,$ENV{'PWD'});
59             @curdir = '' unless @curdir;
60             foreach $component (split(m#/#, $newdir)) {
61                 next if $component eq '.';
62                 pop(@curdir),next if $component eq '..';
63                 push(@curdir,$component);
64             }
65             $ENV{'PWD'} = join('/',@curdir) || '/';
66         }
67     }
68     else {
69         0;
70     }
71 }
72
73 1;