5 Cwd - get pathname of current working directory
13 my $abs_path = abs_path($file);
17 This module provides functions for determining the pathname of the
18 current working directory. It is recommended that getcwd (or another
19 *cwd() function) be used in I<all> code to ensure portability.
21 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
22 fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
25 =head2 getcwd and friends
27 Each of these functions are called without arguments and return the
28 absolute path of the current working directory.
36 Returns the current working directory.
38 Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
44 The cwd() is the most natural form for the current architecture. For
45 most systems it is identical to `pwd` (but without the trailing line
52 A more dangerous version of getcwd(), but potentially faster.
54 It might conceivably chdir() you out of a directory that it can't
55 chdir() you back into. If fastcwd encounters a problem it will return
56 undef but will probably leave you in a different directory. For a
57 measure of extra security, if everything appears to have worked, the
58 fastcwd() function will check that it leaves you in the same directory
59 that it started in. If it has changed it will C<die> with the message
60 "Unstable directory path, current directory changed
61 unexpectedly". That should never happen.
65 my $cwd = fastgetcwd();
67 The fastgetcwd() function is provided as a synonym for cwd().
72 my $cwd = getdcwd('C:');
74 The getdcwd() function is also provided on Win32 to get the current working
75 directory on the specified drive, since Windows maintains a separate current
76 working directory for each drive. If no drive is specified then the current
79 This function simply calls the Microsoft C library _getdcwd() function.
84 =head2 abs_path and friends
86 These functions are exported only on request. They each take a single
87 argument and return the absolute pathname for it. If no argument is
88 given they'll use the current working directory.
94 my $abs_path = abs_path($file);
96 Uses the same algorithm as getcwd(). Symbolic links and relative-path
97 components ("." and "..") are resolved to return the canonical
98 pathname, just like realpath(3).
102 my $abs_path = realpath($file);
104 A synonym for abs_path().
108 my $abs_path = fast_abs_path($file);
110 A more dangerous, but potentially faster version of abs_path.
116 If you ask to override your chdir() built-in function,
120 then your PWD environment variable will be kept up to date. Note that
121 it will only be kept up to date if all packages which use chdir import
131 Since the path seperators are different on some operating systems ('/'
132 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
133 modules wherever portability is a concern.
137 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
138 functions are all aliases for the C<cwd()> function, which, on Mac OS,
139 calls `pwd`. Likewise, the C<abs_path()> function is an alias for
146 Originally by the perl5-porters.
148 Maintained by Ken Williams <KWILLIAMS@cpan.org>
152 Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
154 This program is free software; you can redistribute it and/or modify
155 it under the same terms as Perl itself.
157 Portions of the C code in this library are copyright (c) 1994 by the
158 Regents of the University of California. All rights reserved. The
159 license on this code is compatible with the licensing of the rest of
160 the distribution - please see the source code in F<Cwd.xs> for the
171 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
175 @ISA = qw/ Exporter /;
176 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
177 push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
178 @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
180 # sys_cwd may keep the builtin command
182 # All the functionality of this module may provided by builtins,
183 # there is no sense to process the rest of the file.
184 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
189 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
194 *fast_abs_path = \&sys_abspath if defined &sys_abspath;
195 *abs_path = \&fast_abs_path;
196 *realpath = \&fast_abs_path;
197 *fast_realpath = \&fast_abs_path;
202 # If loading the XS stuff doesn't work, we can fall back to pure perl
206 XSLoader::load( __PACKAGE__, $VERSION );
209 push @ISA, 'DynaLoader';
210 __PACKAGE__->bootstrap( $VERSION );
214 # Must be after the DynaLoader stuff:
215 $VERSION = eval $VERSION;
217 # Big nasty table of function aliases
223 getcwd => '_vms_cwd',
224 fastcwd => '_vms_cwd',
225 fastgetcwd => '_vms_cwd',
226 abs_path => '_vms_abs_path',
227 fast_abs_path => '_vms_abs_path',
232 # We assume that &_NT_cwd is defined as an XSUB or in the core.
235 fastcwd => '_NT_cwd',
236 fastgetcwd => '_NT_cwd',
237 abs_path => 'fast_abs_path',
238 realpath => 'fast_abs_path',
244 getcwd => '_dos_cwd',
245 fastgetcwd => '_dos_cwd',
246 fastcwd => '_dos_cwd',
247 abs_path => 'fast_abs_path',
253 getcwd => '_qnx_cwd',
254 fastgetcwd => '_qnx_cwd',
255 fastcwd => '_qnx_cwd',
256 abs_path => '_qnx_abs_path',
257 fast_abs_path => '_qnx_abs_path',
265 abs_path => 'fast_abs_path',
266 realpath => 'fast_abs_path',
272 getcwd => '_epoc_cwd',
273 fastgetcwd => '_epoc_cwd',
274 fastcwd => '_epoc_cwd',
275 abs_path => 'fast_abs_path',
283 abs_path => 'fast_abs_path',
287 $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
288 $METHOD_MAP{nto} = $METHOD_MAP{qnx};
291 # Find the pwd command in the expected locations. We assume these
292 # are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
293 # so everything works under taint mode.
295 foreach my $try ('/bin/pwd',
297 '/QOpenSys/bin/pwd', # OS/400 PASE.
306 # Isn't this wrong? _backtick_pwd() will fail if somenone has
307 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
308 # See [perl #16774]. --jhi
313 sub _carp { require Carp; Carp::carp(@_) }
314 sub _croak { require Carp; Carp::croak(@_) }
316 # The 'natural and safe form' for UNIX (pwd may be setuid root)
318 local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
319 my $cwd = `$pwd_cmd`;
320 # Belt-and-suspenders in case someone said "undef $/".
322 # `pwd` may fail e.g. if the disk is full
323 chomp($cwd) if defined $cwd;
327 # Since some ports may predefine cwd internally (e.g., NT)
328 # we take care not to override an existing definition for cwd().
330 unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
331 # The pwd command is not available in some chroot(2)'ed environments
332 my $sep = $Config::Config{path_sep} || ':';
333 if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
334 $^O ne 'MSWin32' && # no pwd on Windows
335 grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
337 *cwd = \&_backtick_pwd;
344 # set a reasonable (and very safe) default for fastgetcwd, in case it
345 # isn't redefined later (20001212 rspier)
348 # By Brandon S. Allbery
350 # Usage: $cwd = getcwd();
360 # Usage: $cwd = &fastcwd;
362 # This is a faster version of getcwd. It's also more dangerous because
363 # you might chdir out of a directory that you can't chdir back into.
366 my($odev, $oino, $cdev, $cino, $tdev, $tino);
370 my($orig_cdev, $orig_cino) = stat('.');
371 ($cdev, $cino) = ($orig_cdev, $orig_cino);
374 ($odev, $oino) = ($cdev, $cino);
375 CORE::chdir('..') || return undef;
376 ($cdev, $cino) = stat('.');
377 last if $odev == $cdev && $oino == $cino;
378 opendir(DIR, '.') || return undef;
380 $direntry = readdir(DIR);
381 last unless defined $direntry;
382 next if $direntry eq '.';
383 next if $direntry eq '..';
385 ($tdev, $tino) = lstat($direntry);
386 last unless $tdev != $odev || $tino != $oino;
389 return undef unless defined $direntry; # should never happen
390 unshift(@path, $direntry);
392 $path = '/' . join('/', @path);
393 if ($^O eq 'apollo') { $path = "/".$path; }
394 # At this point $path may be tainted (if tainting) and chdir would fail.
395 # Untaint it then check that we landed where we started.
396 $path =~ /^(.*)\z/s # untaint
397 && CORE::chdir($1) or return undef;
398 ($cdev, $cino) = stat('.');
399 die "Unstable directory path, current directory changed unexpectedly"
400 if $cdev != $orig_cdev || $cino != $orig_cino;
403 if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
406 # Keeps track of current working directory in PWD environment var
414 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
415 my($dd,$di) = stat('.');
416 my($pd,$pi) = stat($ENV{'PWD'});
417 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
423 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
426 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
427 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
428 my($pd,$pi) = stat($2);
429 my($dd,$di) = stat($1);
430 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
438 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
439 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
440 chdir_init() unless $chdir_init;
442 if ($^O eq 'MSWin32') {
443 # get the full path name *before* the chdir()
444 $newpwd = Win32::GetFullPathName($newdir);
447 return 0 unless CORE::chdir $newdir;
450 return $ENV{'PWD'} = $ENV{'DEFAULT'}
452 elsif ($^O eq 'MacOS') {
453 return $ENV{'PWD'} = cwd();
455 elsif ($^O eq 'MSWin32') {
456 $ENV{'PWD'} = $newpwd;
460 if ($newdir =~ m#^/#s) {
461 $ENV{'PWD'} = $newdir;
463 my @curdir = split(m#/#,$ENV{'PWD'});
464 @curdir = ('') unless @curdir;
466 foreach $component (split(m#/#, $newdir)) {
467 next if $component eq '.';
468 pop(@curdir),next if $component eq '..';
469 push(@curdir,$component);
471 $ENV{'PWD'} = join('/',@curdir) || '/';
479 my $start = @_ ? shift : '.';
480 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
482 unless (@cst = stat( $start ))
484 _carp("stat($start): $!");
489 # Make sure we can be invoked on plain files, not just directories.
490 # NOTE that this routine assumes that '/' is the only directory separator.
492 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
493 or return cwd() . '/' . $start;
495 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
497 my $link_target = readlink($start);
498 die "Can't resolve link $start: $!" unless defined $link_target;
501 $link_target = $dir . '/' . $link_target
502 unless File::Spec->file_name_is_absolute($link_target);
504 return abs_path($link_target);
507 return $dir ? abs_path($dir) . "/$file" : "/$file";
517 unless (opendir(PARENT, $dotdots))
519 _carp("opendir($dotdots): $!");
522 unless (@cst = stat($dotdots))
524 _carp("stat($dotdots): $!");
528 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
536 unless (defined ($dir = readdir(PARENT)))
538 _carp("readdir($dotdots): $!");
542 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
544 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
547 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
549 } while (defined $dir);
550 chop($cwd) unless $cwd eq '/'; # drop the trailing /
557 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
560 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
562 # Detaint else we'll explode in taint mode. This is safe because
563 # we're not doing anything dangerous with it.
564 ($path) = $path =~ /(.*)/;
565 ($cwd) = $cwd =~ /(.*)/;
568 _croak("$path: No such file or directory");
572 # Make sure we can be invoked on plain files, not just directories.
574 my ($vol, $dir, $file) = File::Spec->splitpath($path);
575 return File::Spec->catfile($cwd, $path) unless length $dir;
578 my $link_target = readlink($path);
579 die "Can't resolve link $path: $!" unless defined $link_target;
581 $link_target = File::Spec->catpath($vol, $dir, $link_target)
582 unless File::Spec->file_name_is_absolute($link_target);
584 return fast_abs_path($link_target);
588 $tdir =~ s!\\!/!g if $^O eq 'MSWin32';
589 return $tdir eq File::Spec->rootdir
590 ? File::Spec->catpath($vol, $dir, $file)
591 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
594 if (!CORE::chdir($path)) {
595 _croak("Cannot chdir to $path: $!");
597 my $realpath = getcwd();
598 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
599 _croak("Cannot chdir back to $cwd: $!");
604 # added function alias to follow principle of least surprise
605 # based on previous aliasing. --tchrist 27-Jan-00
606 *fast_realpath = \&fast_abs_path;
609 # --- PORTING SECTION ---
611 # VMS: $ENV{'DEFAULT'} points to default directory at all times
612 # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
613 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
614 # in the process logical name table as the default device and directory
615 # seen by Perl. This may not be the same as the default device
616 # and directory seen by DCL after Perl exits, since the effects
617 # the CRTL chdir() function persist only until Perl exits.
620 return $ENV{'DEFAULT'};
624 return $ENV{'DEFAULT'} unless @_;
626 # may need to turn foo.dir into [.foo]
627 my $path = VMS::Filespec::pathify($_[0]);
628 $path = $_[0] unless defined $path;
630 return VMS::Filespec::rmsexpand($path);
634 $ENV{'PWD'} = `cmd /c cd`;
636 $ENV{'PWD'} =~ s:\\:/:g ;
641 $ENV{'PWD'} = Win32::GetCwd();
642 $ENV{'PWD'} =~ s:\\:/:g ;
646 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
647 defined &Win32::GetCwd);
649 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
652 if (!defined &Dos::GetCwd) {
653 $ENV{'PWD'} = `command /c cd`;
655 $ENV{'PWD'} =~ s:\\:/:g ;
657 $ENV{'PWD'} = Dos::GetCwd();
663 local $ENV{PATH} = '';
664 local $ENV{CDPATH} = '';
665 local $ENV{ENV} = '';
666 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
672 local $ENV{PATH} = '';
673 local $ENV{CDPATH} = '';
674 local $ENV{ENV} = '';
675 my $path = @_ ? shift : '.';
678 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
679 die "Can't open /usr/bin/fullpath: $!";
680 my $realpath = <REALPATH>;
687 $ENV{'PWD'} = EPOC::getcwd();
692 # Now that all the base-level functions are set up, alias the
693 # user-level functions to the right places
695 if (exists $METHOD_MAP{$^O}) {
696 my $map = $METHOD_MAP{$^O};
697 foreach my $name (keys %$map) {
698 local $^W = 0; # assignments trigger 'subroutine redefined' warning
700 *{$name} = \&{$map->{$name}};
704 # In case the XS version doesn't load.
705 *abs_path = \&_perl_abs_path unless defined &abs_path;
707 # added function alias for those of us more
708 # used to the libc function. --tchrist 27-Jan-00
709 *realpath = \&abs_path;