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