Upgrade to Pod-Simple-3.08
[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 # 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;