chdir "/tmp";
print $ENV{'PWD'};
- use Cwd 'abs_path';
+ use Cwd 'abs_path'; # aka realpath()
print abs_path($ENV{'PWD'});
use Cwd 'fast_abs_path';
in Perl.
The abs_path() function takes a single argument and returns the
-absolute pathname for that argument. It uses the same algorithm as
-getcwd(). (actually getcwd() is abs_path("."))
+absolute pathname for that argument. It uses the same algorithm
+as getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links
+and relative-path components ("." and "..") are resolved to return
+the canonical pathname, just like realpath(3). Also callable as
+realpath().
The fastcwd() function looks the same as getcwd(), but runs faster.
It's also more dangerous because it might conceivably chdir() you out
use Carp;
-$VERSION = '2.01';
+$VERSION = '2.02';
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-@EXPORT_OK = qw(chdir abs_path fast_abs_path);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
# The 'natural and safe form' for UNIX (pwd may be setuid root)
if ($^O eq 'apollo') { $path = "/".$path; }
# At this point $path may be tainted (if tainting) and chdir would fail.
# To be more useful we untaint it then check that we landed where we started.
- $path = $1 if $path =~ /^(.*)$/; # untaint
+ $path = $1 if $path =~ /^(.*)\z/s; # untaint
CORE::chdir($path) || return undef;
($cdev, $cino) = stat('.');
die "Unstable directory path, current directory changed unexpectedly"
$ENV{'PWD'} = cwd();
}
# Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
- if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+ if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
my($pd,$pi) = stat($2);
my($dd,$di) = stat($1);
if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
return 0 unless CORE::chdir $newdir;
if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
- if ($newdir =~ m#^/#) {
+ if ($newdir =~ m#^/#s) {
$ENV{'PWD'} = $newdir;
} else {
my @curdir = split(m#/#,$ENV{'PWD'});
$cwd;
}
+# added function alias for those of us more
+# used to the libc function. --tchrist 27-Jan-00
+*realpath = \&abs_path;
+
sub fast_abs_path {
my $cwd = getcwd();
my $path = shift || '.';
$realpath;
}
+# added function alias to follow principle of least surprise
+# based on previous aliasing. --tchrist 27-Jan-00
+*fast_realpath = \&fast_abs_path;
+
# --- PORTING SECTION ---
}
{
- local $^W = 0; # assignments trigger 'subroutine redefined' warning
+ no warnings; # assignments trigger 'subroutine redefined' warning
if ($^O eq 'VMS') {
*cwd = \&_vms_cwd;
*abs_path = \&_qnx_abs_path;
*fast_abs_path = \&_qnx_abs_path;
}
+ elsif ($^O eq 'cygwin') {
+ *getcwd = \&cwd;
+ *fastgetcwd = \&cwd;
+ *fastcwd = \&cwd;
+ *abs_path = \&fast_abs_path;
+ }
}
# package main; eval join('',<DATA>) || die $@; # quick test