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 ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
  15 ;#
  16 ;# $Log:        pwd.pl,v $
  17 ;#
  18 ;# Usage:
  19 ;#      require "pwd.pl";
  20 ;#      &initpwd;
  21 ;#      ...
  22 ;#      &chdir($newdir);
  23
  24 package pwd;
  25
  26 sub main'initpwd {
  27     if ($ENV{'PWD'}) {
  28         local($dd,$di) = stat('.');
  29         local($pd,$pi) = stat($ENV{'PWD'});
  30         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
  31             chop($ENV{'PWD'} = `pwd`);
  32         }
  33     }
  34     else {
  35         chop($ENV{'PWD'} = `pwd`);
  36     }
  37     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  38         local($pd,$pi) = stat($2);
  39         local($dd,$di) = stat($1);
  40         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
  41             $ENV{'PWD'}="$2$3";
  42         }
  43     }
  44 }
  45
  46 sub main'chdir {
  47     local($newdir) = shift;
  48     $newdir =~ s|/{2,}|/|g;
  49     if (chdir $newdir) {
  50         if ($newdir =~ m#^/#) {
  51             $ENV{'PWD'} = $newdir;
  52         }
  53         else {
  54             local(@curdir) = split(m#/#,$ENV{'PWD'});
  55             @curdir = '' unless @curdir;
  56             foreach $component (split(m#/#, $newdir)) {
  57                 next if $component eq '.';
  58                 pop(@curdir),next if $component eq '..';
  59                 push(@curdir,$component);
  60             }
  61             $ENV{'PWD'} = join('/',@curdir) || '/';
  62         }
  63     }
  64     else {
  65         0;
  66     }
  67 }
  68
  69 1;