dist/PathTools/Cwd.pm

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