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_01';
 175 $VERSION = eval $VERSION;
 176
 177 @ISA = qw/ Exporter /;
 178 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 179 push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
 180 @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 181
 182 # sys_cwd may keep the builtin command
 183
 184 # All the functionality of this module may provided by builtins,
 185 # there is no sense to process the rest of the file.
 186 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
 187
 188 if ($^O eq 'os2') {
 189     local $^W = 0;
 190
 191     *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
 192     *getcwd             = \&cwd;
 193     *fastgetcwd         = \&cwd;
 194     *fastcwd            = \&cwd;
 195
 196     *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
 197     *abs_path           = \&fast_abs_path;
 198     *realpath           = \&fast_abs_path;
 199     *fast_realpath      = \&fast_abs_path;
 200
 201     return 1;
 202 }
 203
 204 # If loading the XS stuff doesn't work, we can fall back to pure perl
 205 eval {
 206   if ( $] >= 5.006 ) {
 207     require XSLoader;
 208     XSLoader::load( __PACKAGE__, $VERSION );
 209   } else {
 210     require DynaLoader;
 211     push @ISA, 'DynaLoader';
 212     __PACKAGE__->bootstrap( $VERSION );
 213   }
 214 };
 215
 216 # Must be after the DynaLoader stuff:
 217 $VERSION = eval $VERSION;
 218
 219 # Big nasty table of function aliases
 220 my %METHOD_MAP =
 221   (
 222    VMS =>
 223    {
 224     cwd                 => '_vms_cwd',
 225     getcwd              => '_vms_cwd',
 226     fastcwd             => '_vms_cwd',
 227     fastgetcwd          => '_vms_cwd',
 228     abs_path            => '_vms_abs_path',
 229     fast_abs_path       => '_vms_abs_path',
 230    },
 231
 232    MSWin32 =>
 233    {
 234     # We assume that &_NT_cwd is defined as an XSUB or in the core.
 235     cwd                 => '_NT_cwd',
 236     getcwd              => '_NT_cwd',
 237     fastcwd             => '_NT_cwd',
 238     fastgetcwd          => '_NT_cwd',
 239     abs_path            => 'fast_abs_path',
 240     realpath            => 'fast_abs_path',
 241    },
 242
 243    dos =>
 244    {
 245     cwd                 => '_dos_cwd',
 246     getcwd              => '_dos_cwd',
 247     fastgetcwd          => '_dos_cwd',
 248     fastcwd             => '_dos_cwd',
 249     abs_path            => 'fast_abs_path',
 250    },
 251
 252    qnx =>
 253    {
 254     cwd                 => '_qnx_cwd',
 255     getcwd              => '_qnx_cwd',
 256     fastgetcwd          => '_qnx_cwd',
 257     fastcwd             => '_qnx_cwd',
 258     abs_path            => '_qnx_abs_path',
 259     fast_abs_path       => '_qnx_abs_path',
 260    },
 261
 262    cygwin =>
 263    {
 264     getcwd              => 'cwd',
 265     fastgetcwd          => 'cwd',
 266     fastcwd             => 'cwd',
 267     abs_path            => 'fast_abs_path',
 268     realpath            => 'fast_abs_path',
 269    },
 270
 271    epoc =>
 272    {
 273     cwd                 => '_epoc_cwd',
 274     getcwd              => '_epoc_cwd',
 275     fastgetcwd          => '_epoc_cwd',
 276     fastcwd             => '_epoc_cwd',
 277     abs_path            => 'fast_abs_path',
 278    },
 279
 280    MacOS =>
 281    {
 282     getcwd              => 'cwd',
 283     fastgetcwd          => 'cwd',
 284     fastcwd             => 'cwd',
 285     abs_path            => 'fast_abs_path',
 286    },
 287   );
 288
 289 $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
 290 $METHOD_MAP{nto} = $METHOD_MAP{qnx};
 291
 292
 293 # Find the pwd command in the expected locations.  We assume these
 294 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
 295 # so everything works under taint mode.
 296 my $pwd_cmd;
 297 foreach my $try ('/bin/pwd',
 298                  '/usr/bin/pwd',
 299                  '/QOpenSys/bin/pwd', # OS/400 PASE.
 300                 ) {
 301
 302     if( -x $try ) {
 303         $pwd_cmd = $try;
 304         last;
 305     }
 306 }
 307 my $found_pwd_cmd = defined($pwd_cmd);
 308 unless ($pwd_cmd) {
 309     # Isn't this wrong?  _backtick_pwd() will fail if somenone has
 310     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
 311     # See [perl #16774]. --jhi
 312     $pwd_cmd = 'pwd';
 313 }
 314
 315 # Lazy-load Carp
 316 sub _carp  { require Carp; Carp::carp(@_)  }
 317 sub _croak { require Carp; Carp::croak(@_) }
 318
 319 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 320 sub _backtick_pwd {
 321     # Localize %ENV entries in a way that won't create new hash keys
 322     my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
 323     local @ENV{@localize};
 324
 325     my $cwd = `$pwd_cmd`;
 326     # Belt-and-suspenders in case someone said "undef $/".
 327     local $/ = "\n";
 328     # `pwd` may fail e.g. if the disk is full
 329     chomp($cwd) if defined $cwd;
 330     $cwd;
 331 }
 332
 333 # Since some ports may predefine cwd internally (e.g., NT)
 334 # we take care not to override an existing definition for cwd().
 335
 336 unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
 337     # The pwd command is not available in some chroot(2)'ed environments
 338     my $sep = $Config::Config{path_sep} || ':';
 339     my $os = $^O;  # Protect $^O from tainting
 340
 341
 342     # Try again to find a pwd, this time searching the whole PATH.
 343     if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
 344         my @candidates = split($sep, $ENV{PATH});
 345         while (!$found_pwd_cmd and @candidates) {
 346             my $candidate = shift @candidates;
 347             $found_pwd_cmd = 1 if -x "$candidate/pwd";
 348         }
 349     }
 350
 351     # MacOS has some special magic to make `pwd` work.
 352     if( $os eq 'MacOS' || $found_pwd_cmd )
 353     {
 354         *cwd = \&_backtick_pwd;
 355     }
 356     else {
 357         *cwd = \&getcwd;
 358     }
 359 }
 360
 361 if ($^O eq 'cygwin') {
 362   # We need to make sure cwd() is called with no args, because it's
 363   # got an arg-less prototype and will die if args are present.
 364   local $^W = 0;
 365   my $orig_cwd = \&cwd;
 366   *cwd = sub { &$orig_cwd() }
 367 }
 368
 369
 370 # set a reasonable (and very safe) default for fastgetcwd, in case it
 371 # isn't redefined later (20001212 rspier)
 372 *fastgetcwd = \&cwd;
 373
 374 # A non-XS version of getcwd() - also used to bootstrap the perl build
 375 # process, when miniperl is running and no XS loading happens.
 376 sub _perl_getcwd
 377 {
 378     abs_path('.');
 379 }
 380
 381 # By John Bazik
 382 #
 383 # Usage: $cwd = &fastcwd;
 384 #
 385 # This is a faster version of getcwd.  It's also more dangerous because
 386 # you might chdir out of a directory that you can't chdir back into.
 387
 388 sub fastcwd_ {
 389     my($odev, $oino, $cdev, $cino, $tdev, $tino);
 390     my(@path, $path);
 391     local(*DIR);
 392
 393     my($orig_cdev, $orig_cino) = stat('.');
 394     ($cdev, $cino) = ($orig_cdev, $orig_cino);
 395     for (;;) {
 396         my $direntry;
 397         ($odev, $oino) = ($cdev, $cino);
 398         CORE::chdir('..') || return undef;
 399         ($cdev, $cino) = stat('.');
 400         last if $odev == $cdev && $oino == $cino;
 401         opendir(DIR, '.') || return undef;
 402         for (;;) {
 403             $direntry = readdir(DIR);
 404             last unless defined $direntry;
 405             next if $direntry eq '.';
 406             next if $direntry eq '..';
 407
 408             ($tdev, $tino) = lstat($direntry);
 409             last unless $tdev != $odev || $tino != $oino;
 410         }
 411         closedir(DIR);
 412         return undef unless defined $direntry; # should never happen
 413         unshift(@path, $direntry);
 414     }
 415     $path = '/' . join('/', @path);
 416     if ($^O eq 'apollo') { $path = "/".$path; }
 417     # At this point $path may be tainted (if tainting) and chdir would fail.
 418     # Untaint it then check that we landed where we started.
 419     $path =~ /^(.*)\z/s         # untaint
 420         && CORE::chdir($1) or return undef;
 421     ($cdev, $cino) = stat('.');
 422     die "Unstable directory path, current directory changed unexpectedly"
 423         if $cdev != $orig_cdev || $cino != $orig_cino;
 424     $path;
 425 }
 426 if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
 427
 428
 429 # Keeps track of current working directory in PWD environment var
 430 # Usage:
 431 #       use Cwd 'chdir';
 432 #       chdir $newdir;
 433
 434 my $chdir_init = 0;
 435
 436 sub chdir_init {
 437     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
 438         my($dd,$di) = stat('.');
 439         my($pd,$pi) = stat($ENV{'PWD'});
 440         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
 441             $ENV{'PWD'} = cwd();
 442         }
 443     }
 444     else {
 445         my $wd = cwd();
 446         $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
 447         $ENV{'PWD'} = $wd;
 448     }
 449     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
 450     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
 451         my($pd,$pi) = stat($2);
 452         my($dd,$di) = stat($1);
 453         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
 454             $ENV{'PWD'}="$2$3";
 455         }
 456     }
 457     $chdir_init = 1;
 458 }
 459
 460 sub chdir {
 461     my $newdir = @_ ? shift : '';       # allow for no arg (chdir to HOME dir)
 462     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
 463     chdir_init() unless $chdir_init;
 464     my $newpwd;
 465     if ($^O eq 'MSWin32') {
 466         # get the full path name *before* the chdir()
 467         $newpwd = Win32::GetFullPathName($newdir);
 468     }
 469
 470     return 0 unless CORE::chdir $newdir;
 471
 472     if ($^O eq 'VMS') {
 473         return $ENV{'PWD'} = $ENV{'DEFAULT'}
 474     }
 475     elsif ($^O eq 'MacOS') {
 476         return $ENV{'PWD'} = cwd();
 477     }
 478     elsif ($^O eq 'MSWin32') {
 479         $ENV{'PWD'} = $newpwd;
 480         return 1;
 481     }
 482
 483     if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
 484         $ENV{'PWD'} = cwd();
 485     } elsif ($newdir =~ m#^/#s) {
 486         $ENV{'PWD'} = $newdir;
 487     } else {
 488         my @curdir = split(m#/#,$ENV{'PWD'});
 489         @curdir = ('') unless @curdir;
 490         my $component;
 491         foreach $component (split(m#/#, $newdir)) {
 492             next if $component eq '.';
 493             pop(@curdir),next if $component eq '..';
 494             push(@curdir,$component);
 495         }
 496         $ENV{'PWD'} = join('/',@curdir) || '/';
 497     }
 498     1;
 499 }
 500
 501
 502 sub _perl_abs_path
 503 {
 504     my $start = @_ ? shift : '.';
 505     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
 506
 507     unless (@cst = stat( $start ))
 508     {
 509         _carp("stat($start): $!");
 510         return '';
 511     }
 512
 513     unless (-d _) {
 514         # Make sure we can be invoked on plain files, not just directories.
 515         # NOTE that this routine assumes that '/' is the only directory separator.
 516
 517         my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
 518             or return cwd() . '/' . $start;
 519
 520         # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
 521         if (-l $start) {
 522             my $link_target = readlink($start);
 523             die "Can't resolve link $start: $!" unless defined $link_target;
 524
 525             require File::Spec;
 526             $link_target = $dir . '/' . $link_target
 527                 unless File::Spec->file_name_is_absolute($link_target);
 528
 529             return abs_path($link_target);
 530         }
 531
 532         return $dir ? abs_path($dir) . "/$file" : "/$file";
 533     }
 534
 535     $cwd = '';
 536     $dotdots = $start;
 537     do
 538     {
 539         $dotdots .= '/..';
 540         @pst = @cst;
 541         local *PARENT;
 542         unless (opendir(PARENT, $dotdots))
 543         {
 544             # probably a permissions issue.  Try the native command.
 545             return File::Spec->rel2abs( $start, _backtick_pwd() );
 546         }
 547         unless (@cst = stat($dotdots))
 548         {
 549             _carp("stat($dotdots): $!");
 550             closedir(PARENT);
 551             return '';
 552         }
 553         if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
 554         {
 555             $dir = undef;
 556         }
 557         else
 558         {
 559             do
 560             {
 561                 unless (defined ($dir = readdir(PARENT)))
 562                 {
 563                     _carp("readdir($dotdots): $!");
 564                     closedir(PARENT);
 565                     return '';
 566                 }
 567                 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
 568             }
 569             while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
 570                    $tst[1] != $pst[1]);
 571         }
 572         $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
 573         closedir(PARENT);
 574     } while (defined $dir);
 575     chop($cwd) unless $cwd eq '/'; # drop the trailing /
 576     $cwd;
 577 }
 578
 579
 580 my $Curdir;
 581 sub fast_abs_path {
 582     local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
 583     my $cwd = getcwd();
 584     require File::Spec;
 585     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
 586
 587     # Detaint else we'll explode in taint mode.  This is safe because
 588     # we're not doing anything dangerous with it.
 589     ($path) = $path =~ /(.*)/;
 590     ($cwd)  = $cwd  =~ /(.*)/;
 591
 592     unless (-e $path) {
 593         _croak("$path: No such file or directory");
 594     }
 595
 596     unless (-d _) {
 597         # Make sure we can be invoked on plain files, not just directories.
 598
 599         my ($vol, $dir, $file) = File::Spec->splitpath($path);
 600         return File::Spec->catfile($cwd, $path) unless length $dir;
 601
 602         if (-l $path) {
 603             my $link_target = readlink($path);
 604             die "Can't resolve link $path: $!" unless defined $link_target;
 605
 606             $link_target = File::Spec->catpath($vol, $dir, $link_target)
 607                 unless File::Spec->file_name_is_absolute($link_target);
 608
 609             return fast_abs_path($link_target);
 610         }
 611
 612         return $dir eq File::Spec->rootdir
 613           ? File::Spec->catpath($vol, $dir, $file)
 614           : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
 615     }
 616
 617     if (!CORE::chdir($path)) {
 618         _croak("Cannot chdir to $path: $!");
 619     }
 620     my $realpath = getcwd();
 621     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
 622         _croak("Cannot chdir back to $cwd: $!");
 623     }
 624     $realpath;
 625 }
 626
 627 # added function alias to follow principle of least surprise
 628 # based on previous aliasing.  --tchrist 27-Jan-00
 629 *fast_realpath = \&fast_abs_path;
 630
 631
 632 # --- PORTING SECTION ---
 633
 634 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 635 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
 636 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
 637 #   in the process logical name table as the default device and directory
 638 #   seen by Perl. This may not be the same as the default device
 639 #   and directory seen by DCL after Perl exits, since the effects
 640 #   the CRTL chdir() function persist only until Perl exits.
 641
 642 sub _vms_cwd {
 643     return $ENV{'DEFAULT'};
 644 }
 645
 646 sub _vms_abs_path {
 647     return $ENV{'DEFAULT'} unless @_;
 648     my $path = shift;
 649
 650     if (-l $path) {
 651         my $link_target = readlink($path);
 652         die "Can't resolve link $path: $!" unless defined $link_target;
 653
 654         return _vms_abs_path($link_target);
 655     }
 656
 657     if (defined &VMS::Filespec::vms_realpath) {
 658         my $path = $_[0];
 659         if ($path =~ m#(?<=\^)/# ) {
 660             # Unix format
 661             return VMS::Filespec::vms_realpath($path);
 662         }
 663
 664         # VMS format
 665
 666         my $new_path = VMS::Filespec::vms_realname($path);
 667
 668         # Perl expects directories to be in directory format
 669         $new_path = VMS::Filespec::pathify($new_path) if -d $path;
 670         return $new_path;
 671     }
 672
 673     # Fallback to older algorithm if correct ones are not
 674     # available.
 675
 676     # may need to turn foo.dir into [.foo]
 677     my $pathified = VMS::Filespec::pathify($path);
 678     $path = $pathified if defined $pathified;
 679
 680     return VMS::Filespec::rmsexpand($path);
 681 }
 682
 683 sub _os2_cwd {
 684     $ENV{'PWD'} = `cmd /c cd`;
 685     chomp $ENV{'PWD'};
 686     $ENV{'PWD'} =~ s:\\:/:g ;
 687     return $ENV{'PWD'};
 688 }
 689
 690 sub _win32_cwd {
 691     if (defined &DynaLoader::boot_DynaLoader) {
 692         $ENV{'PWD'} = Win32::GetCwd();
 693     }
 694     else { # miniperl
 695         chomp($ENV{'PWD'} = `cd`);
 696     }
 697     $ENV{'PWD'} =~ s:\\:/:g ;
 698     return $ENV{'PWD'};
 699 }
 700
 701 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
 702
 703 sub _dos_cwd {
 704     if (!defined &Dos::GetCwd) {
 705         $ENV{'PWD'} = `command /c cd`;
 706         chomp $ENV{'PWD'};
 707         $ENV{'PWD'} =~ s:\\:/:g ;
 708     } else {
 709         $ENV{'PWD'} = Dos::GetCwd();
 710     }
 711     return $ENV{'PWD'};
 712 }
 713
 714 sub _qnx_cwd {
 715         local $ENV{PATH} = '';
 716         local $ENV{CDPATH} = '';
 717         local $ENV{ENV} = '';
 718     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
 719     chomp $ENV{'PWD'};
 720     return $ENV{'PWD'};
 721 }
 722
 723 sub _qnx_abs_path {
 724         local $ENV{PATH} = '';
 725         local $ENV{CDPATH} = '';
 726         local $ENV{ENV} = '';
 727     my $path = @_ ? shift : '.';
 728     local *REALPATH;
 729
 730     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
 731       die "Can't open /usr/bin/fullpath: $!";
 732     my $realpath = <REALPATH>;
 733     close REALPATH;
 734     chomp $realpath;
 735     return $realpath;
 736 }
 737
 738 sub _epoc_cwd {
 739     $ENV{'PWD'} = EPOC::getcwd();
 740     return $ENV{'PWD'};
 741 }
 742
 743
 744 # Now that all the base-level functions are set up, alias the
 745 # user-level functions to the right places
 746
 747 if (exists $METHOD_MAP{$^O}) {
 748   my $map = $METHOD_MAP{$^O};
 749   foreach my $name (keys %$map) {
 750     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
 751     no strict 'refs';
 752     *{$name} = \&{$map->{$name}};
 753   }
 754 }
 755
 756 # In case the XS version doesn't load.
 757 *abs_path = \&_perl_abs_path unless defined &abs_path;
 758 *getcwd = \&_perl_getcwd unless defined &getcwd;
 759
 760 # added function alias for those of us more
 761 # used to the libc function.  --tchrist 27-Jan-00
 762 *realpath = \&abs_path;
 763
 764 1;