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

package Cwd;
require 5.000;

=head1 NAME

getcwd - get pathname of current working directory

=head1 SYNOPSIS

    use Cwd;
    $dir = cwd;

    use Cwd;
    $dir = getcwd;

    use Cwd;
    $dir = fastgetcwd;

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

=head1 DESCRIPTION

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 you might conceivably chdir() out of a
directory that you can't chdir() back into.

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). It is recommended that cwd (or another
*cwd() function) is used in I<all> code to ensure portability.

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.

=cut

## use strict;

use Carp;

$VERSION = '2.00';

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@EXPORT_OK = qw(chdir abs_path fast_abs_path);


# The 'natural and safe form' for UNIX (pwd may be setuid root)

sub _backtick_pwd {
    my $cwd;
    chop($cwd = `pwd`);
    $cwd;
}

# Since some ports may predefine cwd internally (e.g., NT)
# we take care not to override an existing definition for cwd().

*cwd = \&_backtick_pwd unless defined &cwd;


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

sub getcwd
{
    my($dotdots, $cwd, @pst, @cst, $dir, @tst);

    unless (@cst = stat('.'))
    {
	warn "stat(.): $!";
	return '';
    }
    $cwd = '';
    $dotdots = '';
    do
    {
	$dotdots .= '/' if $dotdots;
	$dotdots .= '..';
	@pst = @cst;
	unless (opendir(PARENT, $dotdots))
	{
	    warn "opendir($dotdots): $!";
	    return '';
	}
	unless (@cst = stat($dotdots))
	{
	    warn "stat($dotdots): $!";
	    closedir(PARENT);
	    return '';
	}
	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
	{
	    $dir = '';
	}
	else
	{
	    do
	    {
		unless (defined ($dir = readdir(PARENT)))
	        {
		    warn "readdir($dotdots): $!";
		    closedir(PARENT);
		    return '';
		}
		unless (@tst = lstat("$dotdots/$dir"))
		{
		    # warn "lstat($dotdots/$dir): $!";
		    # Just because you can't lstat this directory
		    # doesn't mean you'll never find the right one.
		    # closedir(PARENT);
		    # return '';
		}
	    }
	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
		   $tst[1] != $pst[1]);
	}
	$cwd = "$dir/$cwd";
	closedir(PARENT);
    } while ($dir);
    chop($cwd) unless $cwd eq '/'; # drop the trailing /
    $cwd;
}


# 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);

    ($cdev, $cino) = stat('.');
    for (;;) {
	my $direntry;
	($odev, $oino) = ($cdev, $cino);
	chdir('..');
	($cdev, $cino) = stat('.');
	last if $odev == $cdev && $oino == $cino;
	opendir(DIR, '.');
	for (;;) {
	    $direntry = readdir(DIR);
	    next if $direntry eq '.';
	    next if $direntry eq '..';

	    last unless defined $direntry;
	    ($tdev, $tino) = lstat($direntry);
	    last unless $tdev != $odev || $tino != $oino;
	}
	closedir(DIR);
	unshift(@path, $direntry);
    }
    chdir($path = '/' . join('/', @path));
    $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 'msdos') {
	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 {
	$ENV{'PWD'} = cwd();
    }
    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
	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;
    chdir_init() unless $chdir_init;
    return 0 unless CORE::chdir $newdir;
    if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }

    if ($newdir =~ m#^/#) {
	$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;
}

# 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 = '';
	}
	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 = "$dir/$cwd";
	closedir(PARENT);
    } while ($dir);
    chop($cwd); # drop the trailing /
    $cwd;
}

sub fast_abs_path {
    my $cwd = getcwd();
    my $path = shift || '.';
    chdir($path) || croak "Cannot chdir to $path:$!";
    my $realpath = getcwd();
    chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
    $realpath;
}


# --- PORTING SECTION ---

# VMS: $ENV{'DEFAULT'} points to default directory at all times
# 06-Mar-1996  Charles Bailey  bailey@genetics.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::GetCurrentDirectory();
    $ENV{'PWD'} =~ s:\\:/:g ;
    return $ENV{'PWD'};
}

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

*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;

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

