lib/pwd.pl

   1 ;# pwd.pl - keeps track of current working directory in PWD environment var
   2 ;#
   3 ;# $Header: pwd.pl,v 4.0 91/03/20 01:26:03 lwall Locked $
   4 ;#
   5 ;# $Log:        pwd.pl,v $
   6 ;# Revision 4.0  91/03/20  01:26:03  lwall
   7 ;# 4.0 baseline.
   8 ;#
   9 ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  10 ;# patch42: some .pl files were missing their trailing 1;
  11 ;#
  12 ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  13 ;# patch19: Initial revision
  14 ;#
  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         return if $di == $pi && $dd == $pd;
  29     }
  30     chop($ENV{'PWD'} = `pwd`);
  31 }
  32
  33 sub main'chdir {
  34     local($newdir) = shift;
  35     if (chdir $newdir) {
  36         if ($newdir =~ m#^/#) {
  37             $ENV{'PWD'} = $newdir;
  38         }
  39         else {
  40             local(@curdir) = split(m#/#,$ENV{'PWD'});
  41             @curdir = '' unless @curdir;
  42             foreach $component (split(m#/#, $newdir)) {
  43                 next if $component eq '.';
  44                 pop(@curdir),next if $component eq '..';
  45                 push(@curdir,$component);
  46             }
  47             $ENV{'PWD'} = join('/',@curdir) || '/';
  48         }
  49     }
  50     else {
  51         0;
  52     }
  53 }
  54
  55 1;