This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate eliminate_macros and fixpath.
[perl5.git] / dist / PathTools / Cwd.pm
CommitLineData
a0d0e21e 1package Cwd;
b060a406 2use strict;
a9939470 3use Exporter;
99f36a73
RGS
4use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
5
0a660800 6$VERSION = '3.54';
4a4ab19c 7my $xs_version = $VERSION;
3d2a0adf 8$VERSION =~ tr/_//;
96e4d5b1 9
a9939470
NC
10@ISA = qw/ Exporter /;
11@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
09122b95 12push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
a9939470 13@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
a0d0e21e 14
f5f423e4
IZ
15# sys_cwd may keep the builtin command
16
17# All the functionality of this module may provided by builtins,
18# there is no sense to process the rest of the file.
19# The best choice may be to have this in BEGIN, but how to return from BEGIN?
20
a9939470 21if ($^O eq 'os2') {
f5f423e4 22 local $^W = 0;
a9939470
NC
23
24 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
25 *getcwd = \&cwd;
26 *fastgetcwd = \&cwd;
27 *fastcwd = \&cwd;
28
29 *fast_abs_path = \&sys_abspath if defined &sys_abspath;
30 *abs_path = \&fast_abs_path;
31 *realpath = \&fast_abs_path;
32 *fast_realpath = \&fast_abs_path;
33
f5f423e4
IZ
34 return 1;
35}
36
53e80d0b
JM
37# Need to look up the feature settings on VMS. The preferred way is to use the
38# VMS::Feature module, but that may not be available to dual life modules.
39
40my $use_vms_feature;
41BEGIN {
42 if ($^O eq 'VMS') {
43 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
44 $use_vms_feature = 1;
45 }
46 }
47}
48
49# Need to look up the UNIX report mode. This may become a dynamic mode
50# in the future.
51sub _vms_unix_rpt {
52 my $unix_rpt;
53 if ($use_vms_feature) {
54 $unix_rpt = VMS::Feature::current("filename_unix_report");
55 } else {
56 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
a7884731 57 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
53e80d0b
JM
58 }
59 return $unix_rpt;
60}
61
62# Need to look up the EFS character set mode. This may become a dynamic
63# mode in the future.
64sub _vms_efs {
65 my $efs;
66 if ($use_vms_feature) {
67 $efs = VMS::Feature::current("efs_charset");
68 } else {
69 my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
a7884731 70 $efs = $env_efs =~ /^[ET1]/i;
53e80d0b
JM
71 }
72 return $efs;
73}
74
75
b04f6d36 76# If loading the XS stuff doesn't work, we can fall back to pure perl
96dcbc37
DD
77if(! defined &getcwd && defined &DynaLoader::boot_DynaLoader) {
78 eval {#eval is questionable since we are handling potential errors like
ef47896b 79 #"Cwd object version 3.48 does not match bootstrap parameter 3.50
96dcbc37 80 #at lib/DynaLoader.pm line 216." by having this eval
07f43755
Z
81 if ( $] >= 5.006 ) {
82 require XSLoader;
83 XSLoader::load( __PACKAGE__, $xs_version);
84 } else {
85 require DynaLoader;
86 push @ISA, 'DynaLoader';
87 __PACKAGE__->bootstrap( $xs_version );
88 }
89 };
90}
4633a7c4 91
09122b95
RGS
92# Big nasty table of function aliases
93my %METHOD_MAP =
94 (
95 VMS =>
96 {
97 cwd => '_vms_cwd',
98 getcwd => '_vms_cwd',
99 fastcwd => '_vms_cwd',
100 fastgetcwd => '_vms_cwd',
101 abs_path => '_vms_abs_path',
102 fast_abs_path => '_vms_abs_path',
103 },
104
105 MSWin32 =>
106 {
107 # We assume that &_NT_cwd is defined as an XSUB or in the core.
108 cwd => '_NT_cwd',
109 getcwd => '_NT_cwd',
110 fastcwd => '_NT_cwd',
111 fastgetcwd => '_NT_cwd',
112 abs_path => 'fast_abs_path',
113 realpath => 'fast_abs_path',
114 },
115
116 dos =>
117 {
118 cwd => '_dos_cwd',
119 getcwd => '_dos_cwd',
120 fastgetcwd => '_dos_cwd',
121 fastcwd => '_dos_cwd',
122 abs_path => 'fast_abs_path',
123 },
124
58ccccf6 125 # QNX4. QNX6 has a $os of 'nto'.
09122b95
RGS
126 qnx =>
127 {
128 cwd => '_qnx_cwd',
129 getcwd => '_qnx_cwd',
130 fastgetcwd => '_qnx_cwd',
131 fastcwd => '_qnx_cwd',
132 abs_path => '_qnx_abs_path',
133 fast_abs_path => '_qnx_abs_path',
134 },
135
136 cygwin =>
137 {
138 getcwd => 'cwd',
139 fastgetcwd => 'cwd',
140 fastcwd => 'cwd',
141 abs_path => 'fast_abs_path',
142 realpath => 'fast_abs_path',
143 },
144
145 epoc =>
146 {
147 cwd => '_epoc_cwd',
148 getcwd => '_epoc_cwd',
149 fastgetcwd => '_epoc_cwd',
150 fastcwd => '_epoc_cwd',
151 abs_path => 'fast_abs_path',
152 },
153
154 MacOS =>
155 {
156 getcwd => 'cwd',
157 fastgetcwd => 'cwd',
158 fastcwd => 'cwd',
159 abs_path => 'fast_abs_path',
160 },
161 );
162
163$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
09122b95 164
96e4d5b1 165
3547aa9a
MS
166# Find the pwd command in the expected locations. We assume these
167# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
168# so everything works under taint mode.
169my $pwd_cmd;
f4eedc6b
DD
170if($^O ne 'MSWin32') {
171 foreach my $try ('/bin/pwd',
172 '/usr/bin/pwd',
173 '/QOpenSys/bin/pwd', # OS/400 PASE.
174 ) {
175 if( -x $try ) {
176 $pwd_cmd = $try;
177 last;
178 }
3547aa9a
MS
179 }
180}
b2fc9074
BF
181
182# Android has a built-in pwd. Using $pwd_cmd will DTRT if
183# this perl was compiled with -Dd_useshellcmds, which is the
184# default for Android, but the block below is needed for the
185# miniperl running on the host when cross-compiling, and
186# potentially for native builds with -Ud_useshellcmds.
187if ($^O =~ /android/) {
188 # If targetsh is executable, then we're either a full
189 # perl, or a miniperl for a native build.
190 if (-x $Config::Config{targetsh}) {
191 $pwd_cmd = "$Config::Config{targetsh} -c pwd"
192 }
193 else {
e7d73da9
BF
194 my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh');
195 $pwd_cmd = "$sh -c pwd"
b2fc9074
BF
196 }
197}
198
fa52125f 199my $found_pwd_cmd = defined($pwd_cmd);
522b859a 200unless ($pwd_cmd) {
2d3da5df 201 # Isn't this wrong? _backtick_pwd() will fail if someone has
889f7a4f
RGS
202 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
203 # See [perl #16774]. --jhi
204 $pwd_cmd = 'pwd';
522b859a 205}
3547aa9a 206
a9939470
NC
207# Lazy-load Carp
208sub _carp { require Carp; Carp::carp(@_) }
209sub _croak { require Carp; Carp::croak(@_) }
210
3547aa9a 211# The 'natural and safe form' for UNIX (pwd may be setuid root)
8b88ae92 212sub _backtick_pwd {
f6342b4b
RGS
213 # Localize %ENV entries in a way that won't create new hash keys
214 my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
215 local @ENV{@localize};
216
3547aa9a 217 my $cwd = `$pwd_cmd`;
ac3b20cb 218 # Belt-and-suspenders in case someone said "undef $/".
5cf6da5f 219 local $/ = "\n";
ac3b20cb 220 # `pwd` may fail e.g. if the disk is full
7e03f963 221 chomp($cwd) if defined $cwd;
4633a7c4 222 $cwd;
8b88ae92 223}
4633a7c4
LW
224
225# Since some ports may predefine cwd internally (e.g., NT)
226# we take care not to override an existing definition for cwd().
227
09122b95 228unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
ea54c8bd 229 # The pwd command is not available in some chroot(2)'ed environments
09122b95 230 my $sep = $Config::Config{path_sep} || ':';
60598624 231 my $os = $^O; # Protect $^O from tainting
fa52125f
SP
232
233
234 # Try again to find a pwd, this time searching the whole PATH.
235 if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
236 my @candidates = split($sep, $ENV{PATH});
237 while (!$found_pwd_cmd and @candidates) {
238 my $candidate = shift @candidates;
239 $found_pwd_cmd = 1 if -x "$candidate/pwd";
240 }
241 }
242
243 # MacOS has some special magic to make `pwd` work.
244 if( $os eq 'MacOS' || $found_pwd_cmd )
73b801a6 245 {
ea54c8bd
EC
246 *cwd = \&_backtick_pwd;
247 }
248 else {
249 *cwd = \&getcwd;
250 }
251}
a0d0e21e 252
23bb49fa
SP
253if ($^O eq 'cygwin') {
254 # We need to make sure cwd() is called with no args, because it's
255 # got an arg-less prototype and will die if args are present.
256 local $^W = 0;
257 my $orig_cwd = \&cwd;
258 *cwd = sub { &$orig_cwd() }
259}
260
261
1f4f94f5
RS
262# set a reasonable (and very safe) default for fastgetcwd, in case it
263# isn't redefined later (20001212 rspier)
264*fastgetcwd = \&cwd;
748a9306 265
c47834cd
RGS
266# A non-XS version of getcwd() - also used to bootstrap the perl build
267# process, when miniperl is running and no XS loading happens.
a7a23d71
NC
268sub _perl_getcwd
269{
270 abs_path('.');
271}
272
a0c9c202
JH
273# By John Bazik
274#
275# Usage: $cwd = &fastcwd;
276#
277# This is a faster version of getcwd. It's also more dangerous because
278# you might chdir out of a directory that you can't chdir back into.
279
99f36a73 280sub fastcwd_ {
a0c9c202
JH
281 my($odev, $oino, $cdev, $cino, $tdev, $tino);
282 my(@path, $path);
283 local(*DIR);
284
285 my($orig_cdev, $orig_cino) = stat('.');
286 ($cdev, $cino) = ($orig_cdev, $orig_cino);
287 for (;;) {
288 my $direntry;
289 ($odev, $oino) = ($cdev, $cino);
290 CORE::chdir('..') || return undef;
291 ($cdev, $cino) = stat('.');
292 last if $odev == $cdev && $oino == $cino;
293 opendir(DIR, '.') || return undef;
294 for (;;) {
295 $direntry = readdir(DIR);
296 last unless defined $direntry;
297 next if $direntry eq '.';
298 next if $direntry eq '..';
299
300 ($tdev, $tino) = lstat($direntry);
301 last unless $tdev != $odev || $tino != $oino;
302 }
303 closedir(DIR);
304 return undef unless defined $direntry; # should never happen
305 unshift(@path, $direntry);
306 }
307 $path = '/' . join('/', @path);
308 if ($^O eq 'apollo') { $path = "/".$path; }
309 # At this point $path may be tainted (if tainting) and chdir would fail.
248785eb
RGS
310 # Untaint it then check that we landed where we started.
311 $path =~ /^(.*)\z/s # untaint
312 && CORE::chdir($1) or return undef;
a0c9c202
JH
313 ($cdev, $cino) = stat('.');
314 die "Unstable directory path, current directory changed unexpectedly"
315 if $cdev != $orig_cdev || $cino != $orig_cino;
316 $path;
317}
99f36a73 318if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
a0c9c202
JH
319
320
4633a7c4 321# Keeps track of current working directory in PWD environment var
a0d0e21e
LW
322# Usage:
323# use Cwd 'chdir';
324# chdir $newdir;
325
4633a7c4 326my $chdir_init = 0;
a0d0e21e 327
4633a7c4 328sub chdir_init {
3b8e3443 329 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e
LW
330 my($dd,$di) = stat('.');
331 my($pd,$pi) = stat($ENV{'PWD'});
332 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4 333 $ENV{'PWD'} = cwd();
a0d0e21e
LW
334 }
335 }
336 else {
3b8e3443
GS
337 my $wd = cwd();
338 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
339 $ENV{'PWD'} = $wd;
a0d0e21e 340 }
4633a7c4 341 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443 342 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
a0d0e21e
LW
343 my($pd,$pi) = stat($2);
344 my($dd,$di) = stat($1);
345 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
346 $ENV{'PWD'}="$2$3";
347 }
348 }
349 $chdir_init = 1;
350}
351
352sub chdir {
22978713 353 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
faa5d6ec
TC
354 if ($^O eq "cygwin") {
355 $newdir =~ s|\A///+|//|;
356 $newdir =~ s|(?<=[^/])//+|/|g;
357 }
358 elsif ($^O ne 'MSWin32') {
359 $newdir =~ s|///*|/|g;
360 }
a0d0e21e 361 chdir_init() unless $chdir_init;
4ffa1610
JH
362 my $newpwd;
363 if ($^O eq 'MSWin32') {
364 # get the full path name *before* the chdir()
365 $newpwd = Win32::GetFullPathName($newdir);
366 }
367
4633a7c4 368 return 0 unless CORE::chdir $newdir;
4ffa1610 369
3b8e3443
GS
370 if ($^O eq 'VMS') {
371 return $ENV{'PWD'} = $ENV{'DEFAULT'}
372 }
4aecb5b5
JH
373 elsif ($^O eq 'MacOS') {
374 return $ENV{'PWD'} = cwd();
375 }
3b8e3443 376 elsif ($^O eq 'MSWin32') {
4ffa1610 377 $ENV{'PWD'} = $newpwd;
3b8e3443
GS
378 return 1;
379 }
748a9306 380
e9475de8
SP
381 if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
382 $ENV{'PWD'} = cwd();
383 } elsif ($newdir =~ m#^/#s) {
a0d0e21e 384 $ENV{'PWD'} = $newdir;
4633a7c4
LW
385 } else {
386 my @curdir = split(m#/#,$ENV{'PWD'});
387 @curdir = ('') unless @curdir;
388 my $component;
a0d0e21e
LW
389 foreach $component (split(m#/#, $newdir)) {
390 next if $component eq '.';
391 pop(@curdir),next if $component eq '..';
392 push(@curdir,$component);
393 }
394 $ENV{'PWD'} = join('/',@curdir) || '/';
395 }
4633a7c4 396 1;
a0d0e21e
LW
397}
398
a0c9c202 399
99f36a73 400sub _perl_abs_path
a0c9c202
JH
401{
402 my $start = @_ ? shift : '.';
403 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
404
405 unless (@cst = stat( $start ))
406 {
a9939470 407 _carp("stat($start): $!");
a0c9c202
JH
408 return '';
409 }
09122b95
RGS
410
411 unless (-d _) {
412 # Make sure we can be invoked on plain files, not just directories.
413 # NOTE that this routine assumes that '/' is the only directory separator.
414
415 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
416 or return cwd() . '/' . $start;
417
275e8705
RGS
418 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
419 if (-l $start) {
09122b95
RGS
420 my $link_target = readlink($start);
421 die "Can't resolve link $start: $!" unless defined $link_target;
422
423 require File::Spec;
424 $link_target = $dir . '/' . $link_target
425 unless File::Spec->file_name_is_absolute($link_target);
426
427 return abs_path($link_target);
428 }
429
99f36a73 430 return $dir ? abs_path($dir) . "/$file" : "/$file";
09122b95
RGS
431 }
432
a0c9c202
JH
433 $cwd = '';
434 $dotdots = $start;
435 do
436 {
437 $dotdots .= '/..';
438 @pst = @cst;
a25ef67d 439 local *PARENT;
a0c9c202
JH
440 unless (opendir(PARENT, $dotdots))
441 {
bf7c0a3d 442 # probably a permissions issue. Try the native command.
cdce0d84 443 require File::Spec;
bf7c0a3d 444 return File::Spec->rel2abs( $start, _backtick_pwd() );
a0c9c202
JH
445 }
446 unless (@cst = stat($dotdots))
447 {
a9939470 448 _carp("stat($dotdots): $!");
a0c9c202
JH
449 closedir(PARENT);
450 return '';
451 }
452 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
453 {
454 $dir = undef;
455 }
456 else
457 {
458 do
459 {
460 unless (defined ($dir = readdir(PARENT)))
461 {
a9939470 462 _carp("readdir($dotdots): $!");
a0c9c202
JH
463 closedir(PARENT);
464 return '';
465 }
466 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
467 }
468 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
469 $tst[1] != $pst[1]);
470 }
471 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
472 closedir(PARENT);
473 } while (defined $dir);
474 chop($cwd) unless $cwd eq '/'; # drop the trailing /
475 $cwd;
476}
477
478
3ee63918 479my $Curdir;
96e4d5b1 480sub fast_abs_path {
99f36a73 481 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
96e4d5b1 482 my $cwd = getcwd();
4d6b4052 483 require File::Spec;
3ee63918
MS
484 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
485
486 # Detaint else we'll explode in taint mode. This is safe because
487 # we're not doing anything dangerous with it.
9f28c638
JB
488 ($path) = $path =~ /(.*)/s;
489 ($cwd) = $cwd =~ /(.*)/s;
3ee63918 490
09122b95
RGS
491 unless (-e $path) {
492 _croak("$path: No such file or directory");
493 }
494
495 unless (-d _) {
496 # Make sure we can be invoked on plain files, not just directories.
497
498 my ($vol, $dir, $file) = File::Spec->splitpath($path);
499 return File::Spec->catfile($cwd, $path) unless length $dir;
500
501 if (-l $path) {
502 my $link_target = readlink($path);
503 die "Can't resolve link $path: $!" unless defined $link_target;
504
505 $link_target = File::Spec->catpath($vol, $dir, $link_target)
506 unless File::Spec->file_name_is_absolute($link_target);
507
508 return fast_abs_path($link_target);
509 }
510
d6802e43 511 return $dir eq File::Spec->rootdir
99f36a73
RGS
512 ? File::Spec->catpath($vol, $dir, $file)
513 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
09122b95
RGS
514 }
515
e2ba406b 516 if (!CORE::chdir($path)) {
a9939470 517 _croak("Cannot chdir to $path: $!");
e2ba406b 518 }
96e4d5b1 519 my $realpath = getcwd();
e2ba406b 520 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
a9939470 521 _croak("Cannot chdir back to $cwd: $!");
e2ba406b 522 }
96e4d5b1 523 $realpath;
8b88ae92
NIS
524}
525
e4c51978
GS
526# added function alias to follow principle of least surprise
527# based on previous aliasing. --tchrist 27-Jan-00
528*fast_realpath = \&fast_abs_path;
529
4633a7c4
LW
530
531# --- PORTING SECTION ---
532
533# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c 534# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72 535# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92
NIS
536# in the process logical name table as the default device and directory
537# seen by Perl. This may not be the same as the default device
4633a7c4
LW
538# and directory seen by DCL after Perl exits, since the effects
539# the CRTL chdir() function persist only until Perl exits.
4633a7c4
LW
540
541sub _vms_cwd {
96e4d5b1
PP
542 return $ENV{'DEFAULT'};
543}
544
545sub _vms_abs_path {
546 return $ENV{'DEFAULT'} unless @_;
61729915 547 my $path = shift;
9d7d9729 548
53e80d0b
JM
549 my $efs = _vms_efs;
550 my $unix_rpt = _vms_unix_rpt;
551
552 if (defined &VMS::Filespec::vmsrealpath) {
553 my $path_unix = 0;
554 my $path_vms = 0;
555
556 $path_unix = 1 if ($path =~ m#(?<=\^)/#);
557 $path_unix = 1 if ($path =~ /^\.\.?$/);
558 $path_vms = 1 if ($path =~ m#[\[<\]]#);
559 $path_vms = 1 if ($path =~ /^--?$/);
560
561 my $unix_mode = $path_unix;
562 if ($efs) {
563 # In case of a tie, the Unix report mode decides.
564 if ($path_vms == $path_unix) {
565 $unix_mode = $unix_rpt;
566 } else {
567 $unix_mode = 0 if $path_vms;
568 }
569 }
9d7d9729 570
53e80d0b 571 if ($unix_mode) {
bf7c0a3d 572 # Unix format
53e80d0b 573 return VMS::Filespec::unixrealpath($path);
bf7c0a3d
SP
574 }
575
576 # VMS format
577
53e80d0b 578 my $new_path = VMS::Filespec::vmsrealpath($path);
bf7c0a3d
SP
579
580 # Perl expects directories to be in directory format
581 $new_path = VMS::Filespec::pathify($new_path) if -d $path;
582 return $new_path;
583 }
584
585 # Fallback to older algorithm if correct ones are not
586 # available.
587
53e80d0b
JM
588 if (-l $path) {
589 my $link_target = readlink($path);
590 die "Can't resolve link $path: $!" unless defined $link_target;
591
592 return _vms_abs_path($link_target);
593 }
594
61729915
CB
595 # may need to turn foo.dir into [.foo]
596 my $pathified = VMS::Filespec::pathify($path);
597 $path = $pathified if defined $pathified;
598
96e4d5b1 599 return VMS::Filespec::rmsexpand($path);
4633a7c4 600}
68dc0745 601
4633a7c4
LW
602sub _os2_cwd {
603 $ENV{'PWD'} = `cmd /c cd`;
39741d73 604 chomp $ENV{'PWD'};
aa6b7957 605 $ENV{'PWD'} =~ s:\\:/:g ;
4633a7c4
LW
606 return $ENV{'PWD'};
607}
608
8440aeb0 609sub _win32_cwd_simple {
610 $ENV{'PWD'} = `cd`;
611 chomp $ENV{'PWD'};
612 $ENV{'PWD'} =~ s:\\:/:g ;
613 return $ENV{'PWD'};
614}
615
96e4d5b1 616sub _win32_cwd {
5ec06e76
NC
617 # Need to avoid taking any sort of reference to the typeglob or the code in
618 # the optree, so that this tests the runtime state of things, as the
619 # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
620 # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
621 # lookup avoids needing a string eval, which has been reported to cause
622 # problems (for reasons that we haven't been able to get to the bottom of -
623 # rt.cpan.org #56225)
624 if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
cf2f24a4
JD
625 $ENV{'PWD'} = Win32::GetCwd();
626 }
627 else { # miniperl
628 chomp($ENV{'PWD'} = `cd`);
629 }
aa6b7957 630 $ENV{'PWD'} =~ s:\\:/:g ;
96e4d5b1
PP
631 return $ENV{'PWD'};
632}
633
8440aeb0 634*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
68dc0745 635
39e571d4
ML
636sub _dos_cwd {
637 if (!defined &Dos::GetCwd) {
638 $ENV{'PWD'} = `command /c cd`;
39741d73 639 chomp $ENV{'PWD'};
aa6b7957 640 $ENV{'PWD'} =~ s:\\:/:g ;
39e571d4
ML
641 } else {
642 $ENV{'PWD'} = Dos::GetCwd();
643 }
55497cff
PP
644 return $ENV{'PWD'};
645}
646
7fbf1995 647sub _qnx_cwd {
35b807ef
NA
648 local $ENV{PATH} = '';
649 local $ENV{CDPATH} = '';
650 local $ENV{ENV} = '';
7fbf1995 651 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
39741d73 652 chomp $ENV{'PWD'};
7fbf1995
NA
653 return $ENV{'PWD'};
654}
655
656sub _qnx_abs_path {
35b807ef
NA
657 local $ENV{PATH} = '';
658 local $ENV{CDPATH} = '';
659 local $ENV{ENV} = '';
fa921dc6 660 my $path = @_ ? shift : '.';
39741d73
MS
661 local *REALPATH;
662
99f36a73 663 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
39741d73
MS
664 die "Can't open /usr/bin/fullpath: $!";
665 my $realpath = <REALPATH>;
666 close REALPATH;
667 chomp $realpath;
7fbf1995
NA
668 return $realpath;
669}
670
ed79a026
OF
671sub _epoc_cwd {
672 $ENV{'PWD'} = EPOC::getcwd();
673 return $ENV{'PWD'};
674}
675
4633a7c4 676
09122b95
RGS
677# Now that all the base-level functions are set up, alias the
678# user-level functions to the right places
679
680if (exists $METHOD_MAP{$^O}) {
681 my $map = $METHOD_MAP{$^O};
682 foreach my $name (keys %$map) {
99f36a73 683 local $^W = 0; # assignments trigger 'subroutine redefined' warning
09122b95
RGS
684 no strict 'refs';
685 *{$name} = \&{$map->{$name}};
686 }
55497cff 687}
4633a7c4 688
99f36a73
RGS
689# In case the XS version doesn't load.
690*abs_path = \&_perl_abs_path unless defined &abs_path;
a7a23d71 691*getcwd = \&_perl_getcwd unless defined &getcwd;
99f36a73
RGS
692
693# added function alias for those of us more
694# used to the libc function. --tchrist 27-Jan-00
695*realpath = \&abs_path;
4633a7c4 696
a0d0e21e 6971;
f4eedc6b
DD
698__END__
699
700=head1 NAME
701
702Cwd - get pathname of current working directory
703
704=head1 SYNOPSIS
705
706 use Cwd;
707 my $dir = getcwd;
708
709 use Cwd 'abs_path';
710 my $abs_path = abs_path($file);
711
712=head1 DESCRIPTION
713
714This module provides functions for determining the pathname of the
715current working directory. It is recommended that getcwd (or another
716*cwd() function) be used in I<all> code to ensure portability.
717
718By default, it exports the functions cwd(), getcwd(), fastcwd(), and
719fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
720
721
722=head2 getcwd and friends
723
724Each of these functions are called without arguments and return the
725absolute path of the current working directory.
726
727=over 4
728
729=item getcwd
730
731 my $cwd = getcwd();
732
733Returns the current working directory.
734
735Exposes the POSIX function getcwd(3) or re-implements it if it's not
736available.
737
738=item cwd
739
740 my $cwd = cwd();
741
742The cwd() is the most natural form for the current architecture. For
743most systems it is identical to `pwd` (but without the trailing line
744terminator).
745
746=item fastcwd
747
748 my $cwd = fastcwd();
749
750A more dangerous version of getcwd(), but potentially faster.
751
752It might conceivably chdir() you out of a directory that it can't
753chdir() you back into. If fastcwd encounters a problem it will return
754undef but will probably leave you in a different directory. For a
755measure of extra security, if everything appears to have worked, the
756fastcwd() function will check that it leaves you in the same directory
757that it started in. If it has changed it will C<die> with the message
758"Unstable directory path, current directory changed
759unexpectedly". That should never happen.
760
761=item fastgetcwd
762
763 my $cwd = fastgetcwd();
764
765The fastgetcwd() function is provided as a synonym for cwd().
766
767=item getdcwd
768
769 my $cwd = getdcwd();
770 my $cwd = getdcwd('C:');
771
772The getdcwd() function is also provided on Win32 to get the current working
773directory on the specified drive, since Windows maintains a separate current
774working directory for each drive. If no drive is specified then the current
775drive is assumed.
776
777This function simply calls the Microsoft C library _getdcwd() function.
778
779=back
780
781
782=head2 abs_path and friends
783
784These functions are exported only on request. They each take a single
785argument and return the absolute pathname for it. If no argument is
786given they'll use the current working directory.
787
788=over 4
789
790=item abs_path
791
792 my $abs_path = abs_path($file);
793
794Uses the same algorithm as getcwd(). Symbolic links and relative-path
795components ("." and "..") are resolved to return the canonical
796pathname, just like realpath(3).
797
798=item realpath
799
800 my $abs_path = realpath($file);
801
802A synonym for abs_path().
803
804=item fast_abs_path
805
806 my $abs_path = fast_abs_path($file);
807
808A more dangerous, but potentially faster version of abs_path.
809
810=back
811
812=head2 $ENV{PWD}
813
814If you ask to override your chdir() built-in function,
815
816 use Cwd qw(chdir);
817
818then your PWD environment variable will be kept up to date. Note that
819it will only be kept up to date if all packages which use chdir import
820it from Cwd.
821
822
823=head1 NOTES
824
825=over 4
826
827=item *
828
829Since the path separators are different on some operating systems ('/'
830on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
831modules wherever portability is a concern.
832
833=item *
834
835Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
836functions are all aliases for the C<cwd()> function, which, on Mac OS,
837calls `pwd`. Likewise, the C<abs_path()> function is an alias for
838C<fast_abs_path()>.
839
840=back
841
842=head1 AUTHOR
843
844Originally by the perl5-porters.
845
846Maintained by Ken Williams <KWILLIAMS@cpan.org>
847
848=head1 COPYRIGHT
849
850Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
851
852This program is free software; you can redistribute it and/or modify
853it under the same terms as Perl itself.
854
855Portions of the C code in this library are copyright (c) 1994 by the
856Regents of the University of California. All rights reserved. The
857license on this code is compatible with the licensing of the rest of
858the distribution - please see the source code in F<Cwd.xs> for the
859details.
860
861=head1 SEE ALSO
862
863L<File::chdir>
864
865=cut