home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 November / PCWorld_2004-11_cd.bin / software / topware / activeperl / ActivePerl-5.8.4.810-MSWin32-x86.exe / ActivePerl-5.8.4.810 / Perl / lib / getcwd.pl < prev    next >
Text File  |  2004-06-01  |  1KB  |  72 lines
  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;
  72.