Win32 pacifying from mjd.
[perl.git] / 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 #
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;