This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test that [] // 0 is []
[perl5.git] / lib / Cwd.pm
CommitLineData
a0d0e21e 1package Cwd;
ea067225 2$VERSION = $VERSION = '2.17';
a0d0e21e 3
f06db76b
AD
4=head1 NAME
5
902bacac 6Cwd - get pathname of current working directory
f06db76b
AD
7
8=head1 SYNOPSIS
9
4633a7c4 10 use Cwd;
04929354 11 my $dir = getcwd;
4633a7c4 12
04929354
MS
13 use Cwd 'abs_path';
14 my $abs_path = abs_path($file);
f06db76b 15
04929354 16=head1 DESCRIPTION
902bacac 17
04929354
MS
18This module provides functions for determining the pathname of the
19current working directory. It is recommended that getcwd (or another
20*cwd() function) be used in I<all> code to ensure portability.
f06db76b 21
04929354
MS
22By default, it exports the functions cwd(), getcwd(), fastcwd(), and
23fastgetcwd() into the caller's namespace.
f06db76b 24
20408e3c 25
04929354 26=head2 getcwd and friends
20408e3c 27
04929354
MS
28Each of these functions are called without arguments and return the
29absolute path of the current working directory.
f06db76b 30
04929354
MS
31=over 4
32
33=item getcwd
34
35 my $cwd = getcwd();
36
37Returns the current working directory.
38
39Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
40
41=item cwd
42
43 my $cwd = cwd();
44
45The cwd() is the most natural form for the current architecture. For
46most systems it is identical to `pwd` (but without the trailing line
47terminator).
48
04929354
MS
49=item fastcwd
50
51 my $cwd = fastcwd();
52
53A more dangerous version of getcwd(), but potentially faster.
54
55It might conceivably chdir() you out of a directory that it can't
56chdir() you back into. If fastcwd encounters a problem it will return
57undef but will probably leave you in a different directory. For a
58measure of extra security, if everything appears to have worked, the
59fastcwd() function will check that it leaves you in the same directory
60that it started in. If it has changed it will C<die> with the message
61"Unstable directory path, current directory changed
62unexpectedly". That should never happen.
63
64=item fastgetcwd
65
66 my $cwd = fastgetcwd();
f06db76b 67
902bacac 68The fastgetcwd() function is provided as a synonym for cwd().
fb73857a 69
04929354
MS
70=back
71
902bacac 72
04929354
MS
73=head2 abs_path and friends
74
75These functions are exported only on request. They each take a single
3ee63918
MS
76argument and return the absolute pathname for it. If no argument is
77given they'll use the current working directory.
04929354
MS
78
79=over 4
80
81=item abs_path
82
83 my $abs_path = abs_path($file);
84
85Uses the same algorithm as getcwd(). Symbolic links and relative-path
86components ("." and "..") are resolved to return the canonical
87pathname, just like realpath(3).
88
89=item realpath
90
91 my $abs_path = realpath($file);
92
93A synonym for abs_path().
94
95=item fast_abs_path
96
510179aa 97 my $abs_path = fast_abs_path($file);
04929354
MS
98
99A more dangerous, but potentially faster version of abs_path.
100
101=back
102
103=head2 $ENV{PWD}
104
105If you ask to override your chdir() built-in function,
106
107 use Cwd qw(chdir);
108
109then your PWD environment variable will be kept up to date. Note that
110it will only be kept up to date if all packages which use chdir import
111it from Cwd.
4633a7c4 112
4633a7c4 113
4d6b4052
JH
114=head1 NOTES
115
116=over 4
117
118=item *
119
04929354
MS
120Since the path seperators are different on some operating systems ('/'
121on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
122modules wherever portability is a concern.
123
04929354 124=item *
4d6b4052
JH
125
126Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
127functions are all aliases for the C<cwd()> function, which, on Mac OS,
128calls `pwd`. Likewise, the C<abs_path()> function is an alias for
129C<fast_abs_path()>.
130
131=back
132
02cc4877
NC
133=head1 AUTHOR
134
135Originally by the perl5-porters.
136
137Now maintained by Ken Williams <KWILLIAMS@cpan.org>
138
04929354
MS
139=head1 SEE ALSO
140
141L<File::chdir>
142
f06db76b
AD
143=cut
144
b060a406 145use strict;
a9939470 146use Exporter;
ad78113d 147use vars qw(@ISA @EXPORT @EXPORT_OK);
96e4d5b1 148
a9939470
NC
149@ISA = qw/ Exporter /;
150@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
151@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
a0d0e21e 152
f5f423e4
IZ
153# sys_cwd may keep the builtin command
154
155# All the functionality of this module may provided by builtins,
156# there is no sense to process the rest of the file.
157# The best choice may be to have this in BEGIN, but how to return from BEGIN?
158
a9939470 159if ($^O eq 'os2') {
f5f423e4 160 local $^W = 0;
a9939470
NC
161
162 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
163 *getcwd = \&cwd;
164 *fastgetcwd = \&cwd;
165 *fastcwd = \&cwd;
166
167 *fast_abs_path = \&sys_abspath if defined &sys_abspath;
168 *abs_path = \&fast_abs_path;
169 *realpath = \&fast_abs_path;
170 *fast_realpath = \&fast_abs_path;
171
f5f423e4
IZ
172 return 1;
173}
174
f22d8e4b
DM
175eval {
176 require XSLoader;
46ba3155 177 local $^W = 0;
f22d8e4b
DM
178 XSLoader::load('Cwd');
179};
4633a7c4 180
96e4d5b1 181
3547aa9a
MS
182# Find the pwd command in the expected locations. We assume these
183# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
184# so everything works under taint mode.
185my $pwd_cmd;
889f7a4f
RGS
186foreach my $try ('/bin/pwd',
187 '/usr/bin/pwd',
188 '/QOpenSys/bin/pwd', # OS/400 PASE.
189 ) {
190
3547aa9a
MS
191 if( -x $try ) {
192 $pwd_cmd = $try;
193 last;
194 }
195}
522b859a 196unless ($pwd_cmd) {
889f7a4f
RGS
197 # Isn't this wrong? _backtick_pwd() will fail if somenone has
198 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
199 # See [perl #16774]. --jhi
200 $pwd_cmd = 'pwd';
522b859a 201}
3547aa9a 202
a9939470
NC
203# Lazy-load Carp
204sub _carp { require Carp; Carp::carp(@_) }
205sub _croak { require Carp; Carp::croak(@_) }
206
3547aa9a 207# The 'natural and safe form' for UNIX (pwd may be setuid root)
8b88ae92 208sub _backtick_pwd {
db281859 209 local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
3547aa9a 210 my $cwd = `$pwd_cmd`;
ac3b20cb 211 # Belt-and-suspenders in case someone said "undef $/".
5cf6da5f 212 local $/ = "\n";
ac3b20cb 213 # `pwd` may fail e.g. if the disk is full
7e03f963 214 chomp($cwd) if defined $cwd;
4633a7c4 215 $cwd;
8b88ae92 216}
4633a7c4
LW
217
218# Since some ports may predefine cwd internally (e.g., NT)
219# we take care not to override an existing definition for cwd().
220
ea54c8bd
EC
221unless(defined &cwd) {
222 # The pwd command is not available in some chroot(2)'ed environments
73b801a6
MS
223 if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
224 grep { -x "$_/pwd" } split(':', $ENV{PATH})) )
225 {
ea54c8bd
EC
226 *cwd = \&_backtick_pwd;
227 }
228 else {
229 *cwd = \&getcwd;
230 }
231}
a0d0e21e 232
1f4f94f5
RS
233# set a reasonable (and very safe) default for fastgetcwd, in case it
234# isn't redefined later (20001212 rspier)
235*fastgetcwd = \&cwd;
748a9306 236
a0d0e21e
LW
237# By Brandon S. Allbery
238#
239# Usage: $cwd = getcwd();
240
241sub getcwd
242{
07569ed3 243 abs_path('.');
a0d0e21e
LW
244}
245
a0c9c202
JH
246
247# By John Bazik
248#
249# Usage: $cwd = &fastcwd;
250#
251# This is a faster version of getcwd. It's also more dangerous because
252# you might chdir out of a directory that you can't chdir back into.
253
254sub fastcwd {
255 my($odev, $oino, $cdev, $cino, $tdev, $tino);
256 my(@path, $path);
257 local(*DIR);
258
259 my($orig_cdev, $orig_cino) = stat('.');
260 ($cdev, $cino) = ($orig_cdev, $orig_cino);
261 for (;;) {
262 my $direntry;
263 ($odev, $oino) = ($cdev, $cino);
264 CORE::chdir('..') || return undef;
265 ($cdev, $cino) = stat('.');
266 last if $odev == $cdev && $oino == $cino;
267 opendir(DIR, '.') || return undef;
268 for (;;) {
269 $direntry = readdir(DIR);
270 last unless defined $direntry;
271 next if $direntry eq '.';
272 next if $direntry eq '..';
273
274 ($tdev, $tino) = lstat($direntry);
275 last unless $tdev != $odev || $tino != $oino;
276 }
277 closedir(DIR);
278 return undef unless defined $direntry; # should never happen
279 unshift(@path, $direntry);
280 }
281 $path = '/' . join('/', @path);
282 if ($^O eq 'apollo') { $path = "/".$path; }
283 # At this point $path may be tainted (if tainting) and chdir would fail.
248785eb
RGS
284 # Untaint it then check that we landed where we started.
285 $path =~ /^(.*)\z/s # untaint
286 && CORE::chdir($1) or return undef;
a0c9c202
JH
287 ($cdev, $cino) = stat('.');
288 die "Unstable directory path, current directory changed unexpectedly"
289 if $cdev != $orig_cdev || $cino != $orig_cino;
290 $path;
291}
292
293
4633a7c4 294# Keeps track of current working directory in PWD environment var
a0d0e21e
LW
295# Usage:
296# use Cwd 'chdir';
297# chdir $newdir;
298
4633a7c4 299my $chdir_init = 0;
a0d0e21e 300
4633a7c4 301sub chdir_init {
3b8e3443 302 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e
LW
303 my($dd,$di) = stat('.');
304 my($pd,$pi) = stat($ENV{'PWD'});
305 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4 306 $ENV{'PWD'} = cwd();
a0d0e21e
LW
307 }
308 }
309 else {
3b8e3443
GS
310 my $wd = cwd();
311 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
312 $ENV{'PWD'} = $wd;
a0d0e21e 313 }
4633a7c4 314 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443 315 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
a0d0e21e
LW
316 my($pd,$pi) = stat($2);
317 my($dd,$di) = stat($1);
318 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
319 $ENV{'PWD'}="$2$3";
320 }
321 }
322 $chdir_init = 1;
323}
324
325sub chdir {
22978713 326 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
3b8e3443 327 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
a0d0e21e 328 chdir_init() unless $chdir_init;
4ffa1610
JH
329 my $newpwd;
330 if ($^O eq 'MSWin32') {
331 # get the full path name *before* the chdir()
332 $newpwd = Win32::GetFullPathName($newdir);
333 }
334
4633a7c4 335 return 0 unless CORE::chdir $newdir;
4ffa1610 336
3b8e3443
GS
337 if ($^O eq 'VMS') {
338 return $ENV{'PWD'} = $ENV{'DEFAULT'}
339 }
4aecb5b5
JH
340 elsif ($^O eq 'MacOS') {
341 return $ENV{'PWD'} = cwd();
342 }
3b8e3443 343 elsif ($^O eq 'MSWin32') {
4ffa1610 344 $ENV{'PWD'} = $newpwd;
3b8e3443
GS
345 return 1;
346 }
748a9306 347
392d8ab8 348 if ($newdir =~ m#^/#s) {
a0d0e21e 349 $ENV{'PWD'} = $newdir;
4633a7c4
LW
350 } else {
351 my @curdir = split(m#/#,$ENV{'PWD'});
352 @curdir = ('') unless @curdir;
353 my $component;
a0d0e21e
LW
354 foreach $component (split(m#/#, $newdir)) {
355 next if $component eq '.';
356 pop(@curdir),next if $component eq '..';
357 push(@curdir,$component);
358 }
359 $ENV{'PWD'} = join('/',@curdir) || '/';
360 }
4633a7c4 361 1;
a0d0e21e
LW
362}
363
a0c9c202
JH
364
365# In case the XS version doesn't load.
366*abs_path = \&_perl_abs_path unless defined &abs_path;
367sub _perl_abs_path
368{
369 my $start = @_ ? shift : '.';
370 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
371
372 unless (@cst = stat( $start ))
373 {
a9939470 374 _carp("stat($start): $!");
a0c9c202
JH
375 return '';
376 }
377 $cwd = '';
378 $dotdots = $start;
379 do
380 {
381 $dotdots .= '/..';
382 @pst = @cst;
a25ef67d 383 local *PARENT;
a0c9c202
JH
384 unless (opendir(PARENT, $dotdots))
385 {
a9939470 386 _carp("opendir($dotdots): $!");
a0c9c202
JH
387 return '';
388 }
389 unless (@cst = stat($dotdots))
390 {
a9939470 391 _carp("stat($dotdots): $!");
a0c9c202
JH
392 closedir(PARENT);
393 return '';
394 }
395 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
396 {
397 $dir = undef;
398 }
399 else
400 {
401 do
402 {
403 unless (defined ($dir = readdir(PARENT)))
404 {
a9939470 405 _carp("readdir($dotdots): $!");
a0c9c202
JH
406 closedir(PARENT);
407 return '';
408 }
409 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
410 }
411 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
412 $tst[1] != $pst[1]);
413 }
414 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
415 closedir(PARENT);
416 } while (defined $dir);
417 chop($cwd) unless $cwd eq '/'; # drop the trailing /
418 $cwd;
419}
420
421
e4c51978
GS
422# added function alias for those of us more
423# used to the libc function. --tchrist 27-Jan-00
424*realpath = \&abs_path;
425
3ee63918 426my $Curdir;
96e4d5b1
PP
427sub fast_abs_path {
428 my $cwd = getcwd();
4d6b4052 429 require File::Spec;
3ee63918
MS
430 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
431
432 # Detaint else we'll explode in taint mode. This is safe because
433 # we're not doing anything dangerous with it.
434 ($path) = $path =~ /(.*)/;
435 ($cwd) = $cwd =~ /(.*)/;
436
e2ba406b 437 if (!CORE::chdir($path)) {
a9939470 438 _croak("Cannot chdir to $path: $!");
e2ba406b 439 }
96e4d5b1 440 my $realpath = getcwd();
e2ba406b 441 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
a9939470 442 _croak("Cannot chdir back to $cwd: $!");
e2ba406b 443 }
96e4d5b1 444 $realpath;
8b88ae92
NIS
445}
446
e4c51978
GS
447# added function alias to follow principle of least surprise
448# based on previous aliasing. --tchrist 27-Jan-00
449*fast_realpath = \&fast_abs_path;
450
4633a7c4
LW
451
452# --- PORTING SECTION ---
453
454# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c 455# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72 456# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92
NIS
457# in the process logical name table as the default device and directory
458# seen by Perl. This may not be the same as the default device
4633a7c4
LW
459# and directory seen by DCL after Perl exits, since the effects
460# the CRTL chdir() function persist only until Perl exits.
4633a7c4
LW
461
462sub _vms_cwd {
96e4d5b1
PP
463 return $ENV{'DEFAULT'};
464}
465
466sub _vms_abs_path {
467 return $ENV{'DEFAULT'} unless @_;
468 my $path = VMS::Filespec::pathify($_[0]);
e2ba406b
T
469 if (! defined $path)
470 {
a9939470 471 _croak("Invalid path name $_[0]")
e2ba406b 472 }
96e4d5b1 473 return VMS::Filespec::rmsexpand($path);
4633a7c4 474}
68dc0745 475
4633a7c4
LW
476sub _os2_cwd {
477 $ENV{'PWD'} = `cmd /c cd`;
39741d73 478 chomp $ENV{'PWD'};
aa6b7957 479 $ENV{'PWD'} =~ s:\\:/:g ;
4633a7c4
LW
480 return $ENV{'PWD'};
481}
482
96e4d5b1 483sub _win32_cwd {
2d7a9237 484 $ENV{'PWD'} = Win32::GetCwd();
aa6b7957 485 $ENV{'PWD'} =~ s:\\:/:g ;
96e4d5b1
PP
486 return $ENV{'PWD'};
487}
488
489*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237 490 defined &Win32::GetCwd);
96e4d5b1
PP
491
492*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745 493
39e571d4
ML
494sub _dos_cwd {
495 if (!defined &Dos::GetCwd) {
496 $ENV{'PWD'} = `command /c cd`;
39741d73 497 chomp $ENV{'PWD'};
aa6b7957 498 $ENV{'PWD'} =~ s:\\:/:g ;
39e571d4
ML
499 } else {
500 $ENV{'PWD'} = Dos::GetCwd();
501 }
55497cff
PP
502 return $ENV{'PWD'};
503}
504
7fbf1995 505sub _qnx_cwd {
35b807ef
NA
506 local $ENV{PATH} = '';
507 local $ENV{CDPATH} = '';
508 local $ENV{ENV} = '';
7fbf1995 509 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
39741d73 510 chomp $ENV{'PWD'};
7fbf1995
NA
511 return $ENV{'PWD'};
512}
513
514sub _qnx_abs_path {
35b807ef
NA
515 local $ENV{PATH} = '';
516 local $ENV{CDPATH} = '';
517 local $ENV{ENV} = '';
fa921dc6 518 my $path = @_ ? shift : '.';
39741d73
MS
519 local *REALPATH;
520
521 open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or
522 die "Can't open /usr/bin/fullpath: $!";
523 my $realpath = <REALPATH>;
524 close REALPATH;
525 chomp $realpath;
7fbf1995
NA
526 return $realpath;
527}
528
ed79a026
OF
529sub _epoc_cwd {
530 $ENV{'PWD'} = EPOC::getcwd();
531 return $ENV{'PWD'};
532}
533
ac1ad7f0 534{
db376a24 535 no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4 536
ac1ad7f0 537 if ($^O eq 'VMS') {
96e4d5b1
PP
538 *cwd = \&_vms_cwd;
539 *getcwd = \&_vms_cwd;
540 *fastcwd = \&_vms_cwd;
541 *fastgetcwd = \&_vms_cwd;
542 *abs_path = \&_vms_abs_path;
543 *fast_abs_path = \&_vms_abs_path;
ac1ad7f0
PM
544 }
545 elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
546 # We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1
PP
547 *cwd = \&_NT_cwd;
548 *getcwd = \&_NT_cwd;
549 *fastcwd = \&_NT_cwd;
550 *fastgetcwd = \&_NT_cwd;
551 *abs_path = \&fast_abs_path;
cade0c02 552 *realpath = \&fast_abs_path;
ac1ad7f0 553 }
39e571d4
ML
554 elsif ($^O eq 'dos') {
555 *cwd = \&_dos_cwd;
556 *getcwd = \&_dos_cwd;
557 *fastgetcwd = \&_dos_cwd;
558 *fastcwd = \&_dos_cwd;
96e4d5b1 559 *abs_path = \&fast_abs_path;
ac1ad7f0 560 }
7438b6ad 561 elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
7fbf1995
NA
562 *cwd = \&_qnx_cwd;
563 *getcwd = \&_qnx_cwd;
564 *fastgetcwd = \&_qnx_cwd;
565 *fastcwd = \&_qnx_cwd;
566 *abs_path = \&_qnx_abs_path;
567 *fast_abs_path = \&_qnx_abs_path;
568 }
4fabb596 569 elsif ($^O eq 'cygwin') {
1cab015a
FE
570 *getcwd = \&cwd;
571 *fastgetcwd = \&cwd;
572 *fastcwd = \&cwd;
573 *abs_path = \&fast_abs_path;
a9939470 574 *realpath = \&abs_path;
1cab015a 575 }
ed79a026 576 elsif ($^O eq 'epoc') {
fa6a1c44
OF
577 *cwd = \&_epoc_cwd;
578 *getcwd = \&_epoc_cwd;
ed79a026
OF
579 *fastgetcwd = \&_epoc_cwd;
580 *fastcwd = \&_epoc_cwd;
581 *abs_path = \&fast_abs_path;
582 }
4aecb5b5
JH
583 elsif ($^O eq 'MacOS') {
584 *getcwd = \&cwd;
585 *fastgetcwd = \&cwd;
586 *fastcwd = \&cwd;
587 *abs_path = \&fast_abs_path;
588 }
55497cff 589}
4633a7c4 590
4633a7c4 591
a0d0e21e 5921;