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;