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 algoritm 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
=cut
-## use strict;
+use strict;
use Carp;
-$VERSION = '2.01';
+our $VERSION = '2.03';
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-@EXPORT_OK = qw(chdir abs_path fast_abs_path);
+use base qw/ Exporter /;
+our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
# The 'natural and safe form' for UNIX (pwd may be setuid root)
sub _backtick_pwd {
- my $cwd;
- chop($cwd = `pwd`);
+ my $cwd = `pwd`;
+ # `pwd` may fail e.g. if the disk is full
+ chomp($cwd) if defined $cwd;
$cwd;
}
# 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.
-# List of metachars taken from do_exec() in doio.c
-my $quoted_shell_meta = quotemeta('$&*(){}[]";\\|?<>~`'."'\n");
-
sub fastcwd {
my($odev, $oino, $cdev, $cino, $tdev, $tino);
my(@path, $path);
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.
# 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 ---
# VMS: $ENV{'DEFAULT'} points to default directory at all times
-# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
+# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
# in the process logical name table as the default device and directory
# seen by Perl. This may not be the same as the default device
}
{
- 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