home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / lib / pwd.pl < prev    next >
Encoding:
Perl Script  |  1995-05-19  |  1.7 KB  |  76 lines

  1. # -*- Perl -*-
  2.  
  3. eval "exec /usr/local/bin/perl -S $0 $*"
  4.  
  5.     if $running_under_some_shell;
  6.  
  7. ;# pwd.pl - keeps track of current working directory in PWD environment var
  8. ;#
  9. ;# $RCSfile: pwd.pl,v $$Revision: 1.1 $$Date: 1993/04/22 15:49:15 $
  10. ;#
  11. ;# $Log: pwd.pl,v $
  12. % Revision 1.1  1993/04/22  15:49:15  isdk
  13. % Initial load of perl source for NT port
  14. %
  15. ;# Revision 4.0.1.1  92/06/08  13:45:22  lwall
  16. ;# patch20: support added to pwd.pl to strip automounter crud
  17. ;# 
  18. ;# Revision 4.0  91/03/20  01:26:03  lwall
  19. ;# 4.0 baseline.
  20. ;# 
  21. ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  22. ;# patch42: some .pl files were missing their trailing 1;
  23. ;# 
  24. ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  25. ;# patch19: Initial revision
  26. ;# 
  27. ;#
  28. ;# Usage:
  29. ;#    require "pwd.pl";
  30. ;#    &initpwd;
  31. ;#    ...
  32. ;#    &chdir($newdir);
  33.  
  34. package pwd;
  35.  
  36. sub main'initpwd {
  37.     if ($ENV{'PWD'}) {
  38.     local($dd,$di) = stat('.');
  39.     local($pd,$pi) = stat($ENV{'PWD'});
  40.     if ($di != $pi || $dd != $pd) {
  41.         chop($ENV{'PWD'} = `cd`);
  42.     }
  43.     }
  44.     else {
  45.     chop($ENV{'PWD'} = `cd`);
  46.     }
  47.     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  48.     local($pd,$pi) = stat($2);
  49.     local($dd,$di) = stat($1);
  50.     if ($di == $pi && $dd == $pd) {
  51.         $ENV{'PWD'}="$2$3";
  52.     }
  53.     }
  54. }
  55.  
  56. sub main'chdir {
  57.     local($newdir) = shift;
  58.     if (chdir $newdir) {
  59.     if ($newdir =~ m#^/#) {
  60.         $ENV{'PWD'} = $newdir;
  61.     }
  62.     else {
  63.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  64.         @curdir = '' unless @curdir;
  65.         foreach $component (split(m#/#, $newdir)) {
  66.         next if $component eq '.';
  67.         pop(@curdir),next if $component eq '..';
  68.         push(@curdir,$component);
  69.         }
  70.         $ENV{'PWD'} = join('/',@curdir) || '/';
  71.     }
  72.     }
  73.     else {
  74.     0;
  75.     }
  76. }
  77.  
  78. 1;
  79.