lib/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 # This legacy library is deprecated and will be removed in a future
   6 # release of perl.
   7 # In particular, this should not be used as an example of modern Perl
   8 # programming techniques.
   9 #
  10 # Suggested alternative: Cwd
  11
  12 warn( "The 'getcwd.pl' legacy library is deprecated and will be"
  13       . " removed in the next major release of perl. Please use the"
  14       . " Cwd module instead." );
  15
  16 #
  17 # Usage: $cwd = &getcwd;
  18
  19 sub getcwd
  20 {
  21     local($dotdots, $cwd, @pst, @cst, $dir, @tst);
  22
  23     unless (@cst = stat('.'))
  24     {
  25         warn "stat(.): $!";
  26         return '';
  27     }
  28     $cwd = '';
  29     do
  30     {
  31         $dotdots .= '/' if $dotdots;
  32         $dotdots .= '..';
  33         @pst = @cst;
  34         unless (opendir(getcwd'PARENT, $dotdots))                       #'))
  35         {
  36             warn "opendir($dotdots): $!";
  37             return '';
  38         }
  39         unless (@cst = stat($dotdots))
  40         {
  41             warn "stat($dotdots): $!";
  42             closedir(getcwd'PARENT);                                    #');
  43             return '';
  44         }
  45         if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
  46         {
  47             $dir = '';
  48         }
  49         else
  50         {
  51             do
  52             {
  53                 unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
  54                 {
  55                     warn "readdir($dotdots): $!";
  56                     closedir(getcwd'PARENT);                            #');
  57                     return '';
  58                 }
  59                 unless (@tst = lstat("$dotdots/$dir"))
  60                 {
  61                     # warn "lstat($dotdots/$dir): $!";
  62                     # closedir(getcwd'PARENT);                          #');
  63                     # return '';
  64                 }
  65             }
  66             while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
  67                    $tst[$[ + 1] != $pst[$[ + 1]);
  68         }
  69         $cwd = "$dir/$cwd";
  70         closedir(getcwd'PARENT);                                        #');
  71     } while ($dir ne '');
  72     chop($cwd);
  73     $cwd;
  74 }
  75
  76 1;