{
    local $^W = 0;	# 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 'msdos') {
        *cwd		= \&_msdos_cwd;
        *getcwd		= \&_msdos_cwd;
        *fastgetcwd	= \&_msdos_cwd;
        *fastcwd	= \&_msdos_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;
a0d0e21e	2	require 5.000;
a0d0e21e	3
f06db76b	4	=head1 NAME
	5
	6	getcwd - get pathname of current working directory
	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;
4633a7c4	17	$dir = fastgetcwd;
f06db76b	18
	19	use Cwd 'chdir';
	20	chdir "/tmp";
	21	print $ENV{'PWD'};
	22
	23	=head1 DESCRIPTION
	24
	25	The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
4633a7c4	26	in Perl.
f06db76b	27
cb1a09d0	28	The fastcwd() function looks the same as getcwd(), but runs faster.
f06db76b	29	It's also more dangerous because you might conceivably chdir() out of a
	30	directory that you can't chdir() back into.
	31
4633a7c4	32	The cwd() function looks the same as getcwd and fastgetcwd but is
	33	implemented using the most natural and safe form for the current
	34	architecture. For most systems it is identical to `pwd` (but without
	35	the trailing line terminator). It is recommended that cwd (or another
	36	*cwd() function) is used in I<all> code to ensure portability.
	37
	38	If you ask to override your chdir() built-in function, then your PWD
	39	environment variable will be kept up to date. (See
55497cff	40	L<perlsub/Overriding Builtin Functions>.) Note that it will only be
1fef88e7	41	kept up to date if all packages which use chdir import it from Cwd.
4633a7c4	42
f06db76b	43	=cut
f06db76b	44
96e4d5b1	45	## use strict;
	46
	47	use Carp;
	48
	49	$VERSION = '2.00';
	50
	51	require Exporter;
a0d0e21e	52	@ISA = qw(Exporter);
e7ae0116	53	@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
96e4d5b1	54	@EXPORT_OK = qw(chdir abs_path fast_abs_path);
a0d0e21e	55
4633a7c4	56
8b88ae92	57	# The 'natural and safe form' for UNIX (pwd may be setuid root)
96e4d5b1	58
8b88ae92	59	sub _backtick_pwd {
4633a7c4	60	my $cwd;
	61	chop($cwd = `pwd`);
	62	$cwd;
8b88ae92	63	}
4633a7c4	64
	65	# Since some ports may predefine cwd internally (e.g., NT)
	66	# we take care not to override an existing definition for cwd().
	67
	68	*cwd = \&_backtick_pwd unless defined &cwd;
a0d0e21e	69
748a9306	70
a0d0e21e	71	# By Brandon S. Allbery
	72	#
	73	# Usage: $cwd = getcwd();
	74
	75	sub getcwd
	76	{
	77	my($dotdots, $cwd, @pst, @cst, $dir, @tst);
	78
	79	unless (@cst = stat('.'))
	80	{
	81	warn "stat(.): $!";
	82	return '';
	83	}
	84	$cwd = '';
42793c05	85	$dotdots = '';
a0d0e21e	86	do
	87	{
	88	$dotdots .= '/' if $dotdots;
	89	$dotdots .= '..';
	90	@pst = @cst;
	91	unless (opendir(PARENT, $dotdots))
	92	{
	93	warn "opendir($dotdots): $!";
	94	return '';
	95	}
	96	unless (@cst = stat($dotdots))
	97	{
	98	warn "stat($dotdots): $!";
	99	closedir(PARENT);
	100	return '';
	101	}
	102	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
	103	{
	104	$dir = '';
	105	}
	106	else
	107	{
	108	do
	109	{
3edbfbe5	110	unless (defined ($dir = readdir(PARENT)))
3edbfbe5	111	{
a0d0e21e	112	warn "readdir($dotdots): $!";
	113	closedir(PARENT);
	114	return '';
	115	}
	116	unless (@tst = lstat("$dotdots/$dir"))
	117	{
55497cff	118	# warn "lstat($dotdots/$dir): $!";
37120919	119	# Just because you can't lstat this directory
	120	# doesn't mean you'll never find the right one.
	121	# closedir(PARENT);
	122	# return '';
a0d0e21e	123	}
	124	}
	125	while ($dir eq '.' \|\| $dir eq '..' \|\| $tst[0] != $pst[0] \|\|
	126	$tst[1] != $pst[1]);
	127	}
	128	$cwd = "$dir/$cwd";
	129	closedir(PARENT);
	130	} while ($dir);
f6c18ff1	131	chop($cwd) unless $cwd eq '/'; # drop the trailing /
a0d0e21e	132	$cwd;
	133	}
	134
	135
	136
	137	# By John Bazik
	138	#
	139	# Usage: $cwd = &fastcwd;
	140	#
	141	# This is a faster version of getcwd. It's also more dangerous because
	142	# you might chdir out of a directory that you can't chdir back into.
	143
	144	sub fastcwd {
	145	my($odev, $oino, $cdev, $cino, $tdev, $tino);
	146	my(@path, $path);
	147	local(*DIR);
	148
	149	($cdev, $cino) = stat('.');
	150	for (;;) {
40000a8c	151	my $direntry;
a0d0e21e	152	($odev, $oino) = ($cdev, $cino);
	153	chdir('..');
	154	($cdev, $cino) = stat('.');
	155	last if $odev == $cdev && $oino == $cino;
	156	opendir(DIR, '.');
	157	for (;;) {
40000a8c	158	$direntry = readdir(DIR);
	159	next if $direntry eq '.';
	160	next if $direntry eq '..';
a0d0e21e	161
40000a8c	162	last unless defined $direntry;
40000a8c	163	($tdev, $tino) = lstat($direntry);
a0d0e21e	164	last unless $tdev != $odev \|\| $tino != $oino;
	165	}
	166	closedir(DIR);
40000a8c	167	unshift(@path, $direntry);
a0d0e21e	168	}
	169	chdir($path = '/' . join('/', @path));
	170	$path;
	171	}
	172
	173
4633a7c4	174	# Keeps track of current working directory in PWD environment var
a0d0e21e	175	# Usage:
	176	# use Cwd 'chdir';
	177	# chdir $newdir;
	178
4633a7c4	179	my $chdir_init = 0;
a0d0e21e	180
4633a7c4	181	sub chdir_init {
55497cff	182	if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'msdos') {
a0d0e21e	183	my($dd,$di) = stat('.');
	184	my($pd,$pi) = stat($ENV{'PWD'});
	185	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4	186	$ENV{'PWD'} = cwd();
a0d0e21e	187	}
	188	}
	189	else {
4633a7c4	190	$ENV{'PWD'} = cwd();
a0d0e21e	191	}
4633a7c4	192	# Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
a0d0e21e	193	if ($ENV{'PWD'} =~ m\|(/[^/]+(/[^/]+/[^/]+))(.*)\|) {
	194	my($pd,$pi) = stat($2);
	195	my($dd,$di) = stat($1);
	196	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
	197	$ENV{'PWD'}="$2$3";
	198	}
	199	}
	200	$chdir_init = 1;
	201	}
	202
	203	sub chdir {
4633a7c4	204	my $newdir = shift \|\| ''; # allow for no arg (chdir to HOME dir)
4633a7c4	205	$newdir =~ s\|///*\|/\|g;
a0d0e21e	206	chdir_init() unless $chdir_init;
4633a7c4	207	return 0 unless CORE::chdir $newdir;
c6538b72	208	if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
748a9306	209
a0d0e21e	210	if ($newdir =~ m#^/#) {
a0d0e21e	211	$ENV{'PWD'} = $newdir;
4633a7c4	212	} else {
	213	my @curdir = split(m#/#,$ENV{'PWD'});
	214	@curdir = ('') unless @curdir;
	215	my $component;
a0d0e21e	216	foreach $component (split(m#/#, $newdir)) {
	217	next if $component eq '.';
	218	pop(@curdir),next if $component eq '..';
	219	push(@curdir,$component);
	220	}
	221	$ENV{'PWD'} = join('/',@curdir) \|\| '/';
	222	}
4633a7c4	223	1;
a0d0e21e	224	}
a0d0e21e	225
8b88ae92	226	# Taken from Cwd.pm It is really getcwd with an optional
	227	# parameter instead of '.'
	228	#
	229
	230	sub abs_path
	231	{
	232	my $start = shift \|\| '.';
	233	my($dotdots, $cwd, @pst, @cst, $dir, @tst);
	234
	235	unless (@cst = stat( $start ))
	236	{
	237	carp "stat($start): $!";
	238	return '';
	239	}
	240	$cwd = '';
	241	$dotdots = $start;
	242	do
	243	{
	244	$dotdots .= '/..';
	245	@pst = @cst;
	246	unless (opendir(PARENT, $dotdots))
	247	{
	248	carp "opendir($dotdots): $!";
	249	return '';
	250	}
	251	unless (@cst = stat($dotdots))
	252	{
	253	carp "stat($dotdots): $!";
	254	closedir(PARENT);
	255	return '';
	256	}
	257	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
	258	{
	259	$dir = '';
	260	}
	261	else
	262	{
	263	do
	264	{
	265	unless (defined ($dir = readdir(PARENT)))
	266	{
	267	carp "readdir($dotdots): $!";
	268	closedir(PARENT);
	269	return '';
	270	}
	271	$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
	272	}
	273	while ($dir eq '.' \|\| $dir eq '..' \|\| $tst[0] != $pst[0] \|\|
	274	$tst[1] != $pst[1]);
	275	}
	276	$cwd = "$dir/$cwd";
	277	closedir(PARENT);
	278	} while ($dir);
	279	chop($cwd); # drop the trailing /
	280	$cwd;
	281	}
	282
96e4d5b1	283	sub fast_abs_path {
	284	my $cwd = getcwd();
	285	my $path = shift \|\| '.';
	286	chdir($path) \|\| croak "Cannot chdir to $path:$!";
	287	my $realpath = getcwd();
	288	chdir($cwd) \|\| croak "Cannot chdir back to $cwd:$!";
	289	$realpath;
8b88ae92	290	}
8b88ae92	291
4633a7c4	292
	293	# --- PORTING SECTION ---
	294
	295	# VMS: $ENV{'DEFAULT'} points to default directory at all times
c6538b72	296	# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
c6538b72	297	# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92	298	# in the process logical name table as the default device and directory
8b88ae92	299	# seen by Perl. This may not be the same as the default device
4633a7c4	300	# and directory seen by DCL after Perl exits, since the effects
4633a7c4	301	# the CRTL chdir() function persist only until Perl exits.
4633a7c4	302
4633a7c4	303	sub _vms_cwd {
96e4d5b1	304	return $ENV{'DEFAULT'};
	305	}
	306
	307	sub _vms_abs_path {
	308	return $ENV{'DEFAULT'} unless @_;
	309	my $path = VMS::Filespec::pathify($_[0]);
	310	croak("Invalid path name $_[0]") unless defined $path;
	311	return VMS::Filespec::rmsexpand($path);
4633a7c4	312	}
68dc0745	313
4633a7c4	314	sub _os2_cwd {
	315	$ENV{'PWD'} = `cmd /c cd`;
	316	chop $ENV{'PWD'};
	317	$ENV{'PWD'} =~ s:\\:/:g ;
	318	return $ENV{'PWD'};
	319	}
	320
96e4d5b1	321	sub _win32_cwd {
	322	$ENV{'PWD'} = Win32::GetCurrentDirectory();
	323	$ENV{'PWD'} =~ s:\\:/:g ;
	324	return $ENV{'PWD'};
	325	}
	326
	327	*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
	328	defined &Win32::GetCurrentDirectory);
	329
	330	*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745	331
55497cff	332	sub _msdos_cwd {
	333	$ENV{'PWD'} = `command /c cd`;
	334	chop $ENV{'PWD'};
	335	$ENV{'PWD'} =~ s:\\:/:g ;
	336	return $ENV{'PWD'};
	337	}
	338
ac1ad7f0	339	{
ac1ad7f0	340	local $^W = 0; # assignments trigger 'subroutine redefined' warning
4633a7c4	341
ac1ad7f0	342	if ($^O eq 'VMS') {
96e4d5b1	343	*cwd = \&_vms_cwd;
	344	*getcwd = \&_vms_cwd;
	345	*fastcwd = \&_vms_cwd;
	346	*fastgetcwd = \&_vms_cwd;
	347	*abs_path = \&_vms_abs_path;
	348	*fast_abs_path = \&_vms_abs_path;
ac1ad7f0	349	}
	350	elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
	351	# We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1	352	*cwd = \&_NT_cwd;
	353	*getcwd = \&_NT_cwd;
	354	*fastcwd = \&_NT_cwd;
	355	*fastgetcwd = \&_NT_cwd;
	356	*abs_path = \&fast_abs_path;
ac1ad7f0	357	}
	358	elsif ($^O eq 'os2') {
	359	# sys_cwd may keep the builtin command
96e4d5b1	360	*cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
	361	*getcwd = \&cwd;
	362	*fastgetcwd = \&cwd;
	363	*fastcwd = \&cwd;
	364	*abs_path = \&fast_abs_path;
ac1ad7f0	365	}
ac1ad7f0	366	elsif ($^O eq 'msdos') {
96e4d5b1	367	*cwd = \&_msdos_cwd;
	368	*getcwd = \&_msdos_cwd;
	369	*fastgetcwd = \&_msdos_cwd;
	370	*fastcwd = \&_msdos_cwd;
	371	*abs_path = \&fast_abs_path;
ac1ad7f0	372	}
55497cff	373	}
4633a7c4	374
	375	# package main; eval join('',<DATA>) \|\| die $@; # quick test
	376
a0d0e21e	377	1;
a0d0e21e	378
4633a7c4	379	__END__
	380	BEGIN { import Cwd qw(:DEFAULT chdir); }
	381	print join("\n", cwd, getcwd, fastcwd, "");
	382	chdir('..');
	383	print join("\n", cwd, getcwd, fastcwd, "");
	384	print "$ENV{PWD}\n";