This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove support for running PathTools on MacOS
[perl5.git] / dist / PathTools / Cwd.pm
index 0c9b82d..1f94997 100644 (file)
 package Cwd;
-
-=head1 NAME
-
-Cwd - get pathname of current working directory
-
-=head1 SYNOPSIS
-
-    use Cwd;
-    my $dir = getcwd;
-
-    use Cwd 'abs_path';
-    my $abs_path = abs_path($file);
-
-=head1 DESCRIPTION
-
-This module provides functions for determining the pathname of the
-current working directory.  It is recommended that getcwd (or another
-*cwd() function) be used in I<all> code to ensure portability.
-
-By default, it exports the functions cwd(), getcwd(), fastcwd(), and
-fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
-
-
-=head2 getcwd and friends
-
-Each of these functions are called without arguments and return the
-absolute path of the current working directory.
-
-=over 4
-
-=item getcwd
-
-    my $cwd = getcwd();
-
-Returns the current working directory.
-
-Exposes the POSIX function getcwd(3) or re-implements it if it's not
-available.
-
-=item cwd
-
-    my $cwd = cwd();
-
-The cwd() is the most natural form for the current architecture.  For
-most systems it is identical to `pwd` (but without the trailing line
-terminator).
-
-=item fastcwd
-
-    my $cwd = fastcwd();
-
-A more dangerous version of getcwd(), but potentially faster.
-
-It might conceivably chdir() you out of a directory that it can't
-chdir() you back into.  If fastcwd encounters a problem it will return
-undef but will probably leave you in a different directory.  For a
-measure of extra security, if everything appears to have worked, the
-fastcwd() function will check that it leaves you in the same directory
-that it started in.  If it has changed it will C<die> with the message
-"Unstable directory path, current directory changed
-unexpectedly".  That should never happen.
-
-=item fastgetcwd
-
-  my $cwd = fastgetcwd();
-
-The fastgetcwd() function is provided as a synonym for cwd().
-
-=item getdcwd
-
-    my $cwd = getdcwd();
-    my $cwd = getdcwd('C:');
-
-The getdcwd() function is also provided on Win32 to get the current working
-directory on the specified drive, since Windows maintains a separate current
-working directory for each drive.  If no drive is specified then the current
-drive is assumed.
-
-This function simply calls the Microsoft C library _getdcwd() function.
-
-=back
-
-
-=head2 abs_path and friends
-
-These functions are exported only on request.  They each take a single
-argument and return the absolute pathname for it.  If no argument is
-given they'll use the current working directory.
-
-=over 4
-
-=item abs_path
-
-  my $abs_path = abs_path($file);
-
-Uses the same algorithm as getcwd().  Symbolic links and relative-path
-components ("." and "..") are resolved to return the canonical
-pathname, just like realpath(3).
-
-=item realpath
-
-  my $abs_path = realpath($file);
-
-A synonym for abs_path().
-
-=item fast_abs_path
-
-  my $abs_path = fast_abs_path($file);
-
-A more dangerous, but potentially faster version of abs_path.
-
-=back
-
-=head2 $ENV{PWD}
-
-If you ask to override your chdir() built-in function, 
-
-  use Cwd qw(chdir);
-
-then your PWD environment variable will be kept up to date.  Note that
-it will only be kept up to date if all packages which use chdir import
-it from Cwd.
-
-
-=head1 NOTES
-
-=over 4
-
-=item *
-
-Since the path separators are different on some operating systems ('/'
-on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
-modules wherever portability is a concern.
-
-=item *
-
-Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
-functions are all aliases for the C<cwd()> function, which, on Mac OS,
-calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
-C<fast_abs_path()>.
-
-=back
-
-=head1 AUTHOR
-
-Originally by the perl5-porters.
-
-Maintained by Ken Williams <KWILLIAMS@cpan.org>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-Portions of the C code in this library are copyright (c) 1994 by the
-Regents of the University of California.  All rights reserved.  The
-license on this code is compatible with the licensing of the rest of
-the distribution - please see the source code in F<Cwd.xs> for the
-details.
-
-=head1 SEE ALSO
-
-L<File::chdir>
-
-=cut
-
 use strict;
 use Exporter;
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.46';
+
+our $VERSION = '3.71';
 my $xs_version = $VERSION;
-$VERSION =~ tr/_//;
+$VERSION =~ tr/_//d;
 
-@ISA = qw/ Exporter /;
-@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+our @ISA = qw/ Exporter /;
+our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
-@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
 # sys_cwd may keep the builtin command
 
@@ -208,7 +40,10 @@ if ($^O eq 'os2') {
 my $use_vms_feature;
 BEGIN {
     if ($^O eq 'VMS') {
-        if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+        if (eval { local $SIG{__DIE__};
+                   local @INC = @INC;
+                   pop @INC if $INC[-1] eq '.';
+                   require VMS::Feature; }) {
             $use_vms_feature = 1;
         }
     }
@@ -242,17 +77,9 @@ sub _vms_efs {
 
 
 # If loading the XS stuff doesn't work, we can fall back to pure perl
-unless (defined &getcwd) {
-  eval {
-    if ( $] >= 5.006 ) {
-      require XSLoader;
-      XSLoader::load( __PACKAGE__, $xs_version);
-    } else {
-      require DynaLoader;
-      push @ISA, 'DynaLoader';
-      __PACKAGE__->bootstrap( $xs_version );
-    }
-  };
+if(! defined &getcwd && defined &DynaLoader::boot_DynaLoader) { # skipped on miniperl
+    require XSLoader;
+    XSLoader::load( __PACKAGE__, $xs_version);
 }
 
 # Big nasty table of function aliases
@@ -308,22 +135,13 @@ my %METHOD_MAP =
     realpath           => 'fast_abs_path',
    },
 
-   epoc =>
+   amigaos =>
    {
-    cwd                        => '_epoc_cwd',
-    getcwd             => '_epoc_cwd',
-    fastgetcwd         => '_epoc_cwd',
-    fastcwd            => '_epoc_cwd',
-    abs_path           => 'fast_abs_path',
-   },
-
-   MacOS =>
-   {
-    getcwd             => 'cwd',
-    fastgetcwd         => 'cwd',
-    fastcwd            => 'cwd',
-    abs_path           => 'fast_abs_path',
-   },
+    getcwd              => '_backtick_pwd',
+    fastgetcwd          => '_backtick_pwd',
+    fastcwd             => '_backtick_pwd',
+    abs_path            => 'fast_abs_path',
+   }
   );
 
 $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
@@ -333,14 +151,15 @@ $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
 # so everything works under taint mode.
 my $pwd_cmd;
-foreach my $try ('/bin/pwd',
-                '/usr/bin/pwd',
-                '/QOpenSys/bin/pwd', # OS/400 PASE.
-               ) {
-
-    if( -x $try ) {
-        $pwd_cmd = $try;
-        last;
+if($^O ne 'MSWin32') {
+    foreach my $try ('/bin/pwd',
+                    '/usr/bin/pwd',
+                    '/QOpenSys/bin/pwd', # OS/400 PASE.
+                   ) {
+       if( -x $try ) {
+           $pwd_cmd = $try;
+           last;
+       }
     }
 }
 
@@ -356,7 +175,8 @@ if ($^O =~ /android/) {
         $pwd_cmd = "$Config::Config{targetsh} -c pwd"
     }
     else {
-        $pwd_cmd = "$Config::Config{sh} -c pwd"
+        my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh');
+        $pwd_cmd = "$sh -c pwd"
     }
 }
 
@@ -374,9 +194,12 @@ sub _croak { require Carp; Carp::croak(@_) }
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
-    # Localize %ENV entries in a way that won't create new hash keys
-    my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
-    local @ENV{@localize};
+
+    # Localize %ENV entries in a way that won't create new hash keys.
+    # Under AmigaOS we don't want to localize as it stops perl from
+    # finding 'sh' in the PATH.
+    my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV) if $^O ne "amigaos";
+    local @ENV{@localize} if @localize;
     
     my $cwd = `$pwd_cmd`;
     # Belt-and-suspenders in case someone said "undef $/".
@@ -404,8 +227,7 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
        }
     }
 
-    # MacOS has some special magic to make `pwd` work.
-    if( $os eq 'MacOS' || $found_pwd_cmd )
+    if( $found_pwd_cmd )
     {
        *cwd = \&_backtick_pwd;
     }
@@ -515,7 +337,13 @@ sub chdir_init {
 
 sub chdir {
     my $newdir = @_ ? shift : '';      # allow for no arg (chdir to HOME dir)
-    $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
+    if ($^O eq "cygwin") {
+      $newdir =~ s|\A///+|//|;
+      $newdir =~ s|(?<=[^/])//+|/|g;
+    }
+    elsif ($^O ne 'MSWin32') {
+      $newdir =~ s|///*|/|g;
+    }
     chdir_init() unless $chdir_init;
     my $newpwd;
     if ($^O eq 'MSWin32') {
@@ -528,9 +356,6 @@ sub chdir {
     if ($^O eq 'VMS') {
        return $ENV{'PWD'} = $ENV{'DEFAULT'}
     }
-    elsif ($^O eq 'MacOS') {
-       return $ENV{'PWD'} = cwd();
-    }
     elsif ($^O eq 'MSWin32') {
        $ENV{'PWD'} = $newpwd;
        return 1;
@@ -758,57 +583,51 @@ sub _vms_abs_path {
 }
 
 sub _os2_cwd {
-    $ENV{'PWD'} = `cmd /c cd`;
-    chomp $ENV{'PWD'};
-    $ENV{'PWD'} =~ s:\\:/:g ;
-    return $ENV{'PWD'};
+    my $pwd = `cmd /c cd`;
+    chomp $pwd;
+    $pwd =~ s:\\:/:g ;
+    $ENV{'PWD'} = $pwd;
+    return $pwd;
 }
 
 sub _win32_cwd_simple {
-    $ENV{'PWD'} = `cd`;
-    chomp $ENV{'PWD'};
-    $ENV{'PWD'} =~ s:\\:/:g ;
-    return $ENV{'PWD'};
+    my $pwd = `cd`;
+    chomp $pwd;
+    $pwd =~ s:\\:/:g ;
+    $ENV{'PWD'} = $pwd;
+    return $pwd;
 }
 
 sub _win32_cwd {
-    # Need to avoid taking any sort of reference to the typeglob or the code in
-    # the optree, so that this tests the runtime state of things, as the
-    # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
-    # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
-    # lookup avoids needing a string eval, which has been reported to cause
-    # problems (for reasons that we haven't been able to get to the bottom of -
-    # rt.cpan.org #56225)
-    if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
-       $ENV{'PWD'} = Win32::GetCwd();
-    }
-    else { # miniperl
-       chomp($ENV{'PWD'} = `cd`);
-    }
-    $ENV{'PWD'} =~ s:\\:/:g ;
-    return $ENV{'PWD'};
+    my $pwd;
+    $pwd = Win32::GetCwd();
+    $pwd =~ s:\\:/:g ;
+    $ENV{'PWD'} = $pwd;
+    return $pwd;
 }
 
 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
 
 sub _dos_cwd {
+    my $pwd;
     if (!defined &Dos::GetCwd) {
-        $ENV{'PWD'} = `command /c cd`;
-        chomp $ENV{'PWD'};
-        $ENV{'PWD'} =~ s:\\:/:g ;
+        chomp($pwd = `command /c cd`);
+        $pwd =~ s:\\:/:g ;
     } else {
-        $ENV{'PWD'} = Dos::GetCwd();
+        $pwd = Dos::GetCwd();
     }
-    return $ENV{'PWD'};
+    $ENV{'PWD'} = $pwd;
+    return $pwd;
 }
 
 sub _qnx_cwd {
        local $ENV{PATH} = '';
        local $ENV{CDPATH} = '';
        local $ENV{ENV} = '';
-    $ENV{'PWD'} = `/usr/bin/fullpath -t`;
-    chomp $ENV{'PWD'};
-    return $ENV{'PWD'};
+    my $pwd = `/usr/bin/fullpath -t`;
+    chomp $pwd;
+    $ENV{'PWD'} = $pwd;
+    return $pwd;
 }
 
 sub _qnx_abs_path {
@@ -826,12 +645,6 @@ sub _qnx_abs_path {
     return $realpath;
 }
 
-sub _epoc_cwd {
-    $ENV{'PWD'} = EPOC::getcwd();
-    return $ENV{'PWD'};
-}
-
-
 # Now that all the base-level functions are set up, alias the
 # user-level functions to the right places
 
@@ -853,3 +666,171 @@ if (exists $METHOD_MAP{$^O}) {
 *realpath = \&abs_path;
 
 1;
+__END__
+
+=head1 NAME
+
+Cwd - get pathname of current working directory
+
+=head1 SYNOPSIS
+
+    use Cwd;
+    my $dir = getcwd;
+
+    use Cwd 'abs_path';
+    my $abs_path = abs_path($file);
+
+=head1 DESCRIPTION
+
+This module provides functions for determining the pathname of the
+current working directory.  It is recommended that getcwd (or another
+*cwd() function) be used in I<all> code to ensure portability.
+
+By default, it exports the functions cwd(), getcwd(), fastcwd(), and
+fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
+
+
+=head2 getcwd and friends
+
+Each of these functions are called without arguments and return the
+absolute path of the current working directory.
+
+=over 4
+
+=item getcwd
+
+    my $cwd = getcwd();
+
+Returns the current working directory.
+
+Exposes the POSIX function getcwd(3) or re-implements it if it's not
+available.
+
+=item cwd
+
+    my $cwd = cwd();
+
+The cwd() is the most natural form for the current architecture.  For
+most systems it is identical to `pwd` (but without the trailing line
+terminator).
+
+=item fastcwd
+
+    my $cwd = fastcwd();
+
+A more dangerous version of getcwd(), but potentially faster.
+
+It might conceivably chdir() you out of a directory that it can't
+chdir() you back into.  If fastcwd encounters a problem it will return
+undef but will probably leave you in a different directory.  For a
+measure of extra security, if everything appears to have worked, the
+fastcwd() function will check that it leaves you in the same directory
+that it started in.  If it has changed it will C<die> with the message
+"Unstable directory path, current directory changed
+unexpectedly".  That should never happen.
+
+=item fastgetcwd
+
+  my $cwd = fastgetcwd();
+
+The fastgetcwd() function is provided as a synonym for cwd().
+
+=item getdcwd
+
+    my $cwd = getdcwd();
+    my $cwd = getdcwd('C:');
+
+The getdcwd() function is also provided on Win32 to get the current working
+directory on the specified drive, since Windows maintains a separate current
+working directory for each drive.  If no drive is specified then the current
+drive is assumed.
+
+This function simply calls the Microsoft C library _getdcwd() function.
+
+=back
+
+
+=head2 abs_path and friends
+
+These functions are exported only on request.  They each take a single
+argument and return the absolute pathname for it.  If no argument is
+given they'll use the current working directory.
+
+=over 4
+
+=item abs_path
+
+  my $abs_path = abs_path($file);
+
+Uses the same algorithm as getcwd().  Symbolic links and relative-path
+components ("." and "..") are resolved to return the canonical
+pathname, just like realpath(3).
+
+=item realpath
+
+  my $abs_path = realpath($file);
+
+A synonym for abs_path().
+
+=item fast_abs_path
+
+  my $abs_path = fast_abs_path($file);
+
+A more dangerous, but potentially faster version of abs_path.
+
+=back
+
+=head2 $ENV{PWD}
+
+If you ask to override your chdir() built-in function, 
+
+  use Cwd qw(chdir);
+
+then your PWD environment variable will be kept up to date.  Note that
+it will only be kept up to date if all packages which use chdir import
+it from Cwd.
+
+
+=head1 NOTES
+
+=over 4
+
+=item *
+
+Since the path separators are different on some operating systems ('/'
+on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
+modules wherever portability is a concern.
+
+=item *
+
+Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
+functions are all aliases for the C<cwd()> function, which, on Mac OS,
+calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
+C<fast_abs_path()>.
+
+=back
+
+=head1 AUTHOR
+
+Originally by the perl5-porters.
+
+Maintained by Ken Williams <KWILLIAMS@cpan.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Portions of the C code in this library are copyright (c) 1994 by the
+Regents of the University of California.  All rights reserved.  The
+license on this code is compatible with the licensing of the rest of
+the distribution - please see the source code in F<Cwd.xs> for the
+details.
+
+=head1 SEE ALSO
+
+L<File::chdir>
+
+=cut