This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
More tests.
[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
4633a7c4 221# Keeps track of current working directory in PWD environment var
a0d0e21e
LW
222# Usage:
223# use Cwd 'chdir';
224# chdir $newdir;
225
4633a7c4 226my $chdir_init = 0;
a0d0e21e 227
4633a7c4 228sub chdir_init {
3b8e3443 229 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e
LW
230 my($dd,$di) = stat('.');
231 my($pd,$pi) = stat($ENV{'PWD'});
232 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4 233 $ENV{'PWD'} = cwd();
a0d0e21e
LW
234 }
235 }
236 else {
3b8e3443
GS
237 my $wd = cwd();
238 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
239 $ENV{'PWD'} = $wd;
a0d0e21e 240 }
4633a7c4 241 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443 242 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
a0d0e21e
LW
243 my($pd,$pi) = stat($2);
244 my($dd,$di) = stat($1);
245 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
246 $ENV{'PWD'}="$2$3";
247 }
248 }
249 $chdir_init = 1;
250}
251
252sub chdir {
22978713 253 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
3b8e3443 254 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
a0d0e21e 255 chdir_init() unless $chdir_init;
4ffa1610
JH
256 my $newpwd;
257 if ($^O eq 'MSWin32') {
258 # get the full path name *before* the chdir()
259 $newpwd = Win32::GetFullPathName($newdir);
260 }
261
4633a7c4 262 return 0 unless CORE::chdir $newdir;
4ffa1610 263
3b8e3443
GS
264 if ($^O eq 'VMS') {
265 return $ENV{'PWD'} = $ENV{'DEFAULT'}
266 }
4aecb5b5
JH
267 elsif ($^O eq 'MacOS') {
268 return $ENV{'PWD'} = cwd();
269 }
3b8e3443 270 elsif ($^O eq 'MSWin32') {
4ffa1610 271 $ENV{'PWD'} = $newpwd;
3b8e3443
GS
272 return 1;
273 }
748a9306 274
392d8ab8 275 if ($newdir =~ m#^/#s) {
a0d0e21e 276 $ENV{'PWD'} = $newdir;
4633a7c4
LW
277 } else {
278 my @curdir = split(m#/#,$ENV{'PWD'});
279 @curdir = ('') unless @curdir;
280 my $component;
a0d0e21e
LW
281 foreach $component (split(m#/#, $newdir)) {
282 next if $component eq '.';
283 pop(@curdir),next if $component eq '..';
284 push(@curdir,$component);
285 }
286 $ENV{'PWD'} = join('/',@curdir) || '/';
287 }
4633a7c4 288 1;
a0d0e21e
LW
289}
290
e4c51978
GS
291# added function alias for those of us more
292# used to the libc function. --tchrist 27-Jan-00
293*realpath = \&abs_path;
294
96e4d5b1
PP
295sub fast_abs_path {
296 my $cwd = getcwd();
4d6b4052
JH
297 require File::Spec;
298 my $path = @_ ? shift : File::Spec->curdir;
e79e61e4 299 CORE::chdir($path) || croak "Cannot chdir to $path:$!";
96e4d5b1 300 my $realpath = getcwd();
e79e61e4 301 CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
96e4d5b1 302 $realpath;
8b88ae92
NIS
303}
304
e4c51978
GS
305# added function alias to follow principle of least surprise
306# based on previous aliasing. --tchrist 27-Jan-00
307*fast_realpath = \&fast_abs_path;
308
4633a7c4
LW
309
310# --- PORTING SECTION ---
311
312# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c 313# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72 314# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92
NIS
315# in the process logical name table as the default device and directory
316# seen by Perl. This may not be the same as the default device
4633a7c4
LW
317# and directory seen by DCL after Perl exits, since the effects
318# the CRTL chdir() function persist only until Perl exits.
4633a7c4
LW
319
320sub _vms_cwd {
96e4d5b1
PP
321 return $ENV{'DEFAULT'};
322}
323
324sub _vms_abs_path {
325 return $ENV{'DEFAULT'} unless @_;
326 my $path = VMS::Filespec::pathify($_[0]);
327 croak("Invalid path name $_[0]") unless defined $path;
328 return VMS::Filespec::rmsexpand($path);
4633a7c4 329}
68dc0745 330
4633a7c4
LW
331sub _os2_cwd {
332 $ENV{'PWD'} = `cmd /c cd`;
333 chop $ENV{'PWD'};
334 $ENV{'PWD'} =~ s:\\:/:g ;
335 return $ENV{'PWD'};
336}
337
96e4d5b1 338sub _win32_cwd {
2d7a9237 339 $ENV{'PWD'} = Win32::GetCwd();
96e4d5b1
PP
340 $ENV{'PWD'} =~ s:\\:/:g ;
341 return $ENV{'PWD'};
342}
343
344*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237 345 defined &Win32::GetCwd);
96e4d5b1
PP
346
347*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745 348
39e571d4
ML
349sub _dos_cwd {
350 if (!defined &Dos::GetCwd) {
351 $ENV{'PWD'} = `command /c cd`;
352 chop $ENV{'PWD'};
353 $ENV{'PWD'} =~ s:\\:/:g ;
354 } else {
355 $ENV{'PWD'} = Dos::GetCwd();
356 }
55497cff
PP
357 return $ENV{'PWD'};
358}
359
7fbf1995
NA
360sub _qnx_cwd {
361 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
362 chop $ENV{'PWD'};
363 return $ENV{'PWD'};
364}
365
366sub _qnx_abs_path {
fa921dc6 367 my $path = @_ ? shift : '.';
7fbf1995
NA
368 my $realpath=`/usr/bin/fullpath -t $path`;
369 chop $realpath;
370 return $realpath;
371}
372
ed79a026
OF
373sub _epoc_cwd {
374 $ENV{'PWD'} = EPOC::getcwd();
375 return $ENV{'PWD'};
376}
377
ac1ad7f0 378{
db376a24 379 no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4 380
ac1ad7f0 381 if ($^O eq 'VMS') {
96e4d5b1
PP
382 *cwd = \&_vms_cwd;
383 *getcwd = \&_vms_cwd;
384 *fastcwd = \&_vms_cwd;
385 *fastgetcwd = \&_vms_cwd;
386 *abs_path = \&_vms_abs_path;
387 *fast_abs_path = \&_vms_abs_path;
ac1ad7f0
PM
388 }
389 elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
390 # We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1
PP
391 *cwd = \&_NT_cwd;
392 *getcwd = \&_NT_cwd;
393 *fastcwd = \&_NT_cwd;
394 *fastgetcwd = \&_NT_cwd;
395 *abs_path = \&fast_abs_path;
ac1ad7f0
PM
396 }
397 elsif ($^O eq 'os2') {
398 # sys_cwd may keep the builtin command
96e4d5b1
PP
399 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
400 *getcwd = \&cwd;
401 *fastgetcwd = \&cwd;
402 *fastcwd = \&cwd;
403 *abs_path = \&fast_abs_path;
ac1ad7f0 404 }
39e571d4
ML
405 elsif ($^O eq 'dos') {
406 *cwd = \&_dos_cwd;
407 *getcwd = \&_dos_cwd;
408 *fastgetcwd = \&_dos_cwd;
409 *fastcwd = \&_dos_cwd;
96e4d5b1 410 *abs_path = \&fast_abs_path;
ac1ad7f0 411 }
7438b6ad 412 elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
7fbf1995
NA
413 *cwd = \&_qnx_cwd;
414 *getcwd = \&_qnx_cwd;
415 *fastgetcwd = \&_qnx_cwd;
416 *fastcwd = \&_qnx_cwd;
417 *abs_path = \&_qnx_abs_path;
418 *fast_abs_path = \&_qnx_abs_path;
419 }
4fabb596 420 elsif ($^O eq 'cygwin') {
1cab015a
FE
421 *getcwd = \&cwd;
422 *fastgetcwd = \&cwd;
423 *fastcwd = \&cwd;
424 *abs_path = \&fast_abs_path;
425 }
ed79a026 426 elsif ($^O eq 'epoc') {
fa6a1c44
OF
427 *cwd = \&_epoc_cwd;
428 *getcwd = \&_epoc_cwd;
ed79a026
OF
429 *fastgetcwd = \&_epoc_cwd;
430 *fastcwd = \&_epoc_cwd;
431 *abs_path = \&fast_abs_path;
432 }
4aecb5b5
JH
433 elsif ($^O eq 'MacOS') {
434 *getcwd = \&cwd;
435 *fastgetcwd = \&cwd;
436 *fastcwd = \&cwd;
437 *abs_path = \&fast_abs_path;
438 }
55497cff 439}
4633a7c4
LW
440
441# package main; eval join('',<DATA>) || die $@; # quick test
442
a0d0e21e
LW
4431;
444
4633a7c4
LW
445__END__
446BEGIN { import Cwd qw(:DEFAULT chdir); }
447print join("\n", cwd, getcwd, fastcwd, "");
448chdir('..');
449print join("\n", cwd, getcwd, fastcwd, "");
450print "$ENV{PWD}\n";