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

package Cwd;
require 5.000;

=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.

=cut

use strict;

use Carp;

our $VERSION = '2.04';

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');
};

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

sub _backtick_pwd {
    my $cwd = `pwd`;
    # `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();
    my $path = @_ ? shift : '.';
    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 eq 'qnx') {
        *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;
a0d0e21e	2	require 5.000;
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
f06db76b	76	=cut
f06db76b	77
b060a406	78	use strict;
96e4d5b1	79
	80	use Carp;
	81
1f4f94f5	82	our $VERSION = '2.04';
96e4d5b1	83
b060a406	84	use base qw/ Exporter /;
	85	our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
	86	our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
a0d0e21e	87
f5f423e4	88	# sys_cwd may keep the builtin command
	89
	90	# All the functionality of this module may provided by builtins,
	91	# there is no sense to process the rest of the file.
	92	# The best choice may be to have this in BEGIN, but how to return from BEGIN?
	93
	94	if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
	95	local $^W = 0;
	96	*cwd = \&sys_cwd;
	97	*getcwd = \&cwd;
	98	*fastgetcwd = \&cwd;
	99	*fastcwd = \&cwd;
	100	*abs_path = \&sys_abspath;
	101	*fast_abs_path = \&abs_path;
	102	*realpath = \&abs_path;
	103	*fast_realpath = \&abs_path;
	104	return 1;
	105	}
	106
f22d8e4b	107	eval {
	108	require XSLoader;
	109	XSLoader::load('Cwd');
	110	};
4633a7c4	111
8b88ae92	112	# The 'natural and safe form' for UNIX (pwd may be setuid root)
96e4d5b1	113
8b88ae92	114	sub _backtick_pwd {
7e03f963	115	my $cwd = `pwd`;
	116	# `pwd` may fail e.g. if the disk is full
	117	chomp($cwd) if defined $cwd;
4633a7c4	118	$cwd;
8b88ae92	119	}
4633a7c4	120
	121	# Since some ports may predefine cwd internally (e.g., NT)
	122	# we take care not to override an existing definition for cwd().
	123
ea54c8bd	124	unless(defined &cwd) {
ea54c8bd	125	# The pwd command is not available in some chroot(2)'ed environments
4aecb5b5	126	if($^O eq 'MacOS' \|\| grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
ea54c8bd	127	*cwd = \&_backtick_pwd;
	128	}
	129	else {
	130	*cwd = \&getcwd;
	131	}
	132	}
a0d0e21e	133
1f4f94f5	134	# set a reasonable (and very safe) default for fastgetcwd, in case it
	135	# isn't redefined later (20001212 rspier)
	136	*fastgetcwd = \&cwd;
748a9306	137
a0d0e21e	138	# By Brandon S. Allbery
	139	#
	140	# Usage: $cwd = getcwd();
	141
	142	sub getcwd
	143	{
07569ed3	144	abs_path('.');
a0d0e21e	145	}
a0d0e21e	146
4633a7c4	147	# Keeps track of current working directory in PWD environment var
a0d0e21e	148	# Usage:
	149	# use Cwd 'chdir';
	150	# chdir $newdir;
	151
