1package Cwd; 2$VERSION = $VERSION = '2.17'; 3 4=head1 NAME 5 6Cwd - get pathname of current working directory 7 8=head1 SYNOPSIS 9 10 use Cwd; 11 my $dir = getcwd; 12 13 use Cwd 'abs_path'; 14 my $abs_path = abs_path($file); 15 16=head1 DESCRIPTION 17 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. 21 22By default, it exports the functions cwd(), getcwd(), fastcwd(), and 23fastgetcwd() into the caller's namespace. 24 25 26=head2 getcwd and friends 27 28Each of these functions are called without arguments and return the 29absolute path of the current working directory. 30 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 49=item fastcwd 50 51 my $cwd = fastcwd(); 52 53A more dangerous version of getcwd(), but potentially faster. 54 55It might conceivably chdir() you out of a directory that it can't 56chdir() you back into. If fastcwd encounters a problem it will return 57undef but will probably leave you in a different directory. For a 58measure of extra security, if everything appears to have worked, the 59fastcwd() function will check that it leaves you in the same directory 60that it started in. If it has changed it will C<die> with the message 61"Unstable directory path, current directory changed 62unexpectedly". That should never happen. 63 64=item fastgetcwd 65 66 my $cwd = fastgetcwd(); 67 68The fastgetcwd() function is provided as a synonym for cwd(). 69 70=back 71 72 73=head2 abs_path and friends 74 75These functions are exported only on request. They each take a single 76argument and return the absolute pathname for it. If no argument is 77given they'll use the current working directory. 78 79=over 4 80 81=item abs_path 82 83 my $abs_path = abs_path($file); 84 85Uses the same algorithm as getcwd(). Symbolic links and relative-path 86components ("." and "..") are resolved to return the canonical 87pathname, just like realpath(3). 88 89=item realpath 90 91 my $abs_path = realpath($file); 92 93A synonym for abs_path(). 94 95=item fast_abs_path 96 97 my $abs_path = fast_abs_path($file); 98 99A more dangerous, but potentially faster version of abs_path. 100 101=back 102 103=head2 $ENV{PWD} 104 105If you ask to override your chdir() built-in function, 106 107 use Cwd qw(chdir); 108 109then your PWD environment variable will be kept up to date. Note that 110it will only be kept up to date if all packages which use chdir import 111it from Cwd. 112 113 114=head1 NOTES 115 116=over 4 117 118=item * 119 120Since the path seperators are different on some operating systems ('/' 121on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec 122modules wherever portability is a concern. 123 124=item * 125 126Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()> 127functions are all aliases for the C<cwd()> function, which, on Mac OS, 128calls `pwd`. Likewise, the C<abs_path()> function is an alias for 129C<fast_abs_path()>. 130 131=back 132 133=head1 AUTHOR 134 135Originally by the perl5-porters. 136 137Now maintained by Ken Williams <KWILLIAMS@cpan.org> 138 139=head1 SEE ALSO 140 141L<File::chdir> 142 143=cut 144 145use strict; 146use Exporter; 147use vars qw(@ISA @EXPORT @EXPORT_OK); 148 149@ISA = qw/ Exporter /; 150@EXPORT = qw(cwd getcwd fastcwd fastgetcwd); 151@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); 152 153# sys_cwd may keep the builtin command 154 155# All the functionality of this module may provided by builtins, 156# there is no sense to process the rest of the file. 157# The best choice may be to have this in BEGIN, but how to return from BEGIN? 158 159if ($^O eq 'os2') { 160 local $^W = 0; 161 162 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; 163 *getcwd = \&cwd; 164 *fastgetcwd = \&cwd; 165 *fastcwd = \&cwd; 166 167 *fast_abs_path = \&sys_abspath if defined &sys_abspath; 168 *abs_path = \&fast_abs_path; 169 *realpath = \&fast_abs_path; 170 *fast_realpath = \&fast_abs_path; 171 172 return 1; 173} 174 175eval { 176 require XSLoader; 177 local $^W = 0; 178 XSLoader::load('Cwd'); 179}; 180 181 182# Find the pwd command in the expected locations. We assume these 183# are safe. This prevents _backtick_pwd() consulting $ENV{PATH} 184# so everything works under taint mode. 185my $pwd_cmd; 186foreach my $try ('/bin/pwd', 187 '/usr/bin/pwd', 188 '/QOpenSys/bin/pwd', # OS/400 PASE. 189 ) { 190 191 if( -x $try ) { 192 $pwd_cmd = $try; 193 last; 194 } 195} 196unless ($pwd_cmd) { 197 # Isn't this wrong? _backtick_pwd() will fail if somenone has 198 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd? 199 # See [perl #16774]. --jhi 200 $pwd_cmd = 'pwd'; 201} 202 203# Lazy-load Carp 204sub _carp { require Carp; Carp::carp(@_) } 205sub _croak { require Carp; Carp::croak(@_) } 206 207# The 'natural and safe form' for UNIX (pwd may be setuid root) 208sub _backtick_pwd { 209 local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; 210 my $cwd = `$pwd_cmd`; 211 # Belt-and-suspenders in case someone said "undef $/". 212 local $/ = "\n"; 213 # `pwd` may fail e.g. if the disk is full 214 chomp($cwd) if defined $cwd; 215 $cwd; 216} 217 218# Since some ports may predefine cwd internally (e.g., NT) 219# we take care not to override an existing definition for cwd(). 220 221unless(defined &cwd) { 222 # The pwd command is not available in some chroot(2)'ed environments 223 if( $^O eq 'MacOS' || (defined $ENV{PATH} && 224 grep { -x "$_/pwd" } split(':', $ENV{PATH})) ) 225 { 226 *cwd = \&_backtick_pwd; 227 } 228 else { 229 *cwd = \&getcwd; 230 } 231} 232 233# set a reasonable (and very safe) default for fastgetcwd, in case it 234# isn't redefined later (20001212 rspier) 235*fastgetcwd = \&cwd; 236 237# By Brandon S. Allbery 238# 239# Usage: $cwd = getcwd(); 240 241sub getcwd 242{ 243 abs_path('.'); 244} 245 246 247# By John Bazik 248# 249# Usage: $cwd = &fastcwd; 250# 251# This is a faster version of getcwd. It's also more dangerous because 252# you might chdir out of a directory that you can't chdir back into. 253 254sub fastcwd { 255 my($odev, $oino, $cdev, $cino, $tdev, $tino); 256 my(@path, $path); 257 local(*DIR); 258 259 my($orig_cdev, $orig_cino) = stat('.'); 260 ($cdev, $cino) = ($orig_cdev, $orig_cino); 261 for (;;) { 262 my $direntry; 263 ($odev, $oino) = ($cdev, $cino); 264 CORE::chdir('..') || return undef; 265 ($cdev, $cino) = stat('.'); 266 last if $odev == $cdev && $oino == $cino; 267 opendir(DIR, '.') || return undef; 268 for (;;) { 269 $direntry = readdir(DIR); 270 last unless defined $direntry; 271 next if $direntry eq '.'; 272 next if $direntry eq '..'; 273 274 ($tdev, $tino) = lstat($direntry); 275 last unless $tdev != $odev || $tino != $oino; 276 } 277 closedir(DIR); 278 return undef unless defined $direntry; # should never happen 279 unshift(@path, $direntry); 280 } 281 $path = '/' . join('/', @path); 282 if ($^O eq 'apollo') { $path = "/".$path; } 283 # At this point $path may be tainted (if tainting) and chdir would fail. 284 # Untaint it then check that we landed where we started. 285 $path =~ /^(.*)\z/s # untaint 286 && CORE::chdir($1) or return undef; 287 ($cdev, $cino) = stat('.'); 288 die "Unstable directory path, current directory changed unexpectedly" 289 if $cdev != $orig_cdev || $cino != $orig_cino; 290 $path; 291} 292 293 294# Keeps track of current working directory in PWD environment var 295# Usage: 296# use Cwd 'chdir'; 297# chdir $newdir; 298 299my $chdir_init = 0; 300 301sub chdir_init { 302 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') { 303 my($dd,$di) = stat('.'); 304 my($pd,$pi) = stat($ENV{'PWD'}); 305 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { 306 $ENV{'PWD'} = cwd(); 307 } 308 } 309 else { 310 my $wd = cwd(); 311 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; 312 $ENV{'PWD'} = $wd; 313 } 314 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) 315 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { 316 my($pd,$pi) = stat($2); 317 my($dd,$di) = stat($1); 318 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { 319 $ENV{'PWD'}="$2$3"; 320 } 321 } 322 $chdir_init = 1; 323} 324 325sub chdir { 326 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) 327 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; 328 chdir_init() unless $chdir_init; 329 my $newpwd; 330 if ($^O eq 'MSWin32') { 331 # get the full path name *before* the chdir() 332 $newpwd = Win32::GetFullPathName($newdir); 333 } 334 335 return 0 unless CORE::chdir $newdir; 336 337 if ($^O eq 'VMS') { 338 return $ENV{'PWD'} = $ENV{'DEFAULT'} 339 } 340 elsif ($^O eq 'MacOS') { 341 return $ENV{'PWD'} = cwd(); 342 } 343 elsif ($^O eq 'MSWin32') { 344 $ENV{'PWD'} = $newpwd; 345 return 1; 346 } 347 348 if ($newdir =~ m#^/#s) { 349 $ENV{'PWD'} = $newdir; 350 } else { 351 my @curdir = split(m#/#,$ENV{'PWD'}); 352 @curdir = ('') unless @curdir; 353 my $component; 354 foreach $component (split(m#/#, $newdir)) { 355 next if $component eq '.'; 356 pop(@curdir),next if $component eq '..'; 357 push(@curdir,$component); 358 } 359 $ENV{'PWD'} = join('/',@curdir) || '/'; 360 } 361 1; 362} 363 364 365# In case the XS version doesn't load. 366*abs_path = \&_perl_abs_path unless defined &abs_path; 367sub _perl_abs_path 368{ 369 my $start = @_ ? shift : '.'; 370 my($dotdots, $cwd, @pst, @cst, $dir, @tst); 371 372 unless (@cst = stat( $start )) 373 { 374 _carp("stat($start): $!"); 375 return ''; 376 } 377 $cwd = ''; 378 $dotdots = $start; 379 do 380 { 381 $dotdots .= '/..'; 382 @pst = @cst; 383 local *PARENT; 384 unless (opendir(PARENT, $dotdots)) 385 { 386 _carp("opendir($dotdots): $!"); 387 return ''; 388 } 389 unless (@cst = stat($dotdots)) 390 { 391 _carp("stat($dotdots): $!"); 392 closedir(PARENT); 393 return ''; 394 } 395 if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) 396 { 397 $dir = undef; 398 } 399 else 400 { 401 do 402 { 403 unless (defined ($dir = readdir(PARENT))) 404 { 405 _carp("readdir($dotdots): $!"); 406 closedir(PARENT); 407 return ''; 408 } 409 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) 410 } 411 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || 412 $tst[1] != $pst[1]); 413 } 414 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; 415 closedir(PARENT); 416 } while (defined $dir); 417 chop($cwd) unless $cwd eq '/'; # drop the trailing / 418 $cwd; 419} 420 421 422# added function alias for those of us more 423# used to the libc function. --tchrist 27-Jan-00 424*realpath = \&abs_path; 425 426my $Curdir; 427sub fast_abs_path { 428 my $cwd = getcwd(); 429 require File::Spec; 430 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); 431 432 # Detaint else we'll explode in taint mode. This is safe because 433 # we're not doing anything dangerous with it. 434 ($path) = $path =~ /(.*)/; 435 ($cwd) = $cwd =~ /(.*)/; 436 437 if (!CORE::chdir($path)) { 438 _croak("Cannot chdir to $path: $!"); 439 } 440 my $realpath = getcwd(); 441 if (! ((-d $cwd) && (CORE::chdir($cwd)))) { 442 _croak("Cannot chdir back to $cwd: $!"); 443 } 444 $realpath; 445} 446 447# added function alias to follow principle of least surprise 448# based on previous aliasing. --tchrist 27-Jan-00 449*fast_realpath = \&fast_abs_path; 450 451 452# --- PORTING SECTION --- 453 454# VMS: $ENV{'DEFAULT'} points to default directory at all times 455# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu 456# Note: Use of Cwd::chdir() causes the logical name PWD to be defined 457# in the process logical name table as the default device and directory 458# seen by Perl. This may not be the same as the default device 459# and directory seen by DCL after Perl exits, since the effects 460# the CRTL chdir() function persist only until Perl exits. 461 462sub _vms_cwd { 463 return $ENV{'DEFAULT'}; 464} 465 466sub _vms_abs_path { 467 return $ENV{'DEFAULT'} unless @_; 468 my $path = VMS::Filespec::pathify($_[0]); 469 if (! defined $path) 470 { 471 _croak("Invalid path name $_[0]") 472 } 473 return VMS::Filespec::rmsexpand($path); 474} 475 476sub _os2_cwd { 477 $ENV{'PWD'} = `cmd /c cd`; 478 chomp $ENV{'PWD'}; 479 $ENV{'PWD'} =~ s:\\:/:g ; 480 return $ENV{'PWD'}; 481} 482 483sub _win32_cwd { 484 $ENV{'PWD'} = Win32::GetCwd(); 485 $ENV{'PWD'} =~ s:\\:/:g ; 486 return $ENV{'PWD'}; 487} 488 489*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 490 defined &Win32::GetCwd); 491 492*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; 493 494sub _dos_cwd { 495 if (!defined &Dos::GetCwd) { 496 $ENV{'PWD'} = `command /c cd`; 497 chomp $ENV{'PWD'}; 498 $ENV{'PWD'} =~ s:\\:/:g ; 499 } else { 500 $ENV{'PWD'} = Dos::GetCwd(); 501 } 502 return $ENV{'PWD'}; 503} 504 505sub _qnx_cwd { 506 local $ENV{PATH} = ''; 507 local $ENV{CDPATH} = ''; 508 local $ENV{ENV} = ''; 509 $ENV{'PWD'} = `/usr/bin/fullpath -t`; 510 chomp $ENV{'PWD'}; 511 return $ENV{'PWD'}; 512} 513 514sub _qnx_abs_path { 515 local $ENV{PATH} = ''; 516 local $ENV{CDPATH} = ''; 517 local $ENV{ENV} = ''; 518 my $path = @_ ? shift : '.'; 519 local *REALPATH; 520 521 open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or 522 die "Can't open /usr/bin/fullpath: $!"; 523 my $realpath = <REALPATH>; 524 close REALPATH; 525 chomp $realpath; 526 return $realpath; 527} 528 529sub _epoc_cwd { 530 $ENV{'PWD'} = EPOC::getcwd(); 531 return $ENV{'PWD'}; 532} 533 534{ 535 no warnings; # assignments trigger 'subroutine redefined' warning 536 537 if ($^O eq 'VMS') { 538 *cwd = \&_vms_cwd; 539 *getcwd = \&_vms_cwd; 540 *fastcwd = \&_vms_cwd; 541 *fastgetcwd = \&_vms_cwd; 542 *abs_path = \&_vms_abs_path; 543 *fast_abs_path = \&_vms_abs_path; 544 } 545 elsif ($^O eq 'NT' or $^O eq 'MSWin32') { 546 # We assume that &_NT_cwd is defined as an XSUB or in the core. 547 *cwd = \&_NT_cwd; 548 *getcwd = \&_NT_cwd; 549 *fastcwd = \&_NT_cwd; 550 *fastgetcwd = \&_NT_cwd; 551 *abs_path = \&fast_abs_path; 552 *realpath = \&fast_abs_path; 553 } 554 elsif ($^O eq 'dos') { 555 *cwd = \&_dos_cwd; 556 *getcwd = \&_dos_cwd; 557 *fastgetcwd = \&_dos_cwd; 558 *fastcwd = \&_dos_cwd; 559 *abs_path = \&fast_abs_path; 560 } 561 elsif ($^O =~ m/^(?:qnx|nto)$/ ) { 562 *cwd = \&_qnx_cwd; 563 *getcwd = \&_qnx_cwd; 564 *fastgetcwd = \&_qnx_cwd; 565 *fastcwd = \&_qnx_cwd; 566 *abs_path = \&_qnx_abs_path; 567 *fast_abs_path = \&_qnx_abs_path; 568 } 569 elsif ($^O eq 'cygwin') { 570 *getcwd = \&cwd; 571 *fastgetcwd = \&cwd; 572 *fastcwd = \&cwd; 573 *abs_path = \&fast_abs_path; 574 *realpath = \&abs_path; 575 } 576 elsif ($^O eq 'epoc') { 577 *cwd = \&_epoc_cwd; 578 *getcwd = \&_epoc_cwd; 579 *fastgetcwd = \&_epoc_cwd; 580 *fastcwd = \&_epoc_cwd; 581 *abs_path = \&fast_abs_path; 582 } 583 elsif ($^O eq 'MacOS') { 584 *getcwd = \&cwd; 585 *fastgetcwd = \&cwd; 586 *fastcwd = \&cwd; 587 *abs_path = \&fast_abs_path; 588 } 589} 590 591 5921; 593