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