extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.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 #
7 # In particular, this should not be used as an example of modern Perl
8 # programming techniques.
9 #
10 # Suggested alternative: Cwd
11 #
12 ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
13 ;#
14 ;# $Log:        pwd.pl,v $
15 ;#
16 ;# Usage:
17 ;#      require "pwd.pl";
18 ;#      &initpwd;
19 ;#      ...
20 ;#      &chdir($newdir);
21
22 package pwd;
23
24 sub main'initpwd {
25     if ($ENV{'PWD'}) {
26         local($dd,$di) = stat('.');
27         local($pd,$pi) = stat($ENV{'PWD'});
28         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
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);
38         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
39             $ENV{'PWD'}="$2$3";
40         }
41     }
42 }
43
44 sub main'chdir {
45     local($newdir) = shift;
46     $newdir =~ s|/{2,}|/|g;
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
67 1;