contrib/perl5/lib/getcwd.pl

   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;