home *** CD-ROM | disk | FTP | other *** search
/ Freelog 15 / FREELOG 15.ISO / WebMaster / Perl / PERL5106.ZIP / perl5 / Lib / pwd.pl < prev    next >
Encoding:
Perl Script  |  1995-12-02  |  1.2 KB  |  61 lines
  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
  4. ;#
  5. ;# $Log:    pwd.pl,v $
  6. ;#
  7. ;# Usage:
  8. ;#    require "pwd.pl";
  9. ;#    &initpwd;
  10. ;#    ...
  11. ;#    &chdir($newdir);
  12.  
  13. use Cwd;
  14.  
  15. package pwd;
  16.  
  17. sub main'initpwd {
  18.     if ($ENV{'PWD'}) {
  19.     local($dd,$di) = stat('.');
  20.     local($pd,$pi) = stat($ENV{'PWD'});
  21.     if ($di != $pi || $dd != $pd) {
  22.         chop($ENV{'PWD'} = cwd);
  23.     }
  24.     }
  25.     else {
  26.     chop($ENV{'PWD'} = `pwd`);
  27.     }
  28.     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  29.     local($pd,$pi) = stat($2);
  30.     local($dd,$di) = stat($1);
  31.     if ($di == $pi && $dd == $pd) {
  32.         $ENV{'PWD'}="$2$3";
  33.     }
  34.     }
  35. }
  36.  
  37. sub main'chdir {
  38.     local($newdir) = shift;
  39.     $newdir =~ s|/{2,}|/|g;
  40.     if (chdir $newdir) {
  41.     if ($newdir =~ m#^/#) {
  42.         $ENV{'PWD'} = $newdir;
  43.     }
  44.     else {
  45.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  46.         @curdir = '' unless @curdir;
  47.         foreach $component (split(m#/#, $newdir)) {
  48.         next if $component eq '.';
  49.         pop(@curdir),next if $component eq '..';
  50.         push(@curdir,$component);
  51.         }
  52.         $ENV{'PWD'} = join('/',@curdir) || '/';
  53.     }
  54.     }
  55.     else {
  56.     0;
  57.     }
  58. }
  59.  
  60. 1;
  61.