This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deprecate getcwd.pl with a warning
[perl5.git] / lib / getcwd.pl
CommitLineData
55204971
LW
1# By Brandon S. Allbery
2#
a6d71656
GS
3# This library is no longer being maintained, and is included for backward
4# compatibility with Perl 4 programs which may require it.
6e373246
S
5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656
GS
7# In particular, this should not be used as an example of modern Perl
8# programming techniques.
9#
10# Suggested alternative: Cwd
6e373246
S
11
12warn( "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
a6d71656 16#
55204971
LW
17# Usage: $cwd = &getcwd;
18
19sub 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 {
c2960299 53 unless (defined ($dir = readdir(getcwd'PARENT))) #'))
55204971
LW
54 {
55 warn "readdir($dotdots): $!";
56 closedir(getcwd'PARENT); #');
57 return '';
58 }
e334a159 59 unless (@tst = lstat("$dotdots/$dir"))
55204971 60 {
55497cff 61 # warn "lstat($dotdots/$dir): $!";
62 # closedir(getcwd'PARENT); #');
63 # return '';
55204971
LW
64 }
65 }
66 while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
67 $tst[$[ + 1] != $pst[$[ + 1]);
68 }
69 $cwd = "$dir/$cwd";
70 closedir(getcwd'PARENT); #');
1f997daf 71 } while ($dir ne '');
55204971
LW
72 chop($cwd);
73 $cwd;
74}
75
761;