This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make $Config{byteorder} more magical so that it is
[perl5.git] / lib / Cwd.pm
CommitLineData
a0d0e21e
LW
1package Cwd;
2require 5.000;
a0d0e21e 3
f06db76b
AD
4=head1 NAME
5
6getcwd - get pathname of current working directory
7
8=head1 SYNOPSIS
9
4633a7c4
LW
10 use Cwd;
11 $dir = cwd;
12
13 use Cwd;
14 $dir = getcwd;
f06db76b
AD
15
16 use Cwd;
4633a7c4 17 $dir = fastgetcwd;
f06db76b
AD
18
19 use Cwd 'chdir';
20 chdir "/tmp";
21 print $ENV{'PWD'};
22
e4c51978 23 use Cwd 'abs_path'; # aka realpath()
20408e3c
GS
24 print abs_path($ENV{'PWD'});
25
26 use Cwd 'fast_abs_path';
27 print fast_abs_path($ENV{'PWD'});
28
f06db76b
AD
29=head1 DESCRIPTION
30
31The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
4633a7c4 32in Perl.
f06db76b 33
20408e3c 34The abs_path() function takes a single argument and returns the
e4c51978
GS
35absolute pathname for that argument. It uses the same algorithm
36as getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links
37and relative-path components ("." and "..") are resolved to return
38the canonical pathname, just like realpath(3). Also callable as
39realpath().
20408e3c 40
cb1a09d0 41The fastcwd() function looks the same as getcwd(), but runs faster.
fb73857a
PP
42It's also more dangerous because it might conceivably chdir() you out
43of a directory that it can't chdir() you back into. If fastcwd
44encounters a problem it will return undef but will probably leave you
45in a different directory. For a measure of extra security, if
46everything appears to have worked, the fastcwd() function will check
47that it leaves you in the same directory that it started in. If it has
48changed it will C<die> with the message "Unstable directory path,
49current directory changed unexpectedly". That should never happen.
f06db76b 50
20408e3c
GS
51The fast_abs_path() function looks the same as abs_path(), but runs faster.
52And like fastcwd() is more dangerous.
53
4633a7c4
LW
54The cwd() function looks the same as getcwd and fastgetcwd but is
55implemented using the most natural and safe form for the current
56architecture. For most systems it is identical to `pwd` (but without
fb73857a
PP
57the trailing line terminator).
58
59It is recommended that cwd (or another *cwd() function) is used in
60I<all> code to ensure portability.
4633a7c4
LW
61
62If you ask to override your chdir() built-in function, then your PWD
63environment variable will be kept up to date. (See
55497cff 64L<perlsub/Overriding Builtin Functions>.) Note that it will only be
1fef88e7 65kept up to date if all packages which use chdir import it from Cwd.
4633a7c4 66
f06db76b
AD
67=cut
68
96e4d5b1
PP
69## use strict;
70
71use Carp;
72
d57281c6 73$VERSION = '2.02';
96e4d5b1
PP
74
75require Exporter;
a0d0e21e 76@ISA = qw(Exporter);
e7ae0116 77@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
e4c51978 78@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
a0d0e21e 79
4633a7c4 80
8b88ae92 81# The 'natural and safe form' for UNIX (pwd may be setuid root)
96e4d5b1 82
8b88ae92 83sub _backtick_pwd {
7e03f963
TJ
84 my $cwd = `pwd`;
85 # `pwd` may fail e.g. if the disk is full
86 chomp($cwd) if defined $cwd;
4633a7c4 87 $cwd;
8b88ae92 88}
4633a7c4
LW
89
90# Since some ports may predefine cwd internally (e.g., NT)
91# we take care not to override an existing definition for cwd().
92
93*cwd = \&_backtick_pwd unless defined &cwd;
a0d0e21e 94
748a9306 95
a0d0e21e
LW
96# By Brandon S. Allbery
97#
98# Usage: $cwd = getcwd();
99
100sub getcwd
101{
07569ed3 102 abs_path('.');
a0d0e21e
LW
103}
104
a0d0e21e
LW
105# By John Bazik
106#
107# Usage: $cwd = &fastcwd;
108#
109# This is a faster version of getcwd. It's also more dangerous because
110# you might chdir out of a directory that you can't chdir back into.
fb73857a 111
a0d0e21e
LW
112sub fastcwd {
113 my($odev, $oino, $cdev, $cino, $tdev, $tino);
114 my(@path, $path);
115 local(*DIR);
116
fb73857a
PP
117 my($orig_cdev, $orig_cino) = stat('.');
118 ($cdev, $cino) = ($orig_cdev, $orig_cino);
a0d0e21e 119 for (;;) {
40000a8c 120 my $direntry;
a0d0e21e 121 ($odev, $oino) = ($cdev, $cino);
e79e61e4 122 CORE::chdir('..') || return undef;
a0d0e21e
LW
123 ($cdev, $cino) = stat('.');
124 last if $odev == $cdev && $oino == $cino;
fb73857a 125 opendir(DIR, '.') || return undef;
a0d0e21e 126 for (;;) {
40000a8c 127 $direntry = readdir(DIR);
fb73857a 128 last unless defined $direntry;
40000a8c
AD
129 next if $direntry eq '.';
130 next if $direntry eq '..';
a0d0e21e 131
40000a8c 132 ($tdev, $tino) = lstat($direntry);
a0d0e21e
LW
133 last unless $tdev != $odev || $tino != $oino;
134 }
135 closedir(DIR);
fb73857a 136 return undef unless defined $direntry; # should never happen
40000a8c 137 unshift(@path, $direntry);
a0d0e21e 138 }
fb73857a 139 $path = '/' . join('/', @path);
21ac5ced 140 if ($^O eq 'apollo') { $path = "/".$path; }
fb73857a
PP
141 # At this point $path may be tainted (if tainting) and chdir would fail.
142 # To be more useful we untaint it then check that we landed where we started.
392d8ab8 143 $path = $1 if $path =~ /^(.*)\z/s; # untaint
e79e61e4 144 CORE::chdir($path) || return undef;
fb73857a
PP
145 ($cdev, $cino) = stat('.');
146 die "Unstable directory path, current directory changed unexpectedly"
147 if $cdev != $orig_cdev || $cino != $orig_cino;
a0d0e21e
LW
148 $path;
149}
150
151
4633a7c4 152# Keeps track of current working directory in PWD environment var
a0d0e21e
LW
153# Usage:
154# use Cwd 'chdir';
155# chdir $newdir;
156
4633a7c4 157my $chdir_init = 0;
a0d0e21e 158
4633a7c4 159sub chdir_init {
39e571d4 160 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') {
a0d0e21e
LW
161 my($dd,$di) = stat('.');
162 my($pd,$pi) = stat($ENV{'PWD'});
163 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4 164 $ENV{'PWD'} = cwd();
a0d0e21e
LW
165 }
166 }
167 else {
4633a7c4 168 $ENV{'PWD'} = cwd();
a0d0e21e 169 }
4633a7c4 170 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
392d8ab8 171 if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
a0d0e21e
LW
172 my($pd,$pi) = stat($2);
173 my($dd,$di) = stat($1);
174 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
175 $ENV{'PWD'}="$2$3";
176 }
177 }
178 $chdir_init = 1;
179}
180
181sub chdir {
4633a7c4
LW
182 my $newdir = shift || ''; # allow for no arg (chdir to HOME dir)
183 $newdir =~ s|///*|/|g;
a0d0e21e 184 chdir_init() unless $chdir_init;
4633a7c4 185 return 0 unless CORE::chdir $newdir;
c6538b72 186 if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
748a9306 187
392d8ab8 188 if ($newdir =~ m#^/#s) {
a0d0e21e 189 $ENV{'PWD'} = $newdir;
4633a7c4
LW
190 } else {
191 my @curdir = split(m#/#,$ENV{'PWD'});
192 @curdir = ('') unless @curdir;
193 my $component;
a0d0e21e
LW
194 foreach $component (split(m#/#, $newdir)) {
195 next if $component eq '.';
196 pop(@curdir),next if $component eq '..';
197 push(@curdir,$component);
198 }
199 $ENV{'PWD'} = join('/',@curdir) || '/';
200 }
4633a7c4 201 1;
a0d0e21e
LW
202}
203
d57281c6
JH
204# Taken from Cwd.pm It is really getcwd with an optional
205# parameter instead of '.'
206#
8b88ae92 207
d57281c6
JH
208sub abs_path
209{
210 my $start = @_ ? shift : '.';
211 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
929327b2 212
d57281c6
JH
213 unless (@cst = stat( $start ))
214 {
215 carp "stat($start): $!";
216 return '';
8b88ae92 217 }
d57281c6
JH
218 $cwd = '';
219 $dotdots = $start;
220 do
221 {
222 $dotdots .= '/..';
223 @pst = @cst;
224 unless (opendir(PARENT, $dotdots))
225 {
226 carp "opendir($dotdots): $!";
227 return '';
228 }
229 unless (@cst = stat($dotdots))
230 {
231 carp "stat($dotdots): $!";
232 closedir(PARENT);
233 return '';
234 }
235 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
236 {
237 $dir = undef;
238 }
239 else
240 {
241 do
242 {
243 unless (defined ($dir = readdir(PARENT)))
244 {
245 carp "readdir($dotdots): $!";
246 closedir(PARENT);
247 return '';
248 }
249 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
250 }
251 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
252 $tst[1] != $pst[1]);
253 }
254 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
255 closedir(PARENT);
256 } while (defined $dir);
257 chop($cwd) unless $cwd eq '/'; # drop the trailing /
258 $cwd;
8b88ae92
NIS
259}
260
e4c51978
GS
261# added function alias for those of us more
262# used to the libc function. --tchrist 27-Jan-00
263*realpath = \&abs_path;
264
96e4d5b1
PP
265sub fast_abs_path {
266 my $cwd = getcwd();
267 my $path = shift || '.';
e79e61e4 268 CORE::chdir($path) || croak "Cannot chdir to $path:$!";
96e4d5b1 269 my $realpath = getcwd();
e79e61e4 270 CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
96e4d5b1 271 $realpath;
8b88ae92
NIS
272}
273
e4c51978
GS
274# added function alias to follow principle of least surprise
275# based on previous aliasing. --tchrist 27-Jan-00
276*fast_realpath = \&fast_abs_path;
277
4633a7c4
LW
278
279# --- PORTING SECTION ---
280
281# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c 282# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72 283# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92
NIS
284# in the process logical name table as the default device and directory
285# seen by Perl. This may not be the same as the default device
4633a7c4
LW
286# and directory seen by DCL after Perl exits, since the effects
287# the CRTL chdir() function persist only until Perl exits.
4633a7c4
LW
288
289sub _vms_cwd {
96e4d5b1
PP
290 return $ENV{'DEFAULT'};
291}
292
293sub _vms_abs_path {
294 return $ENV{'DEFAULT'} unless @_;
295 my $path = VMS::Filespec::pathify($_[0]);
296 croak("Invalid path name $_[0]") unless defined $path;
297 return VMS::Filespec::rmsexpand($path);
4633a7c4 298}
68dc0745 299
4633a7c4
LW
300sub _os2_cwd {
301 $ENV{'PWD'} = `cmd /c cd`;
302 chop $ENV{'PWD'};
303 $ENV{'PWD'} =~ s:\\:/:g ;
304 return $ENV{'PWD'};
305}
306
96e4d5b1 307sub _win32_cwd {
2d7a9237 308 $ENV{'PWD'} = Win32::GetCwd();
96e4d5b1
PP
309 $ENV{'PWD'} =~ s:\\:/:g ;
310 return $ENV{'PWD'};
311}
312
313*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237 314 defined &Win32::GetCwd);
96e4d5b1
PP
315
316*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745 317
39e571d4
ML
318sub _dos_cwd {
319 if (!defined &Dos::GetCwd) {
320 $ENV{'PWD'} = `command /c cd`;
321 chop $ENV{'PWD'};
322 $ENV{'PWD'} =~ s:\\:/:g ;
323 } else {
324 $ENV{'PWD'} = Dos::GetCwd();
325 }
55497cff
PP
326 return $ENV{'PWD'};
327}
328
7fbf1995
NA
329sub _qnx_cwd {
330 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
331 chop $ENV{'PWD'};
332 return $ENV{'PWD'};
333}
334
335sub _qnx_abs_path {
336 my $path = shift || '.';
337 my $realpath=`/usr/bin/fullpath -t $path`;
338 chop $realpath;
339 return $realpath;
340}
341
ac1ad7f0 342{
db376a24 343 no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4 344
ac1ad7f0 345 if ($^O eq 'VMS') {
96e4d5b1
PP
346 *cwd = \&_vms_cwd;
347 *getcwd = \&_vms_cwd;
348 *fastcwd = \&_vms_cwd;
349 *fastgetcwd = \&_vms_cwd;
350 *abs_path = \&_vms_abs_path;
351 *fast_abs_path = \&_vms_abs_path;
ac1ad7f0
PM
352 }
353 elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
354 # We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1
PP
355 *cwd = \&_NT_cwd;
356 *getcwd = \&_NT_cwd;
357 *fastcwd = \&_NT_cwd;
358 *fastgetcwd = \&_NT_cwd;
359 *abs_path = \&fast_abs_path;
ac1ad7f0
PM
360 }
361 elsif ($^O eq 'os2') {
362 # sys_cwd may keep the builtin command
96e4d5b1
PP
363 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
364 *getcwd = \&cwd;
365 *fastgetcwd = \&cwd;
366 *fastcwd = \&cwd;
367 *abs_path = \&fast_abs_path;
ac1ad7f0 368 }
39e571d4
ML
369 elsif ($^O eq 'dos') {
370 *cwd = \&_dos_cwd;
371 *getcwd = \&_dos_cwd;
372 *fastgetcwd = \&_dos_cwd;
373 *fastcwd = \&_dos_cwd;
96e4d5b1 374 *abs_path = \&fast_abs_path;
ac1ad7f0 375 }
7fbf1995
NA
376 elsif ($^O eq 'qnx') {
377 *cwd = \&_qnx_cwd;
378 *getcwd = \&_qnx_cwd;
379 *fastgetcwd = \&_qnx_cwd;
380 *fastcwd = \&_qnx_cwd;
381 *abs_path = \&_qnx_abs_path;
382 *fast_abs_path = \&_qnx_abs_path;
383 }
4fabb596 384 elsif ($^O eq 'cygwin') {
1cab015a
FE
385 *getcwd = \&cwd;
386 *fastgetcwd = \&cwd;
387 *fastcwd = \&cwd;
388 *abs_path = \&fast_abs_path;
389 }
55497cff 390}
4633a7c4
LW
391
392# package main; eval join('',<DATA>) || die $@; # quick test
393
a0d0e21e
LW
3941;
395
4633a7c4
LW
396__END__
397BEGIN { import Cwd qw(:DEFAULT chdir); }
398print join("\n", cwd, getcwd, fastcwd, "");
399chdir('..');
400print join("\n", cwd, getcwd, fastcwd, "");
401print "$ENV{PWD}\n";