Rename tied_handle_method() to tied_method(), and make it non-static.
[perl.git] / lib / getcwd.pl
1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
2
3 # By Brandon S. Allbery
4 #
5 # This library is no longer being maintained, and is included for backward
6 # compatibility with Perl 4 programs which may require it.
7 # This legacy library is deprecated and will be removed in a future
8 # release of perl.
9 # In particular, this should not be used as an example of modern Perl
10 # programming techniques.
11 #
12 # Suggested alternative: Cwd
13
14 #
15 # Usage: $cwd = &getcwd;
16
17 sub getcwd
18 {
19     local($dotdots, $cwd, @pst, @cst, $dir, @tst);
20
21     unless (@cst = stat('.'))
22     {
23         warn "stat(.): $!";
24         return '';
25     }
26     $cwd = '';
27     do
28     {
29         $dotdots .= '/' if $dotdots;
30         $dotdots .= '..';
31         @pst = @cst;
32         unless (opendir(getcwd'PARENT, $dotdots))                       #'))
33         {
34             warn "opendir($dotdots): $!";
35             return '';
36         }
37         unless (@cst = stat($dotdots))
38         {
39             warn "stat($dotdots): $!";
40             closedir(getcwd'PARENT);                                    #');
41             return '';
42         }
43         if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
44         {
45             $dir = '';
46         }
47         else
48         {
49             do
50             {
51                 unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
52                 {
53                     warn "readdir($dotdots): $!";
54                     closedir(getcwd'PARENT);                            #');
55                     return '';
56                 }
57                 unless (@tst = lstat("$dotdots/$dir"))
58                 {
59                     # warn "lstat($dotdots/$dir): $!";
60                     # closedir(getcwd'PARENT);                          #');
61                     # return '';
62                 }
63             }
64             while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
65                    $tst[1] != $pst[1]);
66         }
67         $cwd = "$dir/$cwd";
68         closedir(getcwd'PARENT);                                        #');
69     } while ($dir ne '');
70     chop($cwd);
71     $cwd;
72 }
73
74 1;