lib/Cwd.pm

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