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