This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re-introduce pure-Perl fall-back for abs_path,
[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;
171 XSLoader::load('Cwd');
172};
4633a7c4 173
96e4d5b1 174
3547aa9a
MS
175# Find the pwd command in the expected locations. We assume these
176# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
177# so everything works under taint mode.
178my $pwd_cmd;
179foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
180 if( -x $try ) {
181 $pwd_cmd = $try;
182 last;
183 }
184}
185$pwd_cmd ||= 'pwd';
186
187# The 'natural and safe form' for UNIX (pwd may be setuid root)
8b88ae92 188sub _backtick_pwd {
3547aa9a 189 my $cwd = `$pwd_cmd`;
7e03f963
TJ
190 # `pwd` may fail e.g. if the disk is full
191 chomp($cwd) if defined $cwd;
4633a7c4 192 $cwd;
8b88ae92 193}
4633a7c4
LW
194
195# Since some ports may predefine cwd internally (e.g., NT)
196# we take care not to override an existing definition for cwd().
197
ea54c8bd
EC
198unless(defined &cwd) {
199 # The pwd command is not available in some chroot(2)'ed environments
4aecb5b5 200 if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
ea54c8bd
EC
201 *cwd = \&_backtick_pwd;
202 }
203 else {
204 *cwd = \&getcwd;
205 }
206}
a0d0e21e 207
1f4f94f5
RS
208# set a reasonable (and very safe) default for fastgetcwd, in case it
209# isn't redefined later (20001212 rspier)
210*fastgetcwd = \&cwd;
748a9306 211
a0d0e21e
LW
212# By Brandon S. Allbery
213#
214# Usage: $cwd = getcwd();
215
216sub getcwd
217{
07569ed3 218 abs_path('.');
a0d0e21e
LW
219}
220
a0c9c202
JH
221
222# By John Bazik
223#
224# Usage: $cwd = &fastcwd;
225#
226# This is a faster version of getcwd. It's also more dangerous because
227# you might chdir out of a directory that you can't chdir back into.
228
229sub fastcwd {
230 my($odev, $oino, $cdev, $cino, $tdev, $tino);
231 my(@path, $path);
232 local(*DIR);
233
234 my($orig_cdev, $orig_cino) = stat('.');
235 ($cdev, $cino) = ($orig_cdev, $orig_cino);
236 for (;;) {
237 my $direntry;
238 ($odev, $oino) = ($cdev, $cino);
239 CORE::chdir('..') || return undef;
240 ($cdev, $cino) = stat('.');
241 last if $odev == $cdev && $oino == $cino;
242 opendir(DIR, '.') || return undef;
243 for (;;) {
244 $direntry = readdir(DIR);
245 last unless defined $direntry;
246 next if $direntry eq '.';
247 next if $direntry eq '..';
248
249 ($tdev, $tino) = lstat($direntry);
250 last unless $tdev != $odev || $tino != $oino;
251 }
252 closedir(DIR);
253 return undef unless defined $direntry; # should never happen
254 unshift(@path, $direntry);
255 }
256 $path = '/' . join('/', @path);
257 if ($^O eq 'apollo') { $path = "/".$path; }
258 # At this point $path may be tainted (if tainting) and chdir would fail.
259 # To be more useful we untaint it then check that we landed where we started.
260 $path = $1 if $path =~ /^(.*)\z/s; # untaint
261 CORE::chdir($path) || return undef;
262 ($cdev, $cino) = stat('.');
263 die "Unstable directory path, current directory changed unexpectedly"
264 if $cdev != $orig_cdev || $cino != $orig_cino;
265 $path;
266}
267
268
4633a7c4 269# Keeps track of current working directory in PWD environment var
a0d0e21e
LW
270# Usage:
271# use Cwd 'chdir';
272# chdir $newdir;
273
4633a7c4 274my $chdir_init = 0;
a0d0e21e 275
4633a7c4 276sub chdir_init {
3b8e3443 277 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e
LW
278 my($dd,$di) = stat('.');
279 my($pd,$pi) = stat($ENV{'PWD'});
280 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4 281 $ENV{'PWD'} = cwd();
a0d0e21e
LW
282 }
283 }
284 else {
3b8e3443
GS
285 my $wd = cwd();
286 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
287 $ENV{'PWD'} = $wd;
a0d0e21e 288 }
4633a7c4 289 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443 290 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
a0d0e21e
LW
291 my($pd,$pi) = stat($2);
292 my($dd,$di) = stat($1);
293 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
294 $ENV{'PWD'}="$2$3";
295 }
296 }
297 $chdir_init = 1;
298}
299
300sub chdir {
22978713 301 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
3b8e3443 302 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
a0d0e21e 303 chdir_init() unless $chdir_init;
4ffa1610
JH
304 my $newpwd;
305 if ($^O eq 'MSWin32') {
306 # get the full path name *before* the chdir()
307 $newpwd = Win32::GetFullPathName($newdir);
308 }
309
4633a7c4 310 return 0 unless CORE::chdir $newdir;
4ffa1610 311
3b8e3443
GS
312 if ($^O eq 'VMS') {
313 return $ENV{'PWD'} = $ENV{'DEFAULT'}
314 }
4aecb5b5
JH
315 elsif ($^O eq 'MacOS') {
316 return $ENV{'PWD'} = cwd();
317 }
3b8e3443 318 elsif ($^O eq 'MSWin32') {
4ffa1610 319 $ENV{'PWD'} = $newpwd;
3b8e3443
GS
320 return 1;
321 }
748a9306 322
392d8ab8 323 if ($newdir =~ m#^/#s) {
a0d0e21e 324 $ENV{'PWD'} = $newdir;
4633a7c4
LW
325 } else {
326 my @curdir = split(m#/#,$ENV{'PWD'});
327 @curdir = ('') unless @curdir;
328 my $component;
a0d0e21e
LW
329 foreach $component (split(m#/#, $newdir)) {
330 next if $component eq '.';
331 pop(@curdir),next if $component eq '..';
332 push(@curdir,$component);
333 }
334 $ENV{'PWD'} = join('/',@curdir) || '/';
335 }
4633a7c4 336 1;
a0d0e21e
LW
337}
338
a0c9c202
JH
339
340# In case the XS version doesn't load.
341*abs_path = \&_perl_abs_path unless defined &abs_path;
342sub _perl_abs_path
343{
344 my $start = @_ ? shift : '.';
345 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
346
347 unless (@cst = stat( $start ))
348 {
349 carp "stat($start): $!";
350 return '';
351 }
352 $cwd = '';
353 $dotdots = $start;
354 do
355 {
356 $dotdots .= '/..';
357 @pst = @cst;
358 unless (opendir(PARENT, $dotdots))
359 {
360 carp "opendir($dotdots): $!";
361 return '';
362 }
363 unless (@cst = stat($dotdots))
364 {
365 carp "stat($dotdots): $!";
366 closedir(PARENT);
367 return '';
368 }
369 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
370 {
371 $dir = undef;
372 }
373 else
374 {
375 do
376 {
377 unless (defined ($dir = readdir(PARENT)))
378 {
379 carp "readdir($dotdots): $!";
380 closedir(PARENT);
381 return '';
382 }
383 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
384 }
385 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
386 $tst[1] != $pst[1]);
387 }
388 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
389 closedir(PARENT);
390 } while (defined $dir);
391 chop($cwd) unless $cwd eq '/'; # drop the trailing /
392 $cwd;
393}
394
395
e4c51978
GS
396# added function alias for those of us more
397# used to the libc function. --tchrist 27-Jan-00
398*realpath = \&abs_path;
399
96e4d5b1
PP
400sub fast_abs_path {
401 my $cwd = getcwd();
4d6b4052
JH
402 require File::Spec;
403 my $path = @_ ? shift : File::Spec->curdir;
e79e61e4 404 CORE::chdir($path) || croak "Cannot chdir to $path:$!";
96e4d5b1 405 my $realpath = getcwd();
e79e61e4 406 CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
96e4d5b1 407 $realpath;
8b88ae92
NIS
408}
409
e4c51978
GS
410# added function alias to follow principle of least surprise
411# based on previous aliasing. --tchrist 27-Jan-00
412*fast_realpath = \&fast_abs_path;
413
4633a7c4
LW
414
415# --- PORTING SECTION ---
416
417# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c 418# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72 419# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92
NIS
420# in the process logical name table as the default device and directory
421# seen by Perl. This may not be the same as the default device
4633a7c4
LW
422# and directory seen by DCL after Perl exits, since the effects
423# the CRTL chdir() function persist only until Perl exits.
4633a7c4
LW
424
425sub _vms_cwd {
96e4d5b1
PP
426 return $ENV{'DEFAULT'};
427}
428
429sub _vms_abs_path {
430 return $ENV{'DEFAULT'} unless @_;
431 my $path = VMS::Filespec::pathify($_[0]);
432 croak("Invalid path name $_[0]") unless defined $path;
433 return VMS::Filespec::rmsexpand($path);
4633a7c4 434}
68dc0745 435
4633a7c4
LW
436sub _os2_cwd {
437 $ENV{'PWD'} = `cmd /c cd`;
438 chop $ENV{'PWD'};
439 $ENV{'PWD'} =~ s:\\:/:g ;
440 return $ENV{'PWD'};
441}
442
96e4d5b1 443sub _win32_cwd {
2d7a9237 444 $ENV{'PWD'} = Win32::GetCwd();
96e4d5b1
PP
445 $ENV{'PWD'} =~ s:\\:/:g ;
446 return $ENV{'PWD'};
447}
448
449*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237 450 defined &Win32::GetCwd);
96e4d5b1
PP
451
452*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745 453
39e571d4
ML
454sub _dos_cwd {
455 if (!defined &Dos::GetCwd) {
456 $ENV{'PWD'} = `command /c cd`;
457 chop $ENV{'PWD'};
458 $ENV{'PWD'} =~ s:\\:/:g ;
459 } else {
460 $ENV{'PWD'} = Dos::GetCwd();
461 }
55497cff
PP
462 return $ENV{'PWD'};
463}
464
7fbf1995
NA
465sub _qnx_cwd {
466 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
467 chop $ENV{'PWD'};
468 return $ENV{'PWD'};
469}
470
471sub _qnx_abs_path {
fa921dc6 472 my $path = @_ ? shift : '.';
7fbf1995
NA
473 my $realpath=`/usr/bin/fullpath -t $path`;
474 chop $realpath;
475 return $realpath;
476}
477
ed79a026
OF
478sub _epoc_cwd {
479 $ENV{'PWD'} = EPOC::getcwd();
480 return $ENV{'PWD'};
481}
482
ac1ad7f0 483{
db376a24 484 no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4 485
ac1ad7f0 486 if ($^O eq 'VMS') {
96e4d5b1
PP
487 *cwd = \&_vms_cwd;
488 *getcwd = \&_vms_cwd;
489 *fastcwd = \&_vms_cwd;
490 *fastgetcwd = \&_vms_cwd;
491 *abs_path = \&_vms_abs_path;
492 *fast_abs_path = \&_vms_abs_path;
ac1ad7f0
PM
493 }
494 elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
495 # We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1
PP
496 *cwd = \&_NT_cwd;
497 *getcwd = \&_NT_cwd;
498 *fastcwd = \&_NT_cwd;
499 *fastgetcwd = \&_NT_cwd;
500 *abs_path = \&fast_abs_path;
ac1ad7f0
PM
501 }
502 elsif ($^O eq 'os2') {
503 # sys_cwd may keep the builtin command
96e4d5b1
PP
504 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
505 *getcwd = \&cwd;
506 *fastgetcwd = \&cwd;
507 *fastcwd = \&cwd;
508 *abs_path = \&fast_abs_path;
ac1ad7f0 509 }
39e571d4
ML
510 elsif ($^O eq 'dos') {
511 *cwd = \&_dos_cwd;
512 *getcwd = \&_dos_cwd;
513 *fastgetcwd = \&_dos_cwd;
514 *fastcwd = \&_dos_cwd;
96e4d5b1 515 *abs_path = \&fast_abs_path;
ac1ad7f0 516 }
7438b6ad 517 elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
7fbf1995
NA
518 *cwd = \&_qnx_cwd;
519 *getcwd = \&_qnx_cwd;
520 *fastgetcwd = \&_qnx_cwd;
521 *fastcwd = \&_qnx_cwd;
522 *abs_path = \&_qnx_abs_path;
523 *fast_abs_path = \&_qnx_abs_path;
524 }
4fabb596 525 elsif ($^O eq 'cygwin') {
1cab015a
FE
526 *getcwd = \&cwd;
527 *fastgetcwd = \&cwd;
528 *fastcwd = \&cwd;
529 *abs_path = \&fast_abs_path;
530 }
ed79a026 531 elsif ($^O eq 'epoc') {
fa6a1c44
OF
532 *cwd = \&_epoc_cwd;
533 *getcwd = \&_epoc_cwd;
ed79a026
OF
534 *fastgetcwd = \&_epoc_cwd;
535 *fastcwd = \&_epoc_cwd;
536 *abs_path = \&fast_abs_path;
537 }
4aecb5b5
JH
538 elsif ($^O eq 'MacOS') {
539 *getcwd = \&cwd;
540 *fastgetcwd = \&cwd;
541 *fastcwd = \&cwd;
542 *abs_path = \&fast_abs_path;
543 }
55497cff 544}
4633a7c4 545
4633a7c4 546
a0d0e21e 5471;