home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / unixtool.zip / TOOLS / lib / perl / pwd.pl < prev    next >
Perl Script  |  2000-04-21  |  811b  |  43 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. ;# $Id: pwd.pl,v 1.2 1996/07/29 21:20:20 jfk Exp $
  7. ;#
  8. ;# Usage:
  9. ;#    require "pwd.pl";
  10. ;#    &initpwd;
  11. ;#    ...
  12. ;#    &chdir($newdir);
  13.  
  14. package pwd;
  15.  
  16. sub main'initpwd {
  17.     chop($ENV{'PWD'} = `pwd`);
  18. }
  19.  
  20. sub main'chdir {
  21.     local($newdir) = shift;
  22.     if (chdir $newdir) {
  23.     if ($newdir =~ m#^/#) {
  24.         $ENV{'PWD'} = $newdir;
  25.     }
  26.     else {
  27.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  28.         @curdir = '' unless @curdir;
  29.         foreach $component (split(m#/#, $newdir)) {
  30.         next if $component eq '.';
  31.         pop(@curdir),next if $component eq '..';
  32.         push(@curdir,$component);
  33.         }
  34.         $ENV{'PWD'} = join('/',@curdir) || '/';
  35.     }
  36.     }
  37.     else {
  38.     0;
  39.     }
  40. }
  41.  
  42. 1;
  43.