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

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