home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_mlb.zip / getcwd.pl < prev    next >
Text File  |  1997-11-25  |  1KB  |  63 lines
  1. # By Brandon S. Allbery
  2. #
  3. # Usage: $cwd = &getcwd;
  4.  
  5. sub getcwd
  6. {
  7.     local($dotdots, $cwd, @pst, @cst, $dir, @tst);
  8.  
  9.     unless (@cst = stat('.'))
  10.     {
  11.     warn "stat(.): $!";
  12.     return '';
  13.     }
  14.     $cwd = '';
  15.     do
  16.     {
  17.     $dotdots .= '/' if $dotdots;
  18.     $dotdots .= '..';
  19.     @pst = @cst;
  20.     unless (opendir(getcwd'PARENT, $dotdots))            #'))
  21.     {
  22.         warn "opendir($dotdots): $!";
  23.         return '';
  24.     }
  25.     unless (@cst = stat($dotdots))
  26.     {
  27.         warn "stat($dotdots): $!";
  28.         closedir(getcwd'PARENT);                    #');
  29.         return '';
  30.     }
  31.     if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
  32.     {
  33.         $dir = '';
  34.     }
  35.     else
  36.     {
  37.         do
  38.         {
  39.         unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
  40.         {
  41.             warn "readdir($dotdots): $!";
  42.             closedir(getcwd'PARENT);                #');
  43.             return '';
  44.         }
  45.         unless (@tst = lstat("$dotdots/$dir"))
  46.         {
  47.             # warn "lstat($dotdots/$dir): $!";
  48.             # closedir(getcwd'PARENT);                #');
  49.             # return '';
  50.         }
  51.         }
  52.         while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
  53.            $tst[$[ + 1] != $pst[$[ + 1]);
  54.     }
  55.     $cwd = "$dir/$cwd";
  56.     closedir(getcwd'PARENT);                    #');
  57.     } while ($dir ne '');
  58.     chop($cwd);
  59.     $cwd;
  60. }
  61.  
  62. 1;
  63.