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 my $os = $^O; # Protect $^O from tainting
334 if( $os eq 'MacOS' || (defined $ENV{PATH} &&
335 $os ne 'MSWin32' && # no pwd on Windows
336 grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
338 *cwd = \&_backtick_pwd;
345 # set a reasonable (and very safe) default for fastgetcwd, in case it
346 # isn't redefined later (20001212 rspier)
349 # By Brandon S. Allbery
351 # Usage: $cwd = getcwd();
361 # Usage: $cwd = &fastcwd;
363 # This is a faster version of getcwd. It's also more dangerous because
364 # you might chdir out of a directory that you can't chdir back into.
367 my($odev, $oino, $cdev, $cino, $tdev, $tino);
371 my($orig_cdev, $orig_cino) = stat('.');
372 ($cdev, $cino) = ($orig_cdev, $orig_cino);
375 ($odev, $oino) = ($cdev, $cino);
376 CORE::chdir('..') || return undef;
377 ($cdev, $cino) = stat('.');
378 last if $odev == $cdev && $oino == $cino;
379 opendir(DIR, '.') || return undef;
381 $direntry = readdir(DIR);
382 last unless defined $direntry;
383 next if $direntry eq '.';
384 next if $direntry eq '..';
386 ($tdev, $tino) = lstat($direntry);
387 last unless $tdev != $odev || $tino != $oino;
390 return undef unless defined $direntry; # should never happen
391 unshift(@path, $direntry);
393 $path = '/' . join('/', @path);
394 if ($^O eq 'apollo') { $path = "/".$path; }
395 # At this point $path may be tainted (if tainting) and chdir would fail.
396 # Untaint it then check that we landed where we started.
397 $path =~ /^(.*)\z/s # untaint
398 && CORE::chdir($1) or return undef;
399 ($cdev, $cino) = stat('.');
400 die "Unstable directory path, current directory changed unexpectedly"
401 if $cdev != $orig_cdev || $cino != $orig_cino;
404 if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
407 # Keeps track of current working directory in PWD environment var
415 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
416 my($dd,$di) = stat('.');
417 my($pd,$pi) = stat($ENV{'PWD'});
418 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
424 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
427 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
428 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
429 my($pd,$pi) = stat($2);
430 my($dd,$di) = stat($1);
431 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
439 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
440 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
441 chdir_init() unless $chdir_init;
443 if ($^O eq 'MSWin32') {
444 # get the full path name *before* the chdir()
445 $newpwd = Win32::GetFullPathName($newdir);
448 return 0 unless CORE::chdir $newdir;
451 return $ENV{'PWD'} = $ENV{'DEFAULT'}
453 elsif ($^O eq 'MacOS') {
454 return $ENV{'PWD'} = cwd();
456 elsif ($^O eq 'MSWin32') {
457 $ENV{'PWD'} = $newpwd;
461 if ($newdir =~ m#^/#s) {
462 $ENV{'PWD'} = $newdir;
464 my @curdir = split(m#/#,$ENV{'PWD'});
465 @curdir = ('') unless @curdir;
467 foreach $component (split(m#/#, $newdir)) {
468 next if $component eq '.';
469 pop(@curdir),next if $component eq '..';
470 push(@curdir,$component);
472 $ENV{'PWD'} = join('/',@curdir) || '/';
480 my $start = @_ ? shift : '.';
481 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
483 unless (@cst = stat( $start ))
485 _carp("stat($start): $!");
490 # Make sure we can be invoked on plain files, not just directories.
491 # NOTE that this routine assumes that '/' is the only directory separator.
493 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
494 or return cwd() . '/' . $start;
496 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
498 my $link_target = readlink($start);
499 die "Can't resolve link $start: $!" unless defined $link_target;
502 $link_target = $dir . '/' . $link_target
503 unless File::Spec->file_name_is_absolute($link_target);
505 return abs_path($link_target);
508 return $dir ? abs_path($dir) . "/$file" : "/$file";
518 unless (opendir(PARENT, $dotdots))
520 _carp("opendir($dotdots): $!");
523 unless (@cst = stat($dotdots))
525 _carp("stat($dotdots): $!");
529 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
537 unless (defined ($dir = readdir(PARENT)))
539 _carp("readdir($dotdots): $!");
543 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
545 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
548 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
550 } while (defined $dir);
551 chop($cwd) unless $cwd eq '/'; # drop the trailing /
558 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
561 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
563 # Detaint else we'll explode in taint mode. This is safe because
564 # we're not doing anything dangerous with it.
565 ($path) = $path =~ /(.*)/;
566 ($cwd) = $cwd =~ /(.*)/;
569 _croak("$path: No such file or directory");
573 # Make sure we can be invoked on plain files, not just directories.
575 my ($vol, $dir, $file) = File::Spec->splitpath($path);
576 return File::Spec->catfile($cwd, $path) unless length $dir;
579 my $link_target = readlink($path);
580 die "Can't resolve link $path: $!" unless defined $link_target;
582 $link_target = File::Spec->catpath($vol, $dir, $link_target)
583 unless File::Spec->file_name_is_absolute($link_target);
585 return fast_abs_path($link_target);
588 return $dir eq File::Spec->rootdir
589 ? File::Spec->catpath($vol, $dir, $file)
590 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
593 if (!CORE::chdir($path)) {
594 _croak("Cannot chdir to $path: $!");
596 my $realpath = getcwd();
597 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
598 _croak("Cannot chdir back to $cwd: $!");
603 # added function alias to follow principle of least surprise
604 # based on previous aliasing. --tchrist 27-Jan-00
605 *fast_realpath = \&fast_abs_path;
608 # --- PORTING SECTION ---
610 # VMS: $ENV{'DEFAULT'} points to default directory at all times
611 # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
612 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
613 # in the process logical name table as the default device and directory
614 # seen by Perl. This may not be the same as the default device
615 # and directory seen by DCL after Perl exits, since the effects
616 # the CRTL chdir() function persist only until Perl exits.
619 return $ENV{'DEFAULT'};
623 return $ENV{'DEFAULT'} unless @_;
625 # may need to turn foo.dir into [.foo]
626 my $path = VMS::Filespec::pathify($_[0]);
627 $path = $_[0] unless defined $path;
629 return VMS::Filespec::rmsexpand($path);
633 $ENV{'PWD'} = `cmd /c cd`;
635 $ENV{'PWD'} =~ s:\\:/:g ;
640 $ENV{'PWD'} = Win32::GetCwd();
641 $ENV{'PWD'} =~ s:\\:/:g ;
645 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
646 defined &Win32::GetCwd);
648 *_NT_cwd = \&_os2_cwd unless defined &_NT_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;