[p5sagit/p5-mst-13.2.git] / lib / Cwd.pm

package Cwd;
require 5.6.0;

=head1 NAME

Cwd - get pathname of current working directory

=head1 SYNOPSIS

    use Cwd;
    $dir = cwd;

    use Cwd;
    $dir = getcwd;

    use Cwd;
    $dir = fastcwd;

    use Cwd;
    $dir = fastgetcwd;

    use Cwd 'chdir';
    chdir "/tmp";
    print $ENV{'PWD'};

    use Cwd 'abs_path';	    # aka realpath()
    print abs_path($ENV{'PWD'});

    use Cwd 'fast_abs_path';
    print fast_abs_path($ENV{'PWD'});

=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 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
encounters a problem it will return undef but will probably leave you
in a different directory.  For a measure of extra security, if
everything appears to have worked, the fastcwd() function will check
that it leaves you in the same directory that it started in. If it has
changed it will C<die> with the message "Unstable directory path,
current directory changed unexpectedly". That should never happen.

The fastgetcwd() function is provided as a synonym for cwd().

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().

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
L<perlsub/Overriding Builtin Functions>.) Note that it will only be
kept up to date if all packages which use chdir import it from Cwd.

=head1 NOTES

=over 4

=item *

On Mac OS (Classic), the path separator is ':', not '/', and the 
current directory is denoted as ':', not '.'. To move up the directory 
tree, you will use '::' to move up one level, but ':::' and so on to 
move up the tree two or more levels (i.e. the equivalent to '../../..'
is '::::'). Generally, you should be careful about specifying relative pathnames. 
While a full path always begins with a volume name, a relative pathname 
should always begin with a ':'.  If specifying a volume name only, a 
trailing ':' is required.

Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
functions  are all aliases for the C<cwd()> function, which, on Mac OS,
calls `pwd`. Likewise, the C<abs_path()> function is an alias for
C<fast_abs_path()>.

=back

=cut

use strict;

use Carp;

our $VERSION = '2.05';

use base qw/ Exporter /;
our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);

# sys_cwd may keep the builtin command

# All the functionality of this module may provided by builtins,
# 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) {
    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;
    return 1;
}

eval {
    require XSLoader;
    XSLoader::load('Cwd');
};


# Find the pwd command in the expected locations.  We assume these
# 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)) {
    if( -x $try ) {
        $pwd_cmd = $try;
        last;
    }
}
$pwd_cmd ||= 'pwd';

# The 'natural and safe form' for UNIX (pwd may be setuid root)
sub _backtick_pwd {
    my $cwd = `$pwd_cmd`;
    # `pwd` may fail e.g. if the disk is full
    chomp($cwd) if defined $cwd;
    $cwd;
}

# Since some ports may predefine cwd internally (e.g., NT)
# we take care not to override an existing definition for 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})) {
	*cwd = \&_backtick_pwd;
    }
    else {
	*cwd = \&getcwd;
    }
}

# set a reasonable (and very safe) default for fastgetcwd, in case it
# isn't redefined later (20001212 rspier)
*fastgetcwd = \&cwd;

# By Brandon S. Allbery
#
# Usage: $cwd = getcwd();

sub getcwd
{
    abs_path('.');
}

# Keeps track of current working directory in PWD environment var
# Usage:
#	use Cwd 'chdir';
#	chdir $newdir;

my $chdir_init = 0;

sub chdir_init {
    if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
	my($dd,$di) = stat('.');
	my($pd,$pi) = stat($ENV{'PWD'});
	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
	    $ENV{'PWD'} = cwd();
	}
    }
    else {
	my $wd = cwd();
	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
	$ENV{'PWD'} = $wd;
    }
    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
    if ($^O ne 'MSWin32' and $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) {
	    $ENV{'PWD'}="$2$3";
	}
    }
    $chdir_init = 1;
}

