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             return undef;
 425         }
 426         unless (@cst = stat($dotdots))
 427         {
 428             my $e = $!;
 429             closedir(PARENT);
 430             $! = $e;
 431             return undef;
 432         }
 433         if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
 434         {
 435             $dir = undef;
 436         }
 437         else
 438         {
 439             do
 440             {
 441                 unless (defined ($dir = readdir(PARENT)))
 442                 {
 443                     closedir(PARENT);
 444                     require Errno;
 445                     $! = Errno::ENOENT();
 446                     return undef;
 447                 }
 448                 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
 449             }
 450             while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
 451                    $tst[1] != $pst[1]);
 452         }
 453         $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
 454         closedir(PARENT);
 455     } while (defined $dir);
 456     chop($cwd) unless $cwd eq '/'; # drop the trailing /
 457     $cwd;
 458 }
 459
 460
 461 my $Curdir;
 462 sub fast_abs_path {
 463     local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
 464     my $cwd = getcwd();
 465     require File::Spec;
 466     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
 467
 468     # Detaint else we'll explode in taint mode.  This is safe because
 469     # we're not doing anything dangerous with it.
 470     ($path) = $path =~ /(.*)/s;
 471     ($cwd)  = $cwd  =~ /(.*)/s;
 472
 473     unless (-e $path) {
 474         _croak("$path: No such file or directory");
 475     }
 476
 477     unless (-d _) {
 478         # Make sure we can be invoked on plain files, not just directories.
 479
 480         my ($vol, $dir, $file) = File::Spec->splitpath($path);
 481         return File::Spec->catfile($cwd, $path) unless length $dir;
 482
 483         if (-l $path) {
 484             my $link_target = readlink($path);
 485             die "Can't resolve link $path: $!" unless defined $link_target;
 486
 487             $link_target = File::Spec->catpath($vol, $dir, $link_target)
 488                 unless File::Spec->file_name_is_absolute($link_target);
 489
 490             return fast_abs_path($link_target);
 491         }
 492
 493         return $dir eq File::Spec->rootdir
 494           ? File::Spec->catpath($vol, $dir, $file)
 495           : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
 496     }
 497
 498     if (!CORE::chdir($path)) {
 499         _croak("Cannot chdir to $path: $!");
 500     }
 501     my $realpath = getcwd();
 502     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
 503         _croak("Cannot chdir back to $cwd: $!");
 504     }
 505     $realpath;
 506 }
 507
 508 # added function alias to follow principle of least surprise
 509 # based on previous aliasing.  --tchrist 27-Jan-00
 510 *fast_realpath = \&fast_abs_path;
 511
 512
 513 # --- PORTING SECTION ---
 514
 515 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 516 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
 517 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
 518 #   in the process logical name table as the default device and directory
 519 #   seen by Perl. This may not be the same as the default device
 520 #   and directory seen by DCL after Perl exits, since the effects
 521 #   the CRTL chdir() function persist only until Perl exits.
 522
 523 sub _vms_cwd {
 524     return $ENV{'DEFAULT'};
 525 }
 526
 527 sub _vms_abs_path {
 528     return $ENV{'DEFAULT'} unless @_;
 529     my $path = shift;
 530
 531     my $efs = _vms_efs;
 532     my $unix_rpt = _vms_unix_rpt;
 533
 534     if (defined &VMS::Filespec::vmsrealpath) {
 535         my $path_unix = 0;
 536         my $path_vms = 0;
 537
 538         $path_unix = 1 if ($path =~ m#(?<=\^)/#);
 539         $path_unix = 1 if ($path =~ /^\.\.?$/);
 540         $path_vms = 1 if ($path =~ m#[\[<\]]#);
 541         $path_vms = 1 if ($path =~ /^--?$/);
 542
 543         my $unix_mode = $path_unix;
 544         if ($efs) {
 545             # In case of a tie, the Unix report mode decides.
 546             if ($path_vms == $path_unix) {
 547                 $unix_mode = $unix_rpt;
 548             } else {
 549                 $unix_mode = 0 if $path_vms;
 550             }
 551         }
 552
 553         if ($unix_mode) {
 554             # Unix format
 555             return VMS::Filespec::unixrealpath($path);
 556         }
 557
 558         # VMS format
 559
 560         my $new_path = VMS::Filespec::vmsrealpath($path);
 561
 562         # Perl expects directories to be in directory format
 563         $new_path = VMS::Filespec::pathify($new_path) if -d $path;
 564         return $new_path;
 565     }
 566
 567     # Fallback to older algorithm if correct ones are not
 568     # available.
 569
 570     if (-l $path) {
 571         my $link_target = readlink($path);
 572         die "Can't resolve link $path: $!" unless defined $link_target;
 573
 574         return _vms_abs_path($link_target);
 575     }
 576
 577     # may need to turn foo.dir into [.foo]
 578     my $pathified = VMS::Filespec::pathify($path);
 579     $path = $pathified if defined $pathified;
 580
 581     return VMS::Filespec::rmsexpand($path);
 582 }
 583
 584 sub _os2_cwd {
 585     my $pwd = `cmd /c cd`;
 586     chomp $pwd;
 587     $pwd =~ s:\\:/:g ;
 588     $ENV{'PWD'} = $pwd;
 589     return $pwd;
 590 }
 591
 592 sub _win32_cwd_simple {
 593     my $pwd = `cd`;
 594     chomp $pwd;
 595     $pwd =~ s:\\:/:g ;
 596     $ENV{'PWD'} = $pwd;
 597     return $pwd;
 598 }
 599
 600 sub _win32_cwd {
 601     my $pwd;
 602     $pwd = Win32::GetCwd();
 603     $pwd =~ s:\\:/:g ;
 604     $ENV{'PWD'} = $pwd;
 605     return $pwd;
 606 }
 607
 608 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
 609
 610 sub _dos_cwd {
 611     my $pwd;
 612     if (!defined &Dos::GetCwd) {
 613         chomp($pwd = `command /c cd`);
 614         $pwd =~ s:\\:/:g ;
 615     } else {
 616         $pwd = Dos::GetCwd();
 617     }
 618     $ENV{'PWD'} = $pwd;
 619     return $pwd;
 620 }
 621
 622 sub _qnx_cwd {
 623         local $ENV{PATH} = '';
 624         local $ENV{CDPATH} = '';
 625         local $ENV{ENV} = '';
 626     my $pwd = `/usr/bin/fullpath -t`;
 627     chomp $pwd;
 628     $ENV{'PWD'} = $pwd;
 629     return $pwd;
 630 }
 631
 632 sub _qnx_abs_path {
 633         local $ENV{PATH} = '';
 634         local $ENV{CDPATH} = '';
 635         local $ENV{ENV} = '';
 636     my $path = @_ ? shift : '.';
 637     local *REALPATH;
 638
 639     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
 640       die "Can't open /usr/bin/fullpath: $!";
 641     my $realpath = <REALPATH>;
 642     close REALPATH;
 643     chomp $realpath;
 644     return $realpath;
 645 }
 646
 647 # Now that all the base-level functions are set up, alias the
 648 # user-level functions to the right places
 649
 650 if (exists $METHOD_MAP{$^O}) {
 651   my $map = $METHOD_MAP{$^O};
 652   foreach my $name (keys %$map) {
 653     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
 654     no strict 'refs';
 655     *{$name} = \&{$map->{$name}};
 656   }
 657 }
 658
 659 # In case the XS version doesn't load.
 660 *abs_path = \&_perl_abs_path unless defined &abs_path;
 661 *getcwd = \&_perl_getcwd unless defined &getcwd;
 662
 663 # added function alias for those of us more
 664 # used to the libc function.  --tchrist 27-Jan-00
 665 *realpath = \&abs_path;
 666
 667 1;
 668 __END__
 669
 670 =head1 NAME
 671
 672 Cwd - get pathname of current working directory
 673
 674 =head1 SYNOPSIS
 675
 676     use Cwd;
 677     my $dir = getcwd;
 678
 679     use Cwd 'abs_path';
 680     my $abs_path = abs_path($file);
 681
 682 =head1 DESCRIPTION
 683
 684 This module provides functions for determining the pathname of the
 685 current working directory.  It is recommended that getcwd (or another
 686 *cwd() function) be used in I<all> code to ensure portability.
 687
 688 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
 689 fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
 690
 691
 692 =head2 getcwd and friends
 693
 694 Each of these functions are called without arguments and return the
 695 absolute path of the current working directory.
 696
 697 =over 4
 698
 699 =item getcwd
 700
 701     my $cwd = getcwd();
 702
 703 Returns the current working directory.  On error returns C<undef>,
 704 with C<$!> set to indicate the error.
 705
 706 Exposes the POSIX function getcwd(3) or re-implements it if it's not
 707 available.
 708
 709 =item cwd
 710
 711     my $cwd = cwd();
 712
 713 The cwd() is the most natural form for the current architecture.  For
 714 most systems it is identical to `pwd` (but without the trailing line
 715 terminator).
 716
 717 =item fastcwd
 718
 719     my $cwd = fastcwd();
 720
 721 A more dangerous version of getcwd(), but potentially faster.
 722
 723 It might conceivably chdir() you out of a directory that it can't
 724 chdir() you back into.  If fastcwd encounters a problem it will return
 725 undef but will probably leave you in a different directory.  For a
 726 measure of extra security, if everything appears to have worked, the
 727 fastcwd() function will check that it leaves you in the same directory
 728 that it started in.  If it has changed it will C<die> with the message
 729 "Unstable directory path, current directory changed
 730 unexpectedly".  That should never happen.
 731
 732 =item fastgetcwd
 733
 734   my $cwd = fastgetcwd();
 735
 736 The fastgetcwd() function is provided as a synonym for cwd().
 737
 738 =item getdcwd
 739
 740     my $cwd = getdcwd();
 741     my $cwd = getdcwd('C:');
 742
 743 The getdcwd() function is also provided on Win32 to get the current working
 744 directory on the specified drive, since Windows maintains a separate current
 745 working directory for each drive.  If no drive is specified then the current
 746 drive is assumed.
 747
 748 This function simply calls the Microsoft C library _getdcwd() function.
 749
 750 =back
 751
 752
 753 =head2 abs_path and friends
 754
 755 These functions are exported only on request.  They each take a single
 756 argument and return the absolute pathname for it.  If no argument is
 757 given they'll use the current working directory.
 758
 759 =over 4
 760
 761 =item abs_path
 762
 763   my $abs_path = abs_path($file);
 764
 765 Uses the same algorithm as getcwd().  Symbolic links and relative-path
 766 components ("." and "..") are resolved to return the canonical
 767 pathname, just like realpath(3).  On error returns C<undef>, with C<$!>
 768 set to indicate the error.
 769
 770 =item realpath
 771
 772   my $abs_path = realpath($file);
 773
 774 A synonym for abs_path().
 775
 776 =item fast_abs_path
 777
 778   my $abs_path = fast_abs_path($file);
 779
 780 A more dangerous, but potentially faster version of abs_path.
 781
 782 =back
 783
 784 =head2 $ENV{PWD}
 785
 786 If you ask to override your chdir() built-in function,
 787
 788   use Cwd qw(chdir);
 789
 790 then your PWD environment variable will be kept up to date.  Note that
 791 it will only be kept up to date if all packages which use chdir import
 792 it from Cwd.
 793
 794
 795 =head1 NOTES
 796
 797 =over 4
 798
 799 =item *
 800
 801 Since the path separators are different on some operating systems ('/'
 802 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
 803 modules wherever portability is a concern.
 804
 805 =item *
 806
 807 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
 808 functions are all aliases for the C<cwd()> function, which, on Mac OS,
 809 calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
 810 C<fast_abs_path()>.
 811
 812 =back
 813
 814 =head1 AUTHOR
 815
 816 Originally by the perl5-porters.
 817
 818 Maintained by Ken Williams <KWILLIAMS@cpan.org>
 819
 820 =head1 COPYRIGHT
 821
 822 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
 823
 824 This program is free software; you can redistribute it and/or modify
 825 it under the same terms as Perl itself.
 826
 827 Portions of the C code in this library are copyright (c) 1994 by the
 828 Regents of the University of California.  All rights reserved.  The
 829 license on this code is compatible with the licensing of the rest of
 830 the distribution - please see the source code in F<Cwd.xs> for the
 831 details.
 832
 833 =head1 SEE ALSO
 834
 835 L<File::chdir>
 836
 837 =cut