=head1 NAME
-getcwd - get pathname of current working directory
+Cwd - get pathname of current working directory
=head1 SYNOPSIS
$dir = getcwd;
use Cwd;
+ $dir = fastcwd;
+
+ use Cwd;
$dir = fastgetcwd;
use Cwd 'chdir';
=head1 DESCRIPTION
+This module provides functions for determining the pathname of the
+current working directory. By default, it exports the functions
+cwd(), getcwd(), fastcwd(), and fastgetcwd() into the caller's
+namespace. Each of these functions are called without arguments and
+return the absolute path of the current working directory. It is
+recommended that cwd (or another *cwd() function) be used in I<all>
+code to ensure portability.
+
+The cwd() is the most natural and safe form for the current
+architecture. For most systems it is identical to `pwd` (but without
+the trailing line terminator).
+
The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
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(".")) 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
of a directory that it can't chdir() you back into. If fastcwd
changed it will C<die> with the message "Unstable directory path,
current directory changed unexpectedly". That should never happen.
-The fast_abs_path() function looks the same as abs_path(), but runs faster.
-And like fastcwd() is more dangerous.
+The fastgetcwd() function is provided as a synonym for cwd().
-The cwd() function looks the same as getcwd and fastgetcwd but is
-implemented using the most natural and safe form for the current
-architecture. For most systems it is identical to `pwd` (but without
-the trailing line terminator).
+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(".")) Symbolic links and
+relative-path components ("." and "..") are resolved to return the
+canonical pathname, just like realpath(3). This function is also
+callable as realpath().
-It is recommended that cwd (or another *cwd() function) is used in
-I<all> code to ensure portability.
+The fast_abs_path() function looks the same as abs_path() but runs
+faster and, like fastcwd(), is more dangerous.
If you ask to override your chdir() built-in function, then your PWD
environment variable will be kept up to date. (See
our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+eval {
+ require XSLoader;
+ XSLoader::load('Cwd');
+};
# The 'natural and safe form' for UNIX (pwd may be setuid root)
unless(defined &cwd) {
# The pwd command is not available in some chroot(2)'ed environments
- if(grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
+ if($^O eq 'MacOS' || 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.
- # To be more useful we untaint it then check that we landed where we started.
- $path = $1 if $path =~ /^(.*)\z/s; # untaint
- CORE::chdir($path) || 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';
my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
$newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
chdir_init() unless $chdir_init;
+ my $newpwd;
+ if ($^O eq 'MSWin32') {
+ # get the full path name *before* the chdir()
+ $newpwd = Win32::GetFullPathName($newdir);
+ }
+
return 0 unless CORE::chdir $newdir;
+
if ($^O eq 'VMS') {
return $ENV{'PWD'} = $ENV{'DEFAULT'}
}
+ elsif ($^O eq 'MacOS') {
+ return $ENV{'PWD'} = cwd();
+ }
elsif ($^O eq 'MSWin32') {
- $ENV{'PWD'} = Win32::GetFullPathName($newdir);
+ $ENV{'PWD'} = $newpwd;
return 1;
}
1;
}
-# Taken from Cwd.pm It is really getcwd with an optional
-# parameter instead of '.'
-#
-
-sub 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;
- 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;
*fastcwd = \&_epoc_cwd;
*abs_path = \&fast_abs_path;
}
+ elsif ($^O eq 'MacOS') {
+ *getcwd = \&cwd;
+ *fastgetcwd = \&cwd;
+ *fastcwd = \&cwd;
+ *abs_path = \&fast_abs_path;
+ }
}
# package main; eval join('',<DATA>) || die $@; # quick test