6 getcwd - get pathname of current working directory
25 The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
28 The fastcwd() function looks the same as getcwd(), but runs faster.
29 It's also more dangerous because you might conceivably chdir() out of a
30 directory that you can't chdir() back into.
32 The cwd() function looks the same as getcwd and fastgetcwd but is
33 implemented using the most natural and safe form for the current
34 architecture. For most systems it is identical to `pwd` (but without
35 the trailing line terminator). It is recommended that cwd (or another
36 *cwd() function) is used in I<all> code to ensure portability.
38 If you ask to override your chdir() built-in function, then your PWD
39 environment variable will be kept up to date. (See
40 L<perlsub/Overriding Builtin Functions>.) Note that it will only be
41 kept up to date if all packages which use chdir import it from Cwd.
53 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
54 @EXPORT_OK = qw(chdir abs_path fast_abs_path);
57 # The 'natural and safe form' for UNIX (pwd may be setuid root)
65 # Since some ports may predefine cwd internally (e.g., NT)
66 # we take care not to override an existing definition for cwd().
68 *cwd = \&_backtick_pwd unless defined &cwd;
71 # By Brandon S. Allbery
73 # Usage: $cwd = getcwd();
77 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
79 unless (@cst = stat('.'))
88 $dotdots .= '/' if $dotdots;
91 unless (opendir(PARENT, $dotdots))
93 warn "opendir($dotdots): $!";
96 unless (@cst = stat($dotdots))
98 warn "stat($dotdots): $!";
102 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
110 unless (defined ($dir = readdir(PARENT)))
112 warn "readdir($dotdots): $!";
116 unless (@tst = lstat("$dotdots/$dir"))
118 # warn "lstat($dotdots/$dir): $!";
119 # Just because you can't lstat this directory
120 # doesn't mean you'll never find the right one.
125 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
131 chop($cwd) unless $cwd eq '/'; # drop the trailing /
139 # Usage: $cwd = &fastcwd;
141 # This is a faster version of getcwd. It's also more dangerous because
142 # you might chdir out of a directory that you can't chdir back into.
145 my($odev, $oino, $cdev, $cino, $tdev, $tino);
149 ($cdev, $cino) = stat('.');
152 ($odev, $oino) = ($cdev, $cino);
154 ($cdev, $cino) = stat('.');
155 last if $odev == $cdev && $oino == $cino;
158 $direntry = readdir(DIR);
159 next if $direntry eq '.';
160 next if $direntry eq '..';
162 last unless defined $direntry;
163 ($tdev, $tino) = lstat($direntry);
164 last unless $tdev != $odev || $tino != $oino;
167 unshift(@path, $direntry);
169 chdir($path = '/' . join('/', @path));
174 # Keeps track of current working directory in PWD environment var
182 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
183 my($dd,$di) = stat('.');
184 my($pd,$pi) = stat($ENV{'PWD'});
185 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
192 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
193 if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
194 my($pd,$pi) = stat($2);
195 my($dd,$di) = stat($1);
196 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
204 my $newdir = shift || ''; # allow for no arg (chdir to HOME dir)
205 $newdir =~ s|///*|/|g;
206 chdir_init() unless $chdir_init;
207 return 0 unless CORE::chdir $newdir;
208 if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
210 if ($newdir =~ m#^/#) {
211 $ENV{'PWD'} = $newdir;
213 my @curdir = split(m#/#,$ENV{'PWD'});
214 @curdir = ('') unless @curdir;
216 foreach $component (split(m#/#, $newdir)) {
217 next if $component eq '.';
218 pop(@curdir),next if $component eq '..';
219 push(@curdir,$component);
221 $ENV{'PWD'} = join('/',@curdir) || '/';
226 # Taken from Cwd.pm It is really getcwd with an optional
227 # parameter instead of '.'
232 my $start = shift || '.';
233 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
235 unless (@cst = stat( $start ))
237 carp "stat($start): $!";
246 unless (opendir(PARENT, $dotdots))
248 carp "opendir($dotdots): $!";
251 unless (@cst = stat($dotdots))
253 carp "stat($dotdots): $!";
257 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
265 unless (defined ($dir = readdir(PARENT)))
267 carp "readdir($dotdots): $!";
271 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
273 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
279 chop($cwd); # drop the trailing /
285 my $path = shift || '.';
286 chdir($path) || croak "Cannot chdir to $path:$!";
287 my $realpath = getcwd();
288 chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
293 # --- PORTING SECTION ---
295 # VMS: $ENV{'DEFAULT'} points to default directory at all times
296 # 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
297 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
298 # in the process logical name table as the default device and directory
299 # seen by Perl. This may not be the same as the default device
300 # and directory seen by DCL after Perl exits, since the effects
301 # the CRTL chdir() function persist only until Perl exits.
304 return $ENV{'DEFAULT'};
308 return $ENV{'DEFAULT'} unless @_;
309 my $path = VMS::Filespec::pathify($_[0]);
310 croak("Invalid path name $_[0]") unless defined $path;
311 return VMS::Filespec::rmsexpand($path);
315 $ENV{'PWD'} = `cmd /c cd`;
317 $ENV{'PWD'} =~ s:\\:/:g ;
322 $ENV{'PWD'} = Win32::GetCurrentDirectory();
323 $ENV{'PWD'} =~ s:\\:/:g ;
327 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
328 defined &Win32::GetCurrentDirectory);
330 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
333 $ENV{'PWD'} = `command /c cd`;
335 $ENV{'PWD'} =~ s:\\:/:g ;
340 local $^W = 0; # assignments trigger 'subroutine redefined' warning
344 *getcwd = \&_vms_cwd;
345 *fastcwd = \&_vms_cwd;
346 *fastgetcwd = \&_vms_cwd;
347 *abs_path = \&_vms_abs_path;
348 *fast_abs_path = \&_vms_abs_path;
350 elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
351 # We assume that &_NT_cwd is defined as an XSUB or in the core.
354 *fastcwd = \&_NT_cwd;
355 *fastgetcwd = \&_NT_cwd;
356 *abs_path = \&fast_abs_path;
358 elsif ($^O eq 'os2') {
359 # sys_cwd may keep the builtin command
360 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
364 *abs_path = \&fast_abs_path;
366 elsif ($^O eq 'msdos') {
368 *getcwd = \&_msdos_cwd;
369 *fastgetcwd = \&_msdos_cwd;
370 *fastcwd = \&_msdos_cwd;
371 *abs_path = \&fast_abs_path;
375 # package main; eval join('',<DATA>) || die $@; # quick test
380 BEGIN { import Cwd qw(:DEFAULT chdir); }
381 print join("\n", cwd, getcwd, fastcwd, "");
383 print join("\n", cwd, getcwd, fastcwd, "");