sub 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'} = $newpwd;
	return 1;
    }

    if ($newdir =~ m#^/#s) {
	$ENV{'PWD'} = $newdir;
    } else {
	my @curdir = split(m#/#,$ENV{'PWD'});
	@curdir = ('') unless @curdir;
	my $component;
	foreach $component (split(m#/#, $newdir)) {
	    next if $component eq '.';
	    pop(@curdir),next if $component eq '..';
	    push(@curdir,$component);
	}
	$ENV{'PWD'} = join('/',@curdir) || '/';
    }
    1;
}

# 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();
    require File::Spec;
    my $path = @_ ? shift : File::Spec->curdir;
    CORE::chdir($path) || croak "Cannot chdir to $path:$!";
    my $realpath = getcwd();
    CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
    $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@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
#   and directory seen by DCL after Perl exits, since the effects
#   the CRTL chdir() function persist only until Perl exits.

sub _vms_cwd {
    return $ENV{'DEFAULT'};
}

sub _vms_abs_path {
    return $ENV{'DEFAULT'} unless @_;
    my $path = VMS::Filespec::pathify($_[0]);
    croak("Invalid path name $_[0]") unless defined $path;
    return VMS::Filespec::rmsexpand($path);
}

sub _os2_cwd {
    $ENV{'PWD'} = `cmd /c cd`;
    chop $ENV{'PWD'};
    $ENV{'PWD'} =~ s:\\:/:g ;
    return $ENV{'PWD'};
}

sub _win32_cwd {
    $ENV{'PWD'} = Win32::GetCwd();
    $ENV{'PWD'} =~ s:\\:/:g ;
    return $ENV{'PWD'};
}

*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 
                            defined &Win32::GetCwd);

*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;

sub _dos_cwd {
    if (!defined &Dos::GetCwd) {
        $ENV{'PWD'} = `command /c cd`;
        chop $ENV{'PWD'};
        $ENV{'PWD'} =~ s:\\:/:g ;
    } else {
        $ENV{'PWD'} = Dos::GetCwd();
    }
    return $ENV{'PWD'};
}

sub _qnx_cwd {
    $ENV{'PWD'} = `/usr/bin/fullpath -t`;
    chop $ENV{'PWD'};
    return $ENV{'PWD'};
}

sub _qnx_abs_path {
    my $path = @_ ? shift : '.';
    my $realpath=`/usr/bin/fullpath -t $path`;
    chop $realpath;
    return $realpath;
}

sub _epoc_cwd {
    $ENV{'PWD'} = EPOC::getcwd();
    return $ENV{'PWD'};
}