4633a7c4	152	my $chdir_init = 0;
a0d0e21e	153
4633a7c4	154	sub chdir_init {
3b8e3443	155	if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
a0d0e21e	156	my($dd,$di) = stat('.');
	157	my($pd,$pi) = stat($ENV{'PWD'});
	158	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
4633a7c4	159	$ENV{'PWD'} = cwd();
a0d0e21e	160	}
	161	}
	162	else {
3b8e3443	163	my $wd = cwd();
	164	$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
	165	$ENV{'PWD'} = $wd;
a0d0e21e	166	}
4633a7c4	167	# Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
3b8e3443	168	if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m\|(/[^/]+(/[^/]+/[^/]+))(.*)\|s) {
a0d0e21e	169	my($pd,$pi) = stat($2);
	170	my($dd,$di) = stat($1);
	171	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
	172	$ENV{'PWD'}="$2$3";
	173	}
	174	}
	175	$chdir_init = 1;
	176	}
	177
	178	sub chdir {
22978713	179	my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
3b8e3443	180	$newdir =~ s\|///*\|/\|g unless $^O eq 'MSWin32';
a0d0e21e	181	chdir_init() unless $chdir_init;
4ffa1610	182	my $newpwd;
	183	if ($^O eq 'MSWin32') {
	184	# get the full path name before the chdir()
	185	$newpwd = Win32::GetFullPathName($newdir);
	186	}
	187
4633a7c4	188	return 0 unless CORE::chdir $newdir;
4ffa1610	189
3b8e3443	190	if ($^O eq 'VMS') {
	191	return $ENV{'PWD'} = $ENV{'DEFAULT'}
	192	}
4aecb5b5	193	elsif ($^O eq 'MacOS') {
	194	return $ENV{'PWD'} = cwd();
	195	}
3b8e3443	196	elsif ($^O eq 'MSWin32') {
4ffa1610	197	$ENV{'PWD'} = $newpwd;
3b8e3443	198	return 1;
3b8e3443	199	}
748a9306	200
392d8ab8	201	if ($newdir =~ m#^/#s) {
a0d0e21e	202	$ENV{'PWD'} = $newdir;
4633a7c4	203	} else {
	204	my @curdir = split(m#/#,$ENV{'PWD'});
	205	@curdir = ('') unless @curdir;
	206	my $component;
a0d0e21e	207	foreach $component (split(m#/#, $newdir)) {
	208	next if $component eq '.';
	209	pop(@curdir),next if $component eq '..';
	210	push(@curdir,$component);
	211	}
	212	$ENV{'PWD'} = join('/',@curdir) \|\| '/';
	213	}
4633a7c4	214	1;
a0d0e21e	215	}
a0d0e21e	216
e4c51978	217	# added function alias for those of us more
	218	# used to the libc function. --tchrist 27-Jan-00
	219	*realpath = \&abs_path;
	220
96e4d5b1	221	sub fast_abs_path {
96e4d5b1	222	my $cwd = getcwd();
3c65c14b	223	my $path = @_ ? shift : '.';
e79e61e4	224	CORE::chdir($path) \|\| croak "Cannot chdir to $path:$!";
96e4d5b1	225	my $realpath = getcwd();
e79e61e4	226	CORE::chdir($cwd) \|\| croak "Cannot chdir back to $cwd:$!";
96e4d5b1	227	$realpath;
8b88ae92	228	}
8b88ae92	229
e4c51978	230	# added function alias to follow principle of least surprise
	231	# based on previous aliasing. --tchrist 27-Jan-00
	232	*fast_realpath = \&fast_abs_path;
	233
4633a7c4	234
	235	# --- PORTING SECTION ---
	236
	237	# VMS: $ENV{'DEFAULT'} points to default directory at all times
bd3fa61c	238	# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
c6538b72	239	# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
8b88ae92	240	# in the process logical name table as the default device and directory
8b88ae92	241	# seen by Perl. This may not be the same as the default device
4633a7c4	242	# and directory seen by DCL after Perl exits, since the effects
4633a7c4	243	# the CRTL chdir() function persist only until Perl exits.
4633a7c4	244
4633a7c4	245	sub _vms_cwd {
96e4d5b1	246	return $ENV{'DEFAULT'};
	247	}
	248
	249	sub _vms_abs_path {
	250	return $ENV{'DEFAULT'} unless @_;
	251	my $path = VMS::Filespec::pathify($_[0]);
	252	croak("Invalid path name $_[0]") unless defined $path;
	253	return VMS::Filespec::rmsexpand($path);
4633a7c4	254	}
68dc0745	255
4633a7c4	256	sub _os2_cwd {
	257	$ENV{'PWD'} = `cmd /c cd`;
	258	chop $ENV{'PWD'};
	259	$ENV{'PWD'} =~ s:\\:/:g ;
	260	return $ENV{'PWD'};
	261	}
	262
96e4d5b1	263	sub _win32_cwd {
2d7a9237	264	$ENV{'PWD'} = Win32::GetCwd();
96e4d5b1	265	$ENV{'PWD'} =~ s:\\:/:g ;
	266	return $ENV{'PWD'};
	267	}
	268
	269	*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
2d7a9237	270	defined &Win32::GetCwd);
96e4d5b1	271
96e4d5b1	272	*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
68dc0745	273
39e571d4	274	sub _dos_cwd {
	275	if (!defined &Dos::GetCwd) {
	276	$ENV{'PWD'} = `command /c cd`;
	277	chop $ENV{'PWD'};
	278	$ENV{'PWD'} =~ s:\\:/:g ;
	279	} else {
	280	$ENV{'PWD'} = Dos::GetCwd();
	281	}
55497cff	282	return $ENV{'PWD'};
	283	}
	284
7fbf1995	285	sub _qnx_cwd {
	286	$ENV{'PWD'} = `/usr/bin/fullpath -t`;
	287	chop $ENV{'PWD'};
	288	return $ENV{'PWD'};
	289	}
	290
	291	sub _qnx_abs_path {
fa921dc6	292	my $path = @_ ? shift : '.';
7fbf1995	293	my $realpath=`/usr/bin/fullpath -t $path`;
	294	chop $realpath;
	295	return $realpath;
	296	}
	297
ed79a026	298	sub _epoc_cwd {
	299	$ENV{'PWD'} = EPOC::getcwd();
	300	return $ENV{'PWD'};
	301	}
	302
ac1ad7f0	303	{
db376a24	304	no warnings; # assignments trigger 'subroutine redefined' warning
4633a7c4	305
ac1ad7f0	306	if ($^O eq 'VMS') {
96e4d5b1	307	*cwd = \&_vms_cwd;
	308	*getcwd = \&_vms_cwd;
	309	*fastcwd = \&_vms_cwd;
	310	*fastgetcwd = \&_vms_cwd;
	311	*abs_path = \&_vms_abs_path;
	312	*fast_abs_path = \&_vms_abs_path;
ac1ad7f0	313	}
	314	elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
	315	# We assume that &_NT_cwd is defined as an XSUB or in the core.
96e4d5b1	316	*cwd = \&_NT_cwd;
	317	*getcwd = \&_NT_cwd;
	318	*fastcwd = \&_NT_cwd;
	319	*fastgetcwd = \&_NT_cwd;
	320	*abs_path = \&fast_abs_path;
ac1ad7f0	321	}
	322	elsif ($^O eq 'os2') {
	323	# sys_cwd may keep the builtin command
96e4d5b1	324	*cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
	325	*getcwd = \&cwd;
	326	*fastgetcwd = \&cwd;
	327	*fastcwd = \&cwd;
	328	*abs_path = \&fast_abs_path;
ac1ad7f0	329	}
39e571d4	330	elsif ($^O eq 'dos') {
	331	*cwd = \&_dos_cwd;
	332	*getcwd = \&_dos_cwd;
	333	*fastgetcwd = \&_dos_cwd;
	334	*fastcwd = \&_dos_cwd;
96e4d5b1	335	*abs_path = \&fast_abs_path;
ac1ad7f0	336	}
7fbf1995	337	elsif ($^O eq 'qnx') {
	338	*cwd = \&_qnx_cwd;
	339	*getcwd = \&_qnx_cwd;
	340	*fastgetcwd = \&_qnx_cwd;
	341	*fastcwd = \&_qnx_cwd;
	342	*abs_path = \&_qnx_abs_path;
	343	*fast_abs_path = \&_qnx_abs_path;
	344	}
4fabb596	345	elsif ($^O eq 'cygwin') {
1cab015a	346	*getcwd = \&cwd;
	347	*fastgetcwd = \&cwd;
	348	*fastcwd = \&cwd;
	349	*abs_path = \&fast_abs_path;
	350	}
ed79a026	351	elsif ($^O eq 'epoc') {
fa6a1c44	352	*cwd = \&_epoc_cwd;
fa6a1c44	353	*getcwd = \&_epoc_cwd;
ed79a026	354	*fastgetcwd = \&_epoc_cwd;
	355	*fastcwd = \&_epoc_cwd;
	356	*abs_path = \&fast_abs_path;
	357	}
4aecb5b5	358	elsif ($^O eq 'MacOS') {
	359	*getcwd = \&cwd;
	360	*fastgetcwd = \&cwd;
	361	*fastcwd = \&cwd;
	362	*abs_path = \&fast_abs_path;
	363	}
55497cff	364	}
4633a7c4	365
	366	# package main; eval join('',<DATA>) \|\| die $@; # quick test
	367
a0d0e21e	368	1;
a0d0e21e	369
4633a7c4	370	__END__
	371	BEGIN { import Cwd qw(:DEFAULT chdir); }
	372	print join("\n", cwd, getcwd, fastcwd, "");
	373	chdir('..');
	374	print join("\n", cwd, getcwd, fastcwd, "");
	375	print "$ENV{PWD}\n";