dist/PathTools/Cwd.pm

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