[Summary view] [Print] [Text view]

   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;