home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / PERL30X.ZIP / PWD.PL < prev    next >
Perl Script  |  1991-01-14  |  1KB  |  49 lines
  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.  
  49.