source: trunk/essentials/dev-lang/perl/lib/getcwd.pl@ 3221

Last change on this file since 3221 was 3181, checked in by bird, 19 years ago

perl 5.8.8

File size: 1.4 KB
Line 
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 }