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 # Localize %ENV entries in a way that won't create new hash keys
319 my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
320 local @ENV{@localize};
322 my $cwd = `$pwd_cmd`;
323 # Belt-and-suspenders in case someone said "undef $/".
325 # `pwd` may fail e.g. if the disk is full
326 chomp($cwd) if defined $cwd;
330 # Since some ports may predefine cwd internally (e.g., NT)
331 # we take care not to override an existing definition for cwd().
333 unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
334 # The pwd command is not available in some chroot(2)'ed environments
335 my $sep = $Config::Config{path_sep} || ':';
336 my $os = $^O; # Protect $^O from tainting
337 if( $os eq 'MacOS' || (defined $ENV{PATH} &&
338 $os ne 'MSWin32' && # no pwd on Windows
339 grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
341 *cwd = \&_backtick_pwd;
348 # set a reasonable (and very safe) default for fastgetcwd, in case it
349 # isn't redefined later (20001212 rspier)
352 # By Brandon S. Allbery
354 # Usage: $cwd = getcwd();
364 # Usage: $cwd = &fastcwd;
366 # This is a faster version of getcwd. It's also more dangerous because
367 # you might chdir out of a directory that you can't chdir back into.
370 my($odev, $oino, $cdev, $cino, $tdev, $tino);
374 my($orig_cdev, $orig_cino) = stat('.');
375 ($cdev, $cino) = ($orig_cdev, $orig_cino);
378 ($odev, $oino) = ($cdev, $cino);
379 CORE::chdir('..') || return undef;
380 ($cdev, $cino) = stat('.');
381 last if $odev == $cdev && $oino == $cino;
382 opendir(DIR, '.') || return undef;
384 $direntry = readdir(DIR);
385 last unless defined $direntry;
386 next if $direntry eq '.';
387 next if $direntry eq '..';
389 ($tdev, $tino) = lstat($direntry);
390 last unless $tdev != $odev || $tino != $oino;
393 return undef unless defined $direntry; # should never happen
394 unshift(@path, $direntry);
396 $path = '/' . join('/', @path);
397 if ($^O eq 'apollo') { $path = "/".$path; }
398 # At this point $path may be tainted (if tainting) and chdir would fail.
399 # Untaint it then check that we landed where we started.
400 $path =~ /^(.*)\z/s # untaint
401 && CORE::chdir($1) or return undef;
402 ($cdev, $cino) = stat('.');
403 die "Unstable directory path, current directory changed unexpectedly"
404 if $cdev != $orig_cdev || $cino != $orig_cino;
407 if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
410 # Keeps track of current working directory in PWD environment var
418 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
419 my($dd,$di) = stat('.');
420 my($pd,$pi) = stat($ENV{'PWD'});
421 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
427 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
430 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
431 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
432 my($pd,$pi) = stat($2);
433 my($dd,$di) = stat($1);
434 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
442 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
443 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
444 chdir_init() unless $chdir_init;
446 if ($^O eq 'MSWin32') {
447 # get the full path name *before* the chdir()
448 $newpwd = Win32::GetFullPathName($newdir);
451 return 0 unless CORE::chdir $newdir;
454 return $ENV{'PWD'} = $ENV{'DEFAULT'}
456 elsif ($^O eq 'MacOS') {
457 return $ENV{'PWD'} = cwd();
459 elsif ($^O eq 'MSWin32') {
460 $ENV{'PWD'} = $newpwd;
464 if ($newdir =~ m#^/#s) {
465 $ENV{'PWD'} = $newdir;
467 my @curdir = split(m#/#,$ENV{'PWD'});
468 @curdir = ('') unless @curdir;
470 foreach $component (split(m#/#, $newdir)) {
471 next if $component eq '.';
472 pop(@curdir),next if $component eq '..';
473 push(@curdir,$component);
475 $ENV{'PWD'} = join('/',@curdir) || '/';
483 my $start = @_ ? shift : '.';
484 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
486 unless (@cst = stat( $start ))
488 _carp("stat($start): $!");
493 # Make sure we can be invoked on plain files, not just directories.
494 # NOTE that this routine assumes that '/' is the only directory separator.
496 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
497 or return cwd() . '/' . $start;
499 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
501 my $link_target = readlink($start);
502 die "Can't resolve link $start: $!" unless defined $link_target;
505 $link_target = $dir . '/' . $link_target
506 unless File::Spec->file_name_is_absolute($link_target);
508 return abs_path($link_target);
511 return $dir ? abs_path($dir) . "/$file" : "/$file";
521 unless (opendir(PARENT, $dotdots))
523 _carp("opendir($dotdots): $!");
526 unless (@cst = stat($dotdots))
528 _carp("stat($dotdots): $!");
532 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
540 unless (defined ($dir = readdir(PARENT)))
542 _carp("readdir($dotdots): $!");
546 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
548 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
551 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
553 } while (defined $dir);
554 chop($cwd) unless $cwd eq '/'; # drop the trailing /
561 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
564 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
566 # Detaint else we'll explode in taint mode. This is safe because
567 # we're not doing anything dangerous with it.
568 ($path) = $path =~ /(.*)/;
569 ($cwd) = $cwd =~ /(.*)/;
572 _croak("$path: No such file or directory");
576 # Make sure we can be invoked on plain files, not just directories.
578 my ($vol, $dir, $file) = File::Spec->splitpath($path);
579 return File::Spec->catfile($cwd, $path) unless length $dir;
582 my $link_target = readlink($path);
583 die "Can't resolve link $path: $!" unless defined $link_target;
585 $link_target = File::Spec->catpath($vol, $dir, $link_target)
586 unless File::Spec->file_name_is_absolute($link_target);
588 return fast_abs_path($link_target);
591 return $dir eq File::Spec->rootdir
592 ? File::Spec->catpath($vol, $dir, $file)
593 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
596 if (!CORE::chdir($path)) {
597 _croak("Cannot chdir to $path: $!");
599 my $realpath = getcwd();
600 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
601 _croak("Cannot chdir back to $cwd: $!");
606 # added function alias to follow principle of least surprise
607 # based on previous aliasing. --tchrist 27-Jan-00
608 *fast_realpath = \&fast_abs_path;
611 # --- PORTING SECTION ---
613 # VMS: $ENV{'DEFAULT'} points to default directory at all times
614 # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
615 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
616 # in the process logical name table as the default device and directory
617 # seen by Perl. This may not be the same as the default device
618 # and directory seen by DCL after Perl exits, since the effects
619 # the CRTL chdir() function persist only until Perl exits.
622 return $ENV{'DEFAULT'};
626 return $ENV{'DEFAULT'} unless @_;
628 # may need to turn foo.dir into [.foo]
629 my $path = VMS::Filespec::pathify($_[0]);
630 $path = $_[0] unless defined $path;
632 return VMS::Filespec::rmsexpand($path);
636 $ENV{'PWD'} = `cmd /c cd`;
638 $ENV{'PWD'} =~ s:\\:/:g ;
643 $ENV{'PWD'} = Win32::GetCwd();
644 $ENV{'PWD'} =~ s:\\:/:g ;
648 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
651 if (!defined &Dos::GetCwd) {
652 $ENV{'PWD'} = `command /c cd`;
654 $ENV{'PWD'} =~ s:\\:/:g ;
656 $ENV{'PWD'} = Dos::GetCwd();
662 local $ENV{PATH} = '';
663 local $ENV{CDPATH} = '';
664 local $ENV{ENV} = '';
665 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
671 local $ENV{PATH} = '';
672 local $ENV{CDPATH} = '';
673 local $ENV{ENV} = '';
674 my $path = @_ ? shift : '.';
677 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
678 die "Can't open /usr/bin/fullpath: $!";
679 my $realpath = <REALPATH>;
686 $ENV{'PWD'} = EPOC::getcwd();
691 # Now that all the base-level functions are set up, alias the
692 # user-level functions to the right places
694 if (exists $METHOD_MAP{$^O}) {
695 my $map = $METHOD_MAP{$^O};
696 foreach my $name (keys %$map) {
697 local $^W = 0; # assignments trigger 'subroutine redefined' warning
699 *{$name} = \&{$map->{$name}};
703 # In case the XS version doesn't load.
704 *abs_path = \&_perl_abs_path unless defined &abs_path;
706 # added function alias for those of us more
707 # used to the libc function. --tchrist 27-Jan-00
708 *realpath = \&abs_path;