lib/perl5/5.6.1/getcwd.pl

   1 # By Brandon S. Allbery
   2 #
   3 # This library is no longer being maintained, and is included for backward
   4 # compatibility with Perl 4 programs which may require it.
   5 #
   6 # In particular, this should not be used as an example of modern Perl
   7 # programming techniques.
   8 #
   9 # Suggested alternative: Cwd
  10 #
  11 #
  12 # Usage: $cwd = &getcwd;
  13
  14 sub getcwd
  15 {
  16     local($dotdots, $cwd, @pst, @cst, $dir, @tst);
  17
  18     unless (@cst = stat('.'))
  19     {
  20         warn "stat(.): $!";
  21         return '';
  22     }
  23     $cwd = '';
  24     do
  25     {
  26         $dotdots .= '/' if $dotdots;
  27         $dotdots .= '..';
  28         @pst = @cst;
  29         unless (opendir(getcwd'PARENT, $dotdots))                       #'))
  30         {
  31             warn "opendir($dotdots): $!";
  32             return '';
  33         }
  34         unless (@cst = stat($dotdots))
  35         {
  36             warn "stat($dotdots): $!";
  37             closedir(getcwd'PARENT);                                    #');
  38             return '';
  39         }
  40         if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
  41         {
  42             $dir = '';
  43         }
  44         else
  45         {
  46             do
  47             {
  48                 unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
  49                 {
  50                     warn "readdir($dotdots): $!";
  51                     closedir(getcwd'PARENT);                            #');
  52                     return '';
  53                 }
  54                 unless (@tst = lstat("$dotdots/$dir"))
  55                 {
  56                     # warn "lstat($dotdots/$dir): $!";
  57                     # closedir(getcwd'PARENT);                          #');
  58                     # return '';
  59                 }
  60             }
  61             while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
  62                    $tst[$[ + 1] != $pst[$[ + 1]);
  63         }
  64         $cwd = "$dir/$cwd";
  65         closedir(getcwd'PARENT);                                        #');
  66     } while ($dir ne '');
  67     chop($cwd);
  68     $cwd;
  69 }
  70
  71 1;