home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / lib / pwd.pl < prev    next >
Perl Script  |  1993-02-08  |  1KB  |  70 lines
  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $RCSfile: pwd.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:45:22 $
  4. ;#
  5. ;# $Log:    pwd.pl,v $
  6. ;# Revision 4.0.1.1  92/06/08  13:45:22  lwall
  7. ;# patch20: support added to pwd.pl to strip automounter crud
  8. ;# 
  9. ;# Revision 4.0  91/03/20  01:26:03  lwall
  10. ;# 4.0 baseline.
  11. ;# 
  12. ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  13. ;# patch42: some .pl files were missing their trailing 1;
  14. ;# 
  15. ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  16. ;# patch19: Initial revision
  17. ;# 
  18. ;#
  19. ;# Usage:
  20. ;#    require "pwd.pl";
  21. ;#    &initpwd;
  22. ;#    ...
  23. ;#    &chdir($newdir);
  24.  
  25. package pwd;
  26.  
  27. sub main'initpwd {
  28.     if ($ENV{'PWD'}) {
  29.     local($dd,$di) = stat('.');
  30.     local($pd,$pi) = stat($ENV{'PWD'});
  31.     if ($di != $pi || $dd != $pd) {
  32.         chop($ENV{'PWD'} = `pwd`);
  33.     }
  34.     }
  35.     else {
  36.     chop($ENV{'PWD'} = `pwd`);
  37.     }
  38.     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  39.     local($pd,$pi) = stat($2);
  40.     local($dd,$di) = stat($1);
  41.     if ($di == $pi && $dd == $pd) {
  42.         $ENV{'PWD'}="$2$3";
  43.     }
  44.     }
  45. }
  46.  
  47. sub main'chdir {
  48.     local($newdir) = shift;
  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;
  70.