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
14sub 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[0] == $cst[0] && $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[0] != $pst[0] ||
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
711;
72