package Cwd;
-use 5.006;
+$VERSION = $VERSION = '2.17';
=head1 NAME
=back
+=head1 AUTHOR
+
+Originally by the perl5-porters.
+
+Now maintained by Ken Williams <KWILLIAMS@cpan.org>
+
=head1 SEE ALSO
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
# 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;
}
# 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)};
unless (@cst = stat( $start ))
{
- carp "stat($start): $!";
+ _carp("stat($start): $!");
return '';
}
$cwd = '';
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 '';
}
{
unless (defined ($dir = readdir(PARENT)))
{
- carp "readdir($dotdots): $!";
+ _carp("readdir($dotdots): $!");
closedir(PARENT);
return '';
}
($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;
}
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'};
}
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();
local $ENV{CDPATH} = '';
local $ENV{ENV} = '';
$ENV{'PWD'} = `/usr/bin/fullpath -t`;
- chop $ENV{'PWD'};
+ chomp $ENV{'PWD'};
return $ENV{'PWD'};
}
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;
}
*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;
*fastgetcwd = \&cwd;
*fastcwd = \&cwd;
*abs_path = \&fast_abs_path;
+ *realpath = \&abs_path;
}
elsif ($^O eq 'epoc') {
*cwd = \&_epoc_cwd;