{
    no warnings;	# assignments trigger 'subroutine redefined' warning

    if ($^O eq 'VMS') {
        *cwd		= \&_vms_cwd;
        *getcwd		= \&_vms_cwd;
        *fastcwd	= \&_vms_cwd;
        *fastgetcwd	= \&_vms_cwd;
        *abs_path	= \&_vms_abs_path;
        *fast_abs_path	= \&_vms_abs_path;
    }
    elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
        # We assume that &_NT_cwd is defined as an XSUB or in the core.
        *cwd		= \&_NT_cwd;
        *getcwd		= \&_NT_cwd;
        *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;
    }
    elsif ($^O eq 'dos') {
        *cwd		= \&_dos_cwd;
        *getcwd		= \&_dos_cwd;
        *fastgetcwd	= \&_dos_cwd;
        *fastcwd	= \&_dos_cwd;
        *abs_path	= \&fast_abs_path;
    }
    elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
        *cwd		= \&_qnx_cwd;
        *getcwd		= \&_qnx_cwd;
        *fastgetcwd	= \&_qnx_cwd;
        *fastcwd	= \&_qnx_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;
    }
    elsif ($^O eq 'epoc') {
        *cwd            = \&_epoc_cwd;
        *getcwd	        = \&_epoc_cwd;
        *fastgetcwd	= \&_epoc_cwd;
        *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

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";
Commit	Line	Data
a0d0e21e	1	package Cwd;
4d6b4052	2	require 5.6.0;
a0d0e21e	3
f06db76b	4	=head1 NAME
f06db76b	5
902bacac	6	Cwd - get pathname of current working directory
f06db76b	7
	8	=head1 SYNOPSIS
	9
4633a7c4	10	use Cwd;
	11	$dir = cwd;
	12
	13	use Cwd;
	14	$dir = getcwd;
f06db76b	15
f06db76b	16	use Cwd;
902bacac	17	$dir = fastcwd;
	18
	19	use Cwd;
4633a7c4	20	$dir = fastgetcwd;
f06db76b	21
	22	use Cwd 'chdir';
	23	chdir "/tmp";
	24	print $ENV{'PWD'};
	25
e4c51978	26	use Cwd 'abs_path'; # aka realpath()
20408e3c	27	print abs_path($ENV{'PWD'});
	28
	29	use Cwd 'fast_abs_path';
	30	print fast_abs_path($ENV{'PWD'});
	31
f06db76b	32	=head1 DESCRIPTION
f06db76b	33
902bacac	34	This module provides functions for determining the pathname of the
	35	current working directory. By default, it exports the functions
	36	cwd(), getcwd(), fastcwd(), and fastgetcwd() into the caller's
	37	namespace. Each of these functions are called without arguments and
	38	return the absolute path of the current working directory. It is
	39	recommended that cwd (or another *cwd() function) be used in I<all>
	40	code to ensure portability.
	41
	42	The cwd() is the most natural and safe form for the current
	43	architecture. For most systems it is identical to `pwd` (but without
	44	the trailing line terminator).
	45
f06db76b	46	The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
4633a7c4	47	in Perl.
f06db76b	48
cb1a09d0	49	The fastcwd() function looks the same as getcwd(), but runs faster.
fb73857a	50	It's also more dangerous because it might conceivably chdir() you out
	51	of a directory that it can't chdir() you back into. If fastcwd
	52	encounters a problem it will return undef but will probably leave you
	53	in a different directory. For a measure of extra security, if
	54	everything appears to have worked, the fastcwd() function will check
	55	that it leaves you in the same directory that it started in. If it has
	56	changed it will C<die> with the message "Unstable directory path,
	57	current directory changed unexpectedly". That should never happen.
f06db76b	58
902bacac	59	The fastgetcwd() function is provided as a synonym for cwd().
fb73857a	60
902bacac	61	The abs_path() function takes a single argument and returns the
	62	absolute pathname for that argument. It uses the same algorithm as
	63	getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links and
	64	relative-path components ("." and "..") are resolved to return the
	65	canonical pathname, just like realpath(3). This function is also
	66	callable as realpath().
	67
	68	The fast_abs_path() function looks the same as abs_path() but runs
	69	faster and, like fastcwd(), is more dangerous.
4633a7c4	70
	71	If you ask to override your chdir() built-in function, then your PWD
	72	environment variable will be kept up to date. (See
55497cff	73	L<perlsub/Overriding Builtin Functions>.) Note that it will only be
1fef88e7	74	kept up to date if all packages which use chdir import it from Cwd.
4633a7c4	75
4d6b4052	76	=head1 NOTES
	77
	78	=over 4
	79
	80	=item *
	81
	82	On Mac OS (Classic), the path separator is ':', not '/', and the
	83	current directory is denoted as ':', not '.'. To move up the directory
	84	tree, you will use '::' to move up one level, but ':::' and so on to
	85	move up the tree two or more levels (i.e. the equivalent to '../../..'
	86	is '::::'). Generally, you should be careful about specifying relative pathnames.
	87	While a full path always begins with a volume name, a relative pathname
	88	should always begin with a ':'. If specifying a volume name only, a
	89	trailing ':' is required.
	90
	91	Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
	92	functions are all aliases for the C<cwd()> function, which, on Mac OS,
	93	calls `pwd`. Likewise, the C<abs_path()> function is an alias for
	94	C<fast_abs_path()>.
	95
	96	=back
	97
f06db76b	98	=cut
f06db76b	99
b060a406	100	use strict;
96e4d5b1	101
	102	use Carp;
	103
4d6b4052	104	our $VERSION = '2.05';
96e4d5b1	105
b060a406	106	use base qw/ Exporter /;
	107	our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
	108	our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
a0d0e21e	109
f5f423e4	110	# sys_cwd may keep the builtin command
	111
	112	# All the functionality of this module may provided by builtins,
	113	# there is no sense to process the rest of the file.
	114	# The best choice may be to have this in BEGIN, but how to return from BEGIN?
	115
	116	if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
	117	local $^W = 0;
	118	*cwd = \&sys_cwd;
	119	*getcwd = \&cwd;
	120	*fastgetcwd = \&cwd;
	121	*fastcwd = \&cwd;
	122	*abs_path = \&sys_abspath;
	123	*fast_abs_path = \&abs_path;
	124	*realpath = \&abs_path;
	125	*fast_realpath = \&abs_path;
	126	return 1;
	127	}
	128
f22d8e4b	129	eval {
	130	require XSLoader;
	131	XSLoader::load('Cwd');
	132	};
4633a7c4	133
96e4d5b1	134
3547aa9a	135	# Find the pwd command in the expected locations. We assume these
	136	# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
	137	# so everything works under taint mode.
	138	my $pwd_cmd;
	139	foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
	140	if( -x $try ) {
	141	$pwd_cmd = $try;
	142	last;
	143	}
	144	}
	145	$pwd_cmd \|\|= 'pwd';
	146
	147	# The 'natural and safe form' for UNIX (pwd may be setuid root)
8b88ae92	148	sub _backtick_pwd {
3547aa9a	149	my $cwd = `$pwd_cmd`;
7e03f963	150	# `pwd` may fail e.g. if the disk is full
7e03f963	151	chomp($cwd) if defined $cwd;
4633a7c4	152	$cwd;
8b88ae92	153	}
4633a7c4	154
	155	# Since some ports may predefine cwd internally (e.g., NT)
	156	# we take care not to override an existing definition for cwd().
	157
ea54c8bd	158	unless(defined &cwd) {
ea54c8bd	159	# The pwd command is not available in some chroot(2)'ed environments
4aecb5b5	160	if($^O eq 'MacOS' \|\| grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
ea54c8bd	161	*cwd = \&_backtick_pwd;
	162	}
	163	else {
	164	*cwd = \&getcwd;
	165	}
	166	}
a0d0e21e	167
1f4f94f5	168	# set a reasonable (and very safe) default for fastgetcwd, in case it
	169	# isn't redefined later (20001212 rspier)
	170	*fastgetcwd = \&cwd;
748a9306	171
a0d0e21e	172	# By Brandon S. Allbery
	173	#
	174	# Usage: $cwd = getcwd();
	175
	176	sub getcwd
	177	{
07569ed3	178	abs_path('.');
a0d0e21e	179	}
a0d0e21e	180
4633a7c4	181	# Keeps track of current working directory in PWD environment var
a0d0e21e	182	# Usage:
	183	# use Cwd 'chdir';
	184	# chdir $newdir;
	185
4633a7c4	186	my $chdir_init = 0;
a0d0e21e	187
4633a7c4	188	sub chdir_init {
3b8e3443	189	if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e	190	my($dd,$di) = stat('.');
	191	my($pd,$pi) = stat($ENV{'PWD'});
	192	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4	193	$ENV{'PWD'} = cwd();
a0d0e21e	194	}
	195	}
	196	else {
3b8e3443	197	my $wd = cwd();
	198	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
	199	$ENV{'PWD'} = $wd;
a0d0e21e	200	}
4633a7c4	201	# Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443	202	if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m\|(/[^/]+(/[^/]+/[^/]+))(.*)\|s) {
a0d0e21e	203	my($pd,$pi) = stat($2);
	204	my($dd,$di) = stat($1);
	205	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
	206	$ENV{'PWD'}="$2$3";
	207	}
	208	}
	209	$chdir_init = 1;
	210	}
	211
	212	sub chdir {
22978713	213	my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
3b8e3443	214	$newdir =~ s\|///*\|/\|g unless $^O eq 'MSWin32';
a0d0e21e	215	chdir_init() unless $chdir_init;
4ffa1610	216	my $newpwd;
	217	if ($^O eq 'MSWin32') {
	218	# get the full path name before the chdir()
	219	$newpwd = Win32::GetFullPathName($newdir);
	220	}
	221
4633a7c4	222	return 0 unless CORE::chdir $newdir;
4ffa1610	223
3b8e3443	224	if ($^O eq 'VMS') {
	225	return $ENV{'PWD'} = $ENV{'DEFAULT'}
	226	}
4aecb5b5	227	elsif ($^O eq 'MacOS') {
	228	return $ENV{'PWD'} = cwd();
	229	}
3b8e3443	230	elsif ($^O eq 'MSWin32') {
4ffa1610	231	$ENV{'PWD'} = $newpwd;
3b8e3443	232	return 1;
3b8e3443	233	}
748a9306	234
392d8ab8	235	if ($newdir =~ m#^/#s) {
a0d0e21e	236	$ENV{'PWD'} = $newdir;
4633a7c4	237	} else {
	238	my @curdir = split(m#/#,$ENV{'PWD'});
	239	@curdir = ('') unless @curdir;
	240	my $component;
a0d0e21e	241	foreach $component (split(m#/#, $newdir)) {
	242	next if $component eq '.';
	243	pop(@curdir),next if $component eq '..';
	244	push(@curdir,$component);
	245	}
	246	$ENV{'PWD'} = join('/',@curdir) \|\| '/';
	247	}
4633a7c4	248	1;
a0d0e21e	249	}
a0d0e21e	250
e4c51978	251	# added function alias for those of us more
	252	# used to the libc function. --tchrist 27-Jan-00
	253	*realpath = \&abs_path;
	254
96e4d5b1	255	sub fast_abs_path {
96e4d5b1	256	my $cwd = getcwd();
4d6b4052	257	require File::Spec;
4d6b4052	258	my $path = @_ ? shift : File::Spec->curdir;
e79e61e4	259	CORE::chdir($path) \|\| croak "Cannot chdir to $path:$!";
96e4d5b1	260	my $realpath = getcwd();
e79e61e4	261	CORE::chdir($cwd) \|\| croak "Cannot chdir back to $cwd:$!";
96e4d5b1	262	$realpath;
8b88ae92	263	}
8b88ae92	264
e4c51978	265	# added function alias to follow principle of least surprise
	266	# based on previous aliasing. --tchrist 27-Jan-00
	267	*fast_realpath = \&fast_abs_path;
	268
4633a7c4	269
	270	# --- PORTING SECTION ---
	271
	272	# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c	273	# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72	274	# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92	275	# in the process logical name table as the default device and directory
8b88ae92	276	# seen by Perl. This may not be the same as the default device
4633a7c4	277	# and directory seen by DCL after Perl exits, since the effects
4633a7c4	278	# the CRTL chdir() function persist only until Perl exits.
4633a7c4	279
4633a7c4	280	sub _vms_cwd {
96e4d5b1	281	return $ENV{'DEFAULT'};
	282	}
	283
	284	sub _vms_abs_path {
	285	return $ENV{'DEFAULT'} unless @_;
	286	my $path = VMS::Filespec::pathify($_[0]);
	287	croak("Invalid path name $_[0]") unless defined $path;
	288	return VMS::Filespec::rmsexpand($path);
4633a7c4	289	}
68dc0745	290
4633a7c4	291	sub _os2_cwd {
	292	$ENV{'PWD'} = `cmd /c cd`;
	293	chop $ENV{'PWD'};
	294	$ENV{'PWD'} =~ s:\\:/:g ;
	295	return $ENV{'PWD'};
	296	}
	297
96e4d5b1	298	sub _win32_cwd {
2d7a9237	299	$ENV{'PWD'} = Win32::GetCwd();
96e4d5b1	300	$ENV{'PWD'} =~ s:\\:/:g ;
	301	return $ENV{'PWD'};
	302	}
	303
	304	*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237	305	defined &Win32::GetCwd);
96e4d5b1	306
96e4d5b1	307	*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745	308
39e571d4	309	sub _dos_cwd {
	310	if (!defined &Dos::GetCwd) {
	311	$ENV{'PWD'} = `command /c cd`;
	312	chop $ENV{'PWD'};
	313	$ENV{'PWD'} =~ s:\\:/:g ;
	314	} else {
	315	$ENV{'PWD'} = Dos::GetCwd();
	316	}
55497cff	317	return $ENV{'PWD'};
	318	}
	319
7fbf1995	320	sub _qnx_cwd {
	321	$ENV{'PWD'} = `/usr/bin/fullpath -t`;
	322	chop $ENV{'PWD'};
	323	return $ENV{'PWD'};
	324	}
	325
	326	sub _qnx_abs_path {
fa921dc6	327	my $path = @_ ? shift : '.';
7fbf1995	328	my $realpath=`/usr/bin/fullpath -t $path`;
	329	chop $realpath;
	330	return $realpath;
	331	}
	332
ed79a026	333	sub _epoc_cwd {
	334	$ENV{'PWD'} = EPOC::getcwd();
	335	return $ENV{'PWD'};
	336	}
	337
ac1ad7f0	338	{
db376a24	339	no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4	340
ac1ad7f0	341	if ($^O eq 'VMS') {
96e4d5b1	342	*cwd = \&_vms_cwd;
	343	*getcwd = \&_vms_cwd;
	344	*fastcwd = \&_vms_cwd;
	345	*fastgetcwd = \&_vms_cwd;
	346	*abs_path = \&_vms_abs_path;
	347	*fast_abs_path = \&_vms_abs_path;
ac1ad7f0	348	}
	349	elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
	350	# We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1	351	*cwd = \&_NT_cwd;
	352	*getcwd = \&_NT_cwd;
	353	*fastcwd = \&_NT_cwd;
	354	*fastgetcwd = \&_NT_cwd;
	355	*abs_path = \&fast_abs_path;
ac1ad7f0	356	}
	357	elsif ($^O eq 'os2') {
	358	# sys_cwd may keep the builtin command
96e4d5b1	359	*cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
	360	*getcwd = \&cwd;
	361	*fastgetcwd = \&cwd;
	362	*fastcwd = \&cwd;
	363	*abs_path = \&fast_abs_path;
ac1ad7f0	364	}
39e571d4	365	elsif ($^O eq 'dos') {
	366	*cwd = \&_dos_cwd;
	367	*getcwd = \&_dos_cwd;
	368	*fastgetcwd = \&_dos_cwd;
	369	*fastcwd = \&_dos_cwd;
96e4d5b1	370	*abs_path = \&fast_abs_path;
ac1ad7f0	371	}
7438b6ad	372	elsif ($^O =~ m/^(?:qnx\|nto)$/ ) {
7fbf1995	373	*cwd = \&_qnx_cwd;
	374	*getcwd = \&_qnx_cwd;
	375	*fastgetcwd = \&_qnx_cwd;
	376	*fastcwd = \&_qnx_cwd;
	377	*abs_path = \&_qnx_abs_path;
	378	*fast_abs_path = \&_qnx_abs_path;
	379	}
4fabb596	380	elsif ($^O eq 'cygwin') {
1cab015a	381	*getcwd = \&cwd;
	382	*fastgetcwd = \&cwd;
	383	*fastcwd = \&cwd;
	384	*abs_path = \&fast_abs_path;
	385	}
ed79a026	386	elsif ($^O eq 'epoc') {
fa6a1c44	387	*cwd = \&_epoc_cwd;
fa6a1c44	388	*getcwd = \&_epoc_cwd;
ed79a026	389	*fastgetcwd = \&_epoc_cwd;
	390	*fastcwd = \&_epoc_cwd;
	391	*abs_path = \&fast_abs_path;
	392	}
4aecb5b5	393	elsif ($^O eq 'MacOS') {
	394	*getcwd = \&cwd;
	395	*fastgetcwd = \&cwd;
	396	*fastcwd = \&cwd;
	397	*abs_path = \&fast_abs_path;
	398	}
55497cff	399	}
4633a7c4	400
	401	# package main; eval join('',<DATA>) \|\| die $@; # quick test
	402
a0d0e21e	403	1;
a0d0e21e	404
4633a7c4	405	__END__
	406	BEGIN { import Cwd qw(:DEFAULT chdir); }
	407	print join("\n", cwd, getcwd, fastcwd, "");
	408	chdir('..');
	409	print join("\n", cwd, getcwd, fastcwd, "");
	410	print "$ENV{PWD}\n";