lib/pwd.pl

   1 ;# pwd.pl - keeps track of current working directory in PWD environment var
   2 ;#
   3 ;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $
   4 ;#
   5 ;# $Log:        pwd.pl,v $
   6 ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
   7 ;# patch19: Initial revision
   8 ;#
   9 ;#
  10 ;# Usage:
  11 ;#      require "pwd.pl";
  12 ;#      &initpwd;
  13 ;#      ...
  14 ;#      &chdir($newdir);
  15
  16 package pwd;
  17
  18 sub main'initpwd {
  19     if ($ENV{'PWD'}) {
  20         local($dd,$di) = stat('.');
  21         local($pd,$pi) = stat($ENV{'PWD'});
  22         return if $di == $pi && $dd == $pd;
  23     }
  24     chop($ENV{'PWD'} = `pwd`);
  25 }
  26
  27 sub main'chdir {
  28     local($newdir) = shift;
  29     if (chdir $newdir) {
  30         if ($newdir =~ m#^/#) {
  31             $ENV{'PWD'} = $newdir;
  32         }
  33         else {
  34             local(@curdir) = split(m#/#,$ENV{'PWD'});
  35             @curdir = '' unless @curdir;
  36             foreach $component (split(m#/#, $newdir)) {
  37                 next if $component eq '.';
  38                 pop(@curdir),next if $component eq '..';
  39                 push(@curdir,$component);
  40             }
  41             $ENV{'PWD'} = join('/',@curdir) || '/';
  42         }
  43     }
  44     else {
  45         0;
  46     }
  47 }
  48