package Cwd;
-require 5.6.0;
+$VERSION = $VERSION = '2.17';
=head1 NAME
most systems it is identical to `pwd` (but without the trailing line
terminator).
-Unfortunately, cwd() tends to break if called under taint mode.
-
=item fastcwd
my $cwd = fastcwd();
=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.
+argument and return the absolute pathname for it. If no argument is
+given they'll use the current working directory.
=over 4
=item fast_abs_path
- my $abs_path = abs_path($file);
+ my $abs_path = fast_abs_path($file);
A more dangerous, but potentially faster version of abs_path.
on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
modules wherever portability is a concern.
-=begin _private
-
=item *
Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
calls `pwd`. Likewise, the C<abs_path()> function is an alias for
C<fast_abs_path()>.
-=end _private
-
=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.06';
-
-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;
}
eval {
require XSLoader;
+ local $^W = 0;
XSLoader::load('Cwd');
};
# 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;
}
}
-$pwd_cmd ||= 'pwd';
+unless ($pwd_cmd) {
+ # 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)};
my $cwd = `$pwd_cmd`;
+ # Belt-and-suspenders in case someone said "undef $/".
+ local $/ = "\n";
# `pwd` may fail e.g. if the disk is full
chomp($cwd) if defined $cwd;
$cwd;
unless(defined &cwd) {
# The pwd command is not available in some chroot(2)'ed environments
- if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
+ if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
+ grep { -x "$_/pwd" } split(':', $ENV{PATH})) )
+ {
*cwd = \&_backtick_pwd;
}
else {
abs_path('.');
}
+
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd. It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+ my($odev, $oino, $cdev, $cino, $tdev, $tino);
+ my(@path, $path);
+ local(*DIR);
+
+ my($orig_cdev, $orig_cino) = stat('.');
+ ($cdev, $cino) = ($orig_cdev, $orig_cino);
+ for (;;) {
+ my $direntry;
+ ($odev, $oino) = ($cdev, $cino);
+ CORE::chdir('..') || return undef;
+ ($cdev, $cino) = stat('.');
+ last if $odev == $cdev && $oino == $cino;
+ opendir(DIR, '.') || return undef;
+ for (;;) {
+ $direntry = readdir(DIR);
+ last unless defined $direntry;
+ next if $direntry eq '.';
+ next if $direntry eq '..';
+
+ ($tdev, $tino) = lstat($direntry);
+ last unless $tdev != $odev || $tino != $oino;
+ }
+ closedir(DIR);
+ return undef unless defined $direntry; # should never happen
+ unshift(@path, $direntry);
+ }
+ $path = '/' . join('/', @path);
+ if ($^O eq 'apollo') { $path = "/".$path; }
+ # At this point $path may be tainted (if tainting) and chdir would fail.
+ # Untaint it then check that we landed where we started.
+ $path =~ /^(.*)\z/s # untaint
+ && CORE::chdir($1) or return undef;
+ ($cdev, $cino) = stat('.');
+ die "Unstable directory path, current directory changed unexpectedly"
+ if $cdev != $orig_cdev || $cino != $orig_cino;
+ $path;
+}
+
+
# Keeps track of current working directory in PWD environment var
# Usage:
# use Cwd 'chdir';
1;
}
+
+# In case the XS version doesn't load.
+*abs_path = \&_perl_abs_path unless defined &abs_path;
+sub _perl_abs_path
+{
+ my $start = @_ ? shift : '.';
+ my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+ unless (@cst = stat( $start ))
+ {
+ _carp("stat($start): $!");
+ return '';
+ }
+ $cwd = '';
+ $dotdots = $start;
+ do
+ {
+ $dotdots .= '/..';
+ @pst = @cst;
+ local *PARENT;
+ unless (opendir(PARENT, $dotdots))
+ {
+ _carp("opendir($dotdots): $!");
+ return '';
+ }
+ unless (@cst = stat($dotdots))
+ {
+ _carp("stat($dotdots): $!");
+ closedir(PARENT);
+ return '';
+ }
+ if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+ {
+ $dir = undef;
+ }
+ else
+ {
+ do
+ {
+ unless (defined ($dir = readdir(PARENT)))
+ {
+ _carp("readdir($dotdots): $!");
+ closedir(PARENT);
+ return '';
+ }
+ $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
+ }
+ while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+ $tst[1] != $pst[1]);
+ }
+ $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
+ closedir(PARENT);
+ } while (defined $dir);
+ chop($cwd) unless $cwd eq '/'; # drop the trailing /
+ $cwd;
+}
+
+
# added function alias for those of us more
# used to the libc function. --tchrist 27-Jan-00
*realpath = \&abs_path;
+my $Curdir;
sub fast_abs_path {
my $cwd = getcwd();
require File::Spec;
- my $path = @_ ? shift : File::Spec->curdir;
- CORE::chdir($path) || croak "Cannot chdir to $path:$!";
+ my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
+
+ # Detaint else we'll explode in taint mode. This is safe because
+ # we're not doing anything dangerous with it.
+ ($path) = $path =~ /(.*)/;
+ ($cwd) = $cwd =~ /(.*)/;
+
+ if (!CORE::chdir($path)) {
+ _croak("Cannot chdir to $path: $!");
+ }
my $realpath = getcwd();
- 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();
}
sub _qnx_cwd {
+ local $ENV{PATH} = '';
+ local $ENV{CDPATH} = '';
+ local $ENV{ENV} = '';
$ENV{'PWD'} = `/usr/bin/fullpath -t`;
- chop $ENV{'PWD'};
+ chomp $ENV{'PWD'};
return $ENV{'PWD'};
}
sub _qnx_abs_path {
+ local $ENV{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;
}
*fastcwd = \&_NT_cwd;
*fastgetcwd = \&_NT_cwd;
*abs_path = \&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;
+ *realpath = \&fast_abs_path;
}
elsif ($^O eq 'dos') {
*cwd = \&_dos_cwd;
*fastgetcwd = \&cwd;
*fastcwd = \&cwd;
*abs_path = \&fast_abs_path;
+ *realpath = \&abs_path;
}
elsif ($^O eq 'epoc') {
*cwd = \&_epoc_cwd;
}
}
-# package main; eval join('',<DATA>) || die $@; # quick test
1;
-
-__END__
-BEGIN { import Cwd qw(:DEFAULT chdir); }
-print join("\n", cwd, getcwd, fastcwd, "");
-chdir('..');
-print join("\n", cwd, getcwd, fastcwd, "");
-print "$ENV{PWD}\n";
https://perl5.git.perl.org / perl5.git / blobdiff