1N/Apackage Cwd;
1N/A$VERSION = $VERSION = '2.17';
1N/A
1N/A=head1 NAME
1N/A
1N/ACwd - get pathname of current working directory
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Cwd;
1N/A my $dir = getcwd;
1N/A
1N/A use Cwd 'abs_path';
1N/A my $abs_path = abs_path($file);
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AThis module provides functions for determining the pathname of the
1N/Acurrent working directory. It is recommended that getcwd (or another
1N/A*cwd() function) be used in I<all> code to ensure portability.
1N/A
1N/ABy default, it exports the functions cwd(), getcwd(), fastcwd(), and
1N/Afastgetcwd() into the caller's namespace.
1N/A
1N/A
1N/A=head2 getcwd and friends
1N/A
1N/AEach of these functions are called without arguments and return the
1N/Aabsolute path of the current working directory.
1N/A
1N/A=over 4
1N/A
1N/A=item getcwd
1N/A
1N/A my $cwd = getcwd();
1N/A
1N/AReturns the current working directory.
1N/A
1N/ARe-implements the getcwd(3) (or getwd(3)) functions in Perl.
1N/A
1N/A=item cwd
1N/A
1N/A my $cwd = cwd();
1N/A
1N/AThe cwd() is the most natural form for the current architecture. For
1N/Amost systems it is identical to `pwd` (but without the trailing line
1N/Aterminator).
1N/A
1N/A=item fastcwd
1N/A
1N/A my $cwd = fastcwd();
1N/A
1N/AA more dangerous version of getcwd(), but potentially faster.
1N/A
1N/AIt might conceivably chdir() you out of a directory that it can't
1N/Achdir() you back into. If fastcwd encounters a problem it will return
1N/Aundef but will probably leave you in a different directory. For a
1N/Ameasure of extra security, if everything appears to have worked, the
1N/Afastcwd() function will check that it leaves you in the same directory
1N/Athat it started in. If it has changed it will C<die> with the message
1N/A"Unstable directory path, current directory changed
1N/Aunexpectedly". That should never happen.
1N/A
1N/A=item fastgetcwd
1N/A
1N/A my $cwd = fastgetcwd();
1N/A
1N/AThe fastgetcwd() function is provided as a synonym for cwd().
1N/A
1N/A=back
1N/A
1N/A
1N/A=head2 abs_path and friends
1N/A
1N/AThese functions are exported only on request. They each take a single
1N/Aargument and return the absolute pathname for it. If no argument is
1N/Agiven they'll use the current working directory.
1N/A
1N/A=over 4
1N/A
1N/A=item abs_path
1N/A
1N/A my $abs_path = abs_path($file);
1N/A
1N/AUses the same algorithm as getcwd(). Symbolic links and relative-path
1N/Acomponents ("." and "..") are resolved to return the canonical
1N/Apathname, just like realpath(3).
1N/A
1N/A=item realpath
1N/A
1N/A my $abs_path = realpath($file);
1N/A
1N/AA synonym for abs_path().
1N/A
1N/A=item fast_abs_path
1N/A
1N/A my $abs_path = fast_abs_path($file);
1N/A
1N/AA more dangerous, but potentially faster version of abs_path.
1N/A
1N/A=back
1N/A
1N/A=head2 $ENV{PWD}
1N/A
1N/AIf you ask to override your chdir() built-in function,
1N/A
1N/A use Cwd qw(chdir);
1N/A
1N/Athen your PWD environment variable will be kept up to date. Note that
1N/Ait will only be kept up to date if all packages which use chdir import
1N/Ait from Cwd.
1N/A
1N/A
1N/A=head1 NOTES
1N/A
1N/A=over 4
1N/A
1N/A=item *
1N/A
1N/ASince the path seperators are different on some operating systems ('/'
1N/Aon Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
1N/Amodules wherever portability is a concern.
1N/A
1N/A=item *
1N/A
1N/AActually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
1N/Afunctions are all aliases for the C<cwd()> function, which, on Mac OS,
1N/Acalls `pwd`. Likewise, the C<abs_path()> function is an alias for
1N/AC<fast_abs_path()>.
1N/A
1N/A=back
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AOriginally by the perl5-porters.
1N/A
1N/ANow maintained by Ken Williams <KWILLIAMS@cpan.org>
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/AL<File::chdir>
1N/A
1N/A=cut
1N/A
1N/Ause strict;
1N/Ause Exporter;
1N/Ause vars qw(@ISA @EXPORT @EXPORT_OK);
1N/A
1N/A@ISA = qw/ Exporter /;
1N/A@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
1N/A@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
1N/A
1N/A# sys_cwd may keep the builtin command
1N/A
1N/A# All the functionality of this module may provided by builtins,
1N/A# there is no sense to process the rest of the file.
1N/A# The best choice may be to have this in BEGIN, but how to return from BEGIN?
1N/A
1N/Aif ($^O eq 'os2') {
1N/A local $^W = 0;
1N/A
1N/A *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
1N/A *getcwd = \&cwd;
1N/A *fastgetcwd = \&cwd;
1N/A *fastcwd = \&cwd;
1N/A
1N/A *fast_abs_path = \&sys_abspath if defined &sys_abspath;
1N/A *abs_path = \&fast_abs_path;
1N/A *realpath = \&fast_abs_path;
1N/A *fast_realpath = \&fast_abs_path;
1N/A
1N/A return 1;
1N/A}
1N/A
1N/Aeval {
1N/A require XSLoader;
1N/A local $^W = 0;
1N/A XSLoader::load('Cwd');
1N/A};
1N/A
1N/A
1N/A# Find the pwd command in the expected locations. We assume these
1N/A# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
1N/A# so everything works under taint mode.
1N/Amy $pwd_cmd;
1N/Aforeach my $try ('/bin/pwd',
1N/A '/usr/bin/pwd',
1N/A '/QOpenSys/bin/pwd', # OS/400 PASE.
1N/A ) {
1N/A
1N/A if( -x $try ) {
1N/A $pwd_cmd = $try;
1N/A last;
1N/A }
1N/A}
1N/Aunless ($pwd_cmd) {
1N/A # Isn't this wrong? _backtick_pwd() will fail if somenone has
1N/A # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
1N/A # See [perl #16774]. --jhi
1N/A $pwd_cmd = 'pwd';
1N/A}
1N/A
1N/A# Lazy-load Carp
1N/Asub _carp { require Carp; Carp::carp(@_) }
1N/Asub _croak { require Carp; Carp::croak(@_) }
1N/A
1N/A# The 'natural and safe form' for UNIX (pwd may be setuid root)
1N/Asub _backtick_pwd {
1N/A local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
1N/A my $cwd = `$pwd_cmd`;
1N/A # Belt-and-suspenders in case someone said "undef $/".
1N/A local $/ = "\n";
1N/A # `pwd` may fail e.g. if the disk is full
1N/A chomp($cwd) if defined $cwd;
1N/A $cwd;
1N/A}
1N/A
1N/A# Since some ports may predefine cwd internally (e.g., NT)
1N/A# we take care not to override an existing definition for cwd().
1N/A
1N/Aunless(defined &cwd) {
1N/A # The pwd command is not available in some chroot(2)'ed environments
1N/A if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
1N/A grep { -x "$_/pwd" } split(':', $ENV{PATH})) )
1N/A {
1N/A *cwd = \&_backtick_pwd;
1N/A }
1N/A else {
1N/A *cwd = \&getcwd;
1N/A }
1N/A}
1N/A
1N/A# set a reasonable (and very safe) default for fastgetcwd, in case it
1N/A# isn't redefined later (20001212 rspier)
1N/A*fastgetcwd = \&cwd;
1N/A
1N/A# By Brandon S. Allbery
1N/A#
1N/A# Usage: $cwd = getcwd();
1N/A
1N/Asub getcwd
1N/A{
1N/A abs_path('.');
1N/A}
1N/A
1N/A
1N/A# By John Bazik
1N/A#
1N/A# Usage: $cwd = &fastcwd;
1N/A#
1N/A# This is a faster version of getcwd. It's also more dangerous because
1N/A# you might chdir out of a directory that you can't chdir back into.
1N/A
1N/Asub fastcwd {
1N/A my($odev, $oino, $cdev, $cino, $tdev, $tino);
1N/A my(@path, $path);
1N/A local(*DIR);
1N/A
1N/A my($orig_cdev, $orig_cino) = stat('.');
1N/A ($cdev, $cino) = ($orig_cdev, $orig_cino);
1N/A for (;;) {
1N/A my $direntry;
1N/A ($odev, $oino) = ($cdev, $cino);
1N/A CORE::chdir('..') || return undef;
1N/A ($cdev, $cino) = stat('.');
1N/A last if $odev == $cdev && $oino == $cino;
1N/A opendir(DIR, '.') || return undef;
1N/A for (;;) {
1N/A $direntry = readdir(DIR);
1N/A last unless defined $direntry;
1N/A next if $direntry eq '.';
1N/A next if $direntry eq '..';
1N/A
1N/A ($tdev, $tino) = lstat($direntry);
1N/A last unless $tdev != $odev || $tino != $oino;
1N/A }
1N/A closedir(DIR);
1N/A return undef unless defined $direntry; # should never happen
1N/A unshift(@path, $direntry);
1N/A }
1N/A $path = '/' . join('/', @path);
1N/A if ($^O eq 'apollo') { $path = "/".$path; }
1N/A # At this point $path may be tainted (if tainting) and chdir would fail.
1N/A # Untaint it then check that we landed where we started.
1N/A $path =~ /^(.*)\z/s # untaint
1N/A && CORE::chdir($1) or return undef;
1N/A ($cdev, $cino) = stat('.');
1N/A die "Unstable directory path, current directory changed unexpectedly"
1N/A if $cdev != $orig_cdev || $cino != $orig_cino;
1N/A $path;
1N/A}
1N/A
1N/A
1N/A# Keeps track of current working directory in PWD environment var
1N/A# Usage:
1N/A# use Cwd 'chdir';
1N/A# chdir $newdir;
1N/A
1N/Amy $chdir_init = 0;
1N/A
1N/Asub chdir_init {
1N/A if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
1N/A my($dd,$di) = stat('.');
1N/A my($pd,$pi) = stat($ENV{'PWD'});
1N/A if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
1N/A $ENV{'PWD'} = cwd();
1N/A }
1N/A }
1N/A else {
1N/A my $wd = cwd();
1N/A $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
1N/A $ENV{'PWD'} = $wd;
1N/A }
1N/A # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
1N/A if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
1N/A my($pd,$pi) = stat($2);
1N/A my($dd,$di) = stat($1);
1N/A if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
1N/A $ENV{'PWD'}="$2$3";
1N/A }
1N/A }
1N/A $chdir_init = 1;
1N/A}
1N/A
1N/Asub chdir {
1N/A my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
1N/A $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
1N/A chdir_init() unless $chdir_init;
1N/A my $newpwd;
1N/A if ($^O eq 'MSWin32') {
1N/A # get the full path name *before* the chdir()
1N/A $newpwd = Win32::GetFullPathName($newdir);
1N/A }
1N/A
1N/A return 0 unless CORE::chdir $newdir;
1N/A
1N/A if ($^O eq 'VMS') {
1N/A return $ENV{'PWD'} = $ENV{'DEFAULT'}
1N/A }
1N/A elsif ($^O eq 'MacOS') {
1N/A return $ENV{'PWD'} = cwd();
1N/A }
1N/A elsif ($^O eq 'MSWin32') {
1N/A $ENV{'PWD'} = $newpwd;
1N/A return 1;
1N/A }
1N/A
1N/A if ($newdir =~ m#^/#s) {
1N/A $ENV{'PWD'} = $newdir;
1N/A } else {
1N/A my @curdir = split(m#/#,$ENV{'PWD'});
1N/A @curdir = ('') unless @curdir;
1N/A my $component;
1N/A foreach $component (split(m#/#, $newdir)) {
1N/A next if $component eq '.';
1N/A pop(@curdir),next if $component eq '..';
1N/A push(@curdir,$component);
1N/A }
1N/A $ENV{'PWD'} = join('/',@curdir) || '/';
1N/A }
1N/A 1;
1N/A}
1N/A
1N/A
1N/A# In case the XS version doesn't load.
1N/A*abs_path = \&_perl_abs_path unless defined &abs_path;
1N/Asub _perl_abs_path
1N/A{
1N/A my $start = @_ ? shift : '.';
1N/A my($dotdots, $cwd, @pst, @cst, $dir, @tst);
1N/A
1N/A unless (@cst = stat( $start ))
1N/A {
1N/A _carp("stat($start): $!");
1N/A return '';
1N/A }
1N/A $cwd = '';
1N/A $dotdots = $start;
1N/A do
1N/A {
1N/A $dotdots .= '/..';
1N/A @pst = @cst;
1N/A local *PARENT;
1N/A unless (opendir(PARENT, $dotdots))
1N/A {
1N/A _carp("opendir($dotdots): $!");
1N/A return '';
1N/A }
1N/A unless (@cst = stat($dotdots))
1N/A {
1N/A _carp("stat($dotdots): $!");
1N/A closedir(PARENT);
1N/A return '';
1N/A }
1N/A if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
1N/A {
1N/A $dir = undef;
1N/A }
1N/A else
1N/A {
1N/A do
1N/A {
1N/A unless (defined ($dir = readdir(PARENT)))
1N/A {
1N/A _carp("readdir($dotdots): $!");
1N/A closedir(PARENT);
1N/A return '';
1N/A }
1N/A $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
1N/A }
1N/A while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
1N/A $tst[1] != $pst[1]);
1N/A }
1N/A $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
1N/A closedir(PARENT);
1N/A } while (defined $dir);
1N/A chop($cwd) unless $cwd eq '/'; # drop the trailing /
1N/A $cwd;
1N/A}
1N/A
1N/A
1N/A# added function alias for those of us more
1N/A# used to the libc function. --tchrist 27-Jan-00
1N/A*realpath = \&abs_path;
1N/A
1N/Amy $Curdir;
1N/Asub fast_abs_path {
1N/A my $cwd = getcwd();
1N/A require File::Spec;
1N/A my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
1N/A
1N/A # Detaint else we'll explode in taint mode. This is safe because
1N/A # we're not doing anything dangerous with it.
1N/A ($path) = $path =~ /(.*)/;
1N/A ($cwd) = $cwd =~ /(.*)/;
1N/A
1N/A if (!CORE::chdir($path)) {
1N/A _croak("Cannot chdir to $path: $!");
1N/A }
1N/A my $realpath = getcwd();
1N/A if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
1N/A _croak("Cannot chdir back to $cwd: $!");
1N/A }
1N/A $realpath;
1N/A}
1N/A
1N/A# added function alias to follow principle of least surprise
1N/A# based on previous aliasing. --tchrist 27-Jan-00
1N/A*fast_realpath = \&fast_abs_path;
1N/A
1N/A
1N/A# --- PORTING SECTION ---
1N/A
1N/A# VMS: $ENV{'DEFAULT'} points to default directory at all times
1N/A# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
1N/A# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
1N/A# in the process logical name table as the default device and directory
1N/A# seen by Perl. This may not be the same as the default device
1N/A# and directory seen by DCL after Perl exits, since the effects
1N/A# the CRTL chdir() function persist only until Perl exits.
1N/A
1N/Asub _vms_cwd {
1N/A return $ENV{'DEFAULT'};
1N/A}
1N/A
1N/Asub _vms_abs_path {
1N/A return $ENV{'DEFAULT'} unless @_;
1N/A my $path = VMS::Filespec::pathify($_[0]);
1N/A if (! defined $path)
1N/A {
1N/A _croak("Invalid path name $_[0]")
1N/A }
1N/A return VMS::Filespec::rmsexpand($path);
1N/A}
1N/A
1N/Asub _os2_cwd {
1N/A $ENV{'PWD'} = `cmd /c cd`;
1N/A chomp $ENV{'PWD'};
1N/A $ENV{'PWD'} =~ s:\\:/:g ;
1N/A return $ENV{'PWD'};
1N/A}
1N/A
1N/Asub _win32_cwd {
1N/A $ENV{'PWD'} = Win32::GetCwd();
1N/A $ENV{'PWD'} =~ s:\\:/:g ;
1N/A return $ENV{'PWD'};
1N/A}
1N/A
1N/A*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
1N/A defined &Win32::GetCwd);
1N/A
1N/A*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
1N/A
1N/Asub _dos_cwd {
1N/A if (!defined &Dos::GetCwd) {
1N/A $ENV{'PWD'} = `command /c cd`;
1N/A chomp $ENV{'PWD'};
1N/A $ENV{'PWD'} =~ s:\\:/:g ;
1N/A } else {
1N/A $ENV{'PWD'} = Dos::GetCwd();
1N/A }
1N/A return $ENV{'PWD'};
1N/A}
1N/A
1N/Asub _qnx_cwd {
1N/A local $ENV{PATH} = '';
1N/A local $ENV{CDPATH} = '';
1N/A local $ENV{ENV} = '';
1N/A $ENV{'PWD'} = `/usr/bin/fullpath -t`;
1N/A chomp $ENV{'PWD'};
1N/A return $ENV{'PWD'};
1N/A}
1N/A
1N/Asub _qnx_abs_path {
1N/A local $ENV{PATH} = '';
1N/A local $ENV{CDPATH} = '';
1N/A local $ENV{ENV} = '';
1N/A my $path = @_ ? shift : '.';
1N/A local *REALPATH;
1N/A
1N/A open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or
1N/A die "Can't open /usr/bin/fullpath: $!";
1N/A my $realpath = <REALPATH>;
1N/A close REALPATH;
1N/A chomp $realpath;
1N/A return $realpath;
1N/A}
1N/A
1N/Asub _epoc_cwd {
1N/A $ENV{'PWD'} = EPOC::getcwd();
1N/A return $ENV{'PWD'};
1N/A}
1N/A
1N/A{
1N/A no warnings; # assignments trigger 'subroutine redefined' warning
1N/A
1N/A if ($^O eq 'VMS') {
1N/A *cwd = \&_vms_cwd;
1N/A *getcwd = \&_vms_cwd;
1N/A *fastcwd = \&_vms_cwd;
1N/A *fastgetcwd = \&_vms_cwd;
1N/A *abs_path = \&_vms_abs_path;
1N/A *fast_abs_path = \&_vms_abs_path;
1N/A }
1N/A elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
1N/A # We assume that &_NT_cwd is defined as an XSUB or in the core.
1N/A *cwd = \&_NT_cwd;
1N/A *getcwd = \&_NT_cwd;
1N/A *fastcwd = \&_NT_cwd;
1N/A *fastgetcwd = \&_NT_cwd;
1N/A *abs_path = \&fast_abs_path;
1N/A *realpath = \&fast_abs_path;
1N/A }
1N/A elsif ($^O eq 'dos') {
1N/A *cwd = \&_dos_cwd;
1N/A *getcwd = \&_dos_cwd;
1N/A *fastgetcwd = \&_dos_cwd;
1N/A *fastcwd = \&_dos_cwd;
1N/A *abs_path = \&fast_abs_path;
1N/A }
1N/A elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
1N/A *cwd = \&_qnx_cwd;
1N/A *getcwd = \&_qnx_cwd;
1N/A *fastgetcwd = \&_qnx_cwd;
1N/A *fastcwd = \&_qnx_cwd;
1N/A *abs_path = \&_qnx_abs_path;
1N/A *fast_abs_path = \&_qnx_abs_path;
1N/A }
1N/A elsif ($^O eq 'cygwin') {
1N/A *getcwd = \&cwd;
1N/A *fastgetcwd = \&cwd;
1N/A *fastcwd = \&cwd;
1N/A *abs_path = \&fast_abs_path;
1N/A *realpath = \&abs_path;
1N/A }
1N/A elsif ($^O eq 'epoc') {
1N/A *cwd = \&_epoc_cwd;
1N/A *getcwd = \&_epoc_cwd;
1N/A *fastgetcwd = \&_epoc_cwd;
1N/A *fastcwd = \&_epoc_cwd;
1N/A *abs_path = \&fast_abs_path;
1N/A }
1N/A elsif ($^O eq 'MacOS') {
1N/A *getcwd = \&cwd;
1N/A *fastgetcwd = \&cwd;
1N/A *fastcwd = \&cwd;
1N/A *abs_path = \&fast_abs_path;
1N/A }
1N/A}
1N/A
1N/A
1N/A1;