8 getcwd - get pathname of current working directory
24 The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
25 in Perl. If you ask to override your chdir() built-in function, then your
26 PWD environment variable will be kept up to date. (See
27 L<perlsub/Overriding builtin functions>.)
29 The fastgetcwd() function looks the same as getcwd(), but runs faster.
30 It's also more dangerous because you might conceivably chdir() out of a
31 directory that you can't chdir() back into.
36 @EXPORT = qw(getcwd fastcwd);
37 @EXPORT_OK = qw(chdir);
40 # VMS: $ENV{'DEFAULT'} points to default directory at all times
41 # 08-Dec-1994 Charles Bailey bailey@genetics.upenn.edu
42 # Note: Use of Cwd::getcwd() or Cwd::chdir() (but not Cwd::fastcwd())
43 # causes the logical name PWD to be defined in the process
44 # logical name table as the default device and directory
45 # seen by Perl. This may not be the same as the default device
46 # and directory seen by DCL after Perl exits, since the effects
47 # the CRTL chdir() function persist only until Perl exits.
49 # By Brandon S. Allbery
51 # Usage: $cwd = getcwd();
55 if($Config{'osname'} eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
57 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
59 unless (@cst = stat('.'))
68 $dotdots .= '/' if $dotdots;
71 unless (opendir(PARENT, $dotdots))
73 warn "opendir($dotdots): $!";
76 unless (@cst = stat($dotdots))
78 warn "stat($dotdots): $!";
82 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
90 unless (defined ($dir = readdir(PARENT)))
92 warn "readdir($dotdots): $!";
96 unless (@tst = lstat("$dotdots/$dir"))
98 warn "lstat($dotdots/$dir): $!";
103 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
109 chop($cwd); # drop the trailing /
117 # Usage: $cwd = &fastcwd;
119 # This is a faster version of getcwd. It's also more dangerous because
120 # you might chdir out of a directory that you can't chdir back into.
123 if($Config{'osname'} eq 'VMS') { return $ENV{'DEFAULT'} }
125 my($odev, $oino, $cdev, $cino, $tdev, $tino);
129 ($cdev, $cino) = stat('.');
132 ($odev, $oino) = ($cdev, $cino);
134 ($cdev, $cino) = stat('.');
135 last if $odev == $cdev && $oino == $cino;
138 $direntry = readdir(DIR);
139 next if $direntry eq '.';
140 next if $direntry eq '..';
142 last unless defined $direntry;
143 ($tdev, $tino) = lstat($direntry);
144 last unless $tdev != $odev || $tino != $oino;
147 unshift(@path, $direntry);
149 chdir($path = '/' . join('/', @path));
154 # keeps track of current working directory in PWD environment var
156 # $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
168 my($dd,$di) = stat('.');
169 my($pd,$pi) = stat($ENV{'PWD'});
170 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
171 chop($ENV{'PWD'} = `pwd`);
175 chop($ENV{'PWD'} = `pwd`);
177 if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
178 my($pd,$pi) = stat($2);
179 my($dd,$di) = stat($1);
180 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
189 $newdir =~ s|/{2,}|/|g;
190 chdir_init() unless $chdir_init;
191 return 0 unless (CORE::chdir $newdir);
192 if ($Config{'osname'} eq 'VMS') { return $ENV{PWD} = $ENV{DEFAULT} }
194 if ($newdir =~ m#^/#) {
195 $ENV{'PWD'} = $newdir;
197 my(@curdir) = split(m#/#,$ENV{'PWD'});
198 @curdir = '' unless @curdir;
199 foreach $component (split(m#/#, $newdir)) {
200 next if $component eq '.';
201 pop(@curdir),next if $component eq '..';
202 push(@curdir,$component);
204 $ENV{'PWD'} = join('/',@curdir) || '/';