This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync with libnet 1.18
[perl5.git] / lib / Cwd.pm
index 305cc60..4d5c71e 100644 (file)
@@ -1,5 +1,5 @@
 package Cwd;
-use 5.006;
+$VERSION = $VERSION = '2.17';
 
 =head1 NAME
 
@@ -130,6 +130,12 @@ C<fast_abs_path()>.
 
 =back
 
+=head1 AUTHOR
+
+Originally by the perl5-porters.
+
+Now maintained by Ken Williams <KWILLIAMS@cpan.org>
+
 =head1 SEE ALSO
 
 L<File::chdir>
@@ -137,14 +143,12 @@ L<File::chdir>
 =cut
 
 use strict;
+use Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
 
-use Carp;
-
-our $VERSION = '2.08';
-
-use base qw/ Exporter /;
-our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+@ISA = qw/ Exporter /;
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
 # sys_cwd may keep the builtin command
 
@@ -152,16 +156,19 @@ our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 # there is no sense to process the rest of the file.
 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
 
-if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
+if ($^O eq 'os2') {
     local $^W = 0;
-    *cwd               = \&sys_cwd;
-    *getcwd            = \&cwd;
-    *fastgetcwd                = \&cwd;
-    *fastcwd           = \&cwd;
-    *abs_path          = \&sys_abspath;
-    *fast_abs_path     = \&abs_path;
-    *realpath          = \&abs_path;
-    *fast_realpath     = \&abs_path;
+
+    *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+    *getcwd             = \&cwd;
+    *fastgetcwd         = \&cwd;
+    *fastcwd            = \&cwd;
+
+    *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
+    *abs_path           = \&fast_abs_path;
+    *realpath           = \&fast_abs_path;
+    *fast_realpath      = \&fast_abs_path;
+
     return 1;
 }
 
@@ -176,23 +183,27 @@ eval {
 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
 # so everything works under taint mode.
 my $pwd_cmd;
-foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
+foreach my $try ('/bin/pwd',
+                '/usr/bin/pwd',
+                '/QOpenSys/bin/pwd', # OS/400 PASE.
+               ) {
+
     if( -x $try ) {
         $pwd_cmd = $try;
         last;
     }
 }
 unless ($pwd_cmd) {
-    if (-x '/QOpenSys/bin/pwd') { # OS/400 PASE.
-        $pwd_cmd = '/QOpenSys/bin/pwd' ;
-    } else {
-        # Isn't this wrong?  _backtick_pwd() will fail if somenone has
-        # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
-        # See [perl #16774]. --jhi
-        $pwd_cmd = 'pwd';
-    }
+    # Isn't this wrong?  _backtick_pwd() will fail if somenone has
+    # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
+    # See [perl #16774]. --jhi
+    $pwd_cmd = 'pwd';
 }
 
+# Lazy-load Carp
+sub _carp  { require Carp; Carp::carp(@_)  }
+sub _croak { require Carp; Carp::croak(@_) }
+
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
     local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
@@ -360,7 +371,7 @@ sub _perl_abs_path
 
     unless (@cst = stat( $start ))
     {
-       carp "stat($start): $!";
+       _carp("stat($start): $!");
        return '';
     }
     $cwd = '';
@@ -372,12 +383,12 @@ sub _perl_abs_path
        local *PARENT;
        unless (opendir(PARENT, $dotdots))
        {
-           carp "opendir($dotdots): $!";
+           _carp("opendir($dotdots): $!");
            return '';
        }
        unless (@cst = stat($dotdots))
        {
-           carp "stat($dotdots): $!";
+           _carp("stat($dotdots): $!");
            closedir(PARENT);
            return '';
        }
@@ -391,7 +402,7 @@ sub _perl_abs_path
            {
                unless (defined ($dir = readdir(PARENT)))
                {
-                   carp "readdir($dotdots): $!";
+                   _carp("readdir($dotdots): $!");
                    closedir(PARENT);
                    return '';
                }
@@ -423,10 +434,13 @@ sub fast_abs_path {
     ($path) = $path =~ /(.*)/;
     ($cwd)  = $cwd  =~ /(.*)/;
 
-    CORE::chdir($path) || croak "Cannot chdir to $path: $!";
+    if (!CORE::chdir($path)) {
+       _croak("Cannot chdir to $path: $!");
+    }
     my $realpath = getcwd();
-    -d $cwd && CORE::chdir($cwd) ||
-       croak "Cannot chdir back to $cwd: $!";
+    if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
+       _croak("Cannot chdir back to $cwd: $!");
+    }
     $realpath;
 }
 
@@ -452,13 +466,16 @@ sub _vms_cwd {
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
     my $path = VMS::Filespec::pathify($_[0]);
-    croak("Invalid path name $_[0]") unless defined $path;
+    if (! defined $path)
+       {
+       _croak("Invalid path name $_[0]")
+       }
     return VMS::Filespec::rmsexpand($path);
 }
 
 sub _os2_cwd {
     $ENV{'PWD'} = `cmd /c cd`;
-    chop $ENV{'PWD'};
+    chomp $ENV{'PWD'};
     $ENV{'PWD'} =~ s:\\:/:g ;
     return $ENV{'PWD'};
 }
@@ -477,7 +494,7 @@ sub _win32_cwd {
 sub _dos_cwd {
     if (!defined &Dos::GetCwd) {
         $ENV{'PWD'} = `command /c cd`;
-        chop $ENV{'PWD'};
+        chomp $ENV{'PWD'};
         $ENV{'PWD'} =~ s:\\:/:g ;
     } else {
         $ENV{'PWD'} = Dos::GetCwd();
@@ -490,7 +507,7 @@ sub _qnx_cwd {
        local $ENV{CDPATH} = '';
        local $ENV{ENV} = '';
     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
-    chop $ENV{'PWD'};
+    chomp $ENV{'PWD'};
     return $ENV{'PWD'};
 }
 
@@ -499,8 +516,13 @@ sub _qnx_abs_path {
        local $ENV{CDPATH} = '';
        local $ENV{ENV} = '';
     my $path = @_ ? shift : '.';
-    my $realpath=`/usr/bin/fullpath -t $path`;
-    chop $realpath;
+    local *REALPATH;
+
+    open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or
+      die "Can't open /usr/bin/fullpath: $!";
+    my $realpath = <REALPATH>;
+    close REALPATH;
+    chomp $realpath;
     return $realpath;
 }
 
@@ -529,14 +551,6 @@ sub _epoc_cwd {
         *abs_path      = \&fast_abs_path;
         *realpath   = \&fast_abs_path;
     }
-    elsif ($^O eq 'os2') {
-        # sys_cwd may keep the builtin command
-        *cwd           = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
-        *getcwd                = \&cwd;
-        *fastgetcwd    = \&cwd;
-        *fastcwd       = \&cwd;
-        *abs_path      = \&fast_abs_path;
-    }
     elsif ($^O eq 'dos') {
         *cwd           = \&_dos_cwd;
         *getcwd                = \&_dos_cwd;
@@ -557,6 +571,7 @@ sub _epoc_cwd {
         *fastgetcwd    = \&cwd;
         *fastcwd       = \&cwd;
         *abs_path      = \&fast_abs_path;
+        *realpath      = \&abs_path;
     }
     elsif ($^O eq 'epoc') {
         *cwd            = \&_epoc_cwd;