home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / pwd.pl < prev    next >
Text File  |  1997-05-18  |  1KB  |  75 lines
  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $RCSfile: pwd.pl,v $$Revision: 1.2 $$Date: 1997/04/07 20:52:01 $
  4. ;#
  5. ;# $Log: pwd.pl,v $
  6. ;# Revision 1.2  1997/04/07 20:52:01  neeri
  7. ;# Synchronized with MacPerl 5.1.4a1
  8. ;#
  9. ;# Revision 1.1.1.1  1997/04/06 21:06:29  neeri
  10. ;# Import of Perl 5.002
  11. ;#
  12. ;#
  13. ;# Usage:
  14. ;#    require "pwd.pl";
  15. ;#    &initpwd;
  16. ;#    ...
  17. ;#    &chdir($newdir);
  18.  
  19. package pwd;
  20.  
  21. sub main'initpwd {
  22.     if ($^O eq 'MacOS') {
  23.     chop($ENV{'PWD'} = `pwd`);
  24.     return;
  25.     } 
  26.     if ($ENV{'PWD'}) {
  27.     local($dd,$di) = stat('.');
  28.     local($pd,$pi) = stat($ENV{'PWD'});
  29.     if ($di != $pi || $dd != $pd) {
  30.         chop($ENV{'PWD'} = `pwd`);
  31.     }
  32.     }
  33.     else {
  34.     chop($ENV{'PWD'} = `pwd`);
  35.     }
  36.     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  37.     local($pd,$pi) = stat($2);
  38.     local($dd,$di) = stat($1);
  39.     if ($di == $pi && $dd == $pd) {
  40.         $ENV{'PWD'}="$2$3";
  41.     }
  42.     }
  43. }
  44.  
  45. sub main'chdir {
  46.     local($newdir) = shift;
  47.     if ($^O eq 'MacOS') {
  48.         if (chdir $newdir) {
  49.         chop($ENV{'PWD'} = `pwd`);
  50.     }
  51.     return;
  52.     } 
  53.     $newdir =~ s|/{2,}|/|g;
  54.     if (chdir $newdir) {
  55.     if ($newdir =~ m#^/#) {
  56.         $ENV{'PWD'} = $newdir;
  57.     }
  58.     else {
  59.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  60.         @curdir = '' unless @curdir;
  61.         foreach $component (split(m#/#, $newdir)) {
  62.         next if $component eq '.';
  63.         pop(@curdir),next if $component eq '..';
  64.         push(@curdir,$component);
  65.         }
  66.         $ENV{'PWD'} = join('/',@curdir) || '/';
  67.     }
  68.     }
  69.     else {
  70.     0;
  71.     }
  72. }
  73.  
  74. 1;
  75.