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