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