1*0Sstevel@tonic-gatepackage Cwd; 2*0Sstevel@tonic-gate$VERSION = $VERSION = '2.17'; 3*0Sstevel@tonic-gate 4*0Sstevel@tonic-gate=head1 NAME 5*0Sstevel@tonic-gate 6*0Sstevel@tonic-gateCwd - get pathname of current working directory 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gate=head1 SYNOPSIS 9*0Sstevel@tonic-gate 10*0Sstevel@tonic-gate use Cwd; 11*0Sstevel@tonic-gate my $dir = getcwd; 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate use Cwd 'abs_path'; 14*0Sstevel@tonic-gate my $abs_path = abs_path($file); 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate=head1 DESCRIPTION 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gateThis module provides functions for determining the pathname of the 19*0Sstevel@tonic-gatecurrent working directory. It is recommended that getcwd (or another 20*0Sstevel@tonic-gate*cwd() function) be used in I<all> code to ensure portability. 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gateBy default, it exports the functions cwd(), getcwd(), fastcwd(), and 23*0Sstevel@tonic-gatefastgetcwd() into the caller's namespace. 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gate=head2 getcwd and friends 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gateEach of these functions are called without arguments and return the 29*0Sstevel@tonic-gateabsolute path of the current working directory. 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate=over 4 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate=item getcwd 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate my $cwd = getcwd(); 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gateReturns the current working directory. 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gateRe-implements the getcwd(3) (or getwd(3)) functions in Perl. 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gate=item cwd 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gate my $cwd = cwd(); 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateThe cwd() is the most natural form for the current architecture. For 46*0Sstevel@tonic-gatemost systems it is identical to `pwd` (but without the trailing line 47*0Sstevel@tonic-gateterminator). 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gate=item fastcwd 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gate my $cwd = fastcwd(); 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gateA more dangerous version of getcwd(), but potentially faster. 54*0Sstevel@tonic-gate 55*0Sstevel@tonic-gateIt might conceivably chdir() you out of a directory that it can't 56*0Sstevel@tonic-gatechdir() you back into. If fastcwd encounters a problem it will return 57*0Sstevel@tonic-gateundef but will probably leave you in a different directory. For a 58*0Sstevel@tonic-gatemeasure of extra security, if everything appears to have worked, the 59*0Sstevel@tonic-gatefastcwd() function will check that it leaves you in the same directory 60*0Sstevel@tonic-gatethat it started in. If it has changed it will C<die> with the message 61*0Sstevel@tonic-gate"Unstable directory path, current directory changed 62*0Sstevel@tonic-gateunexpectedly". That should never happen. 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gate=item fastgetcwd 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate my $cwd = fastgetcwd(); 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gateThe fastgetcwd() function is provided as a synonym for cwd(). 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate=back 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate=head2 abs_path and friends 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gateThese functions are exported only on request. They each take a single 76*0Sstevel@tonic-gateargument and return the absolute pathname for it. If no argument is 77*0Sstevel@tonic-gategiven they'll use the current working directory. 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gate=over 4 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gate=item abs_path 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gate my $abs_path = abs_path($file); 84*0Sstevel@tonic-gate 85*0Sstevel@tonic-gateUses the same algorithm as getcwd(). Symbolic links and relative-path 86*0Sstevel@tonic-gatecomponents ("." and "..") are resolved to return the canonical 87*0Sstevel@tonic-gatepathname, just like realpath(3). 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gate=item realpath 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gate my $abs_path = realpath($file); 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gateA synonym for abs_path(). 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gate=item fast_abs_path 96*0Sstevel@tonic-gate 97*0Sstevel@tonic-gate my $abs_path = fast_abs_path($file); 98*0Sstevel@tonic-gate 99*0Sstevel@tonic-gateA more dangerous, but potentially faster version of abs_path. 100*0Sstevel@tonic-gate 101*0Sstevel@tonic-gate=back 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate=head2 $ENV{PWD} 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gateIf you ask to override your chdir() built-in function, 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate use Cwd qw(chdir); 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gatethen your PWD environment variable will be kept up to date. Note that 110*0Sstevel@tonic-gateit will only be kept up to date if all packages which use chdir import 111*0Sstevel@tonic-gateit from Cwd. 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gate=head1 NOTES 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gate=over 4 117*0Sstevel@tonic-gate 118*0Sstevel@tonic-gate=item * 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gateSince the path seperators are different on some operating systems ('/' 121*0Sstevel@tonic-gateon Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec 122*0Sstevel@tonic-gatemodules wherever portability is a concern. 123*0Sstevel@tonic-gate 124*0Sstevel@tonic-gate=item * 125*0Sstevel@tonic-gate 126*0Sstevel@tonic-gateActually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()> 127*0Sstevel@tonic-gatefunctions are all aliases for the C<cwd()> function, which, on Mac OS, 128*0Sstevel@tonic-gatecalls `pwd`. Likewise, the C<abs_path()> function is an alias for 129*0Sstevel@tonic-gateC<fast_abs_path()>. 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gate=back 132*0Sstevel@tonic-gate 133*0Sstevel@tonic-gate=head1 AUTHOR 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gateOriginally by the perl5-porters. 136*0Sstevel@tonic-gate 137*0Sstevel@tonic-gateNow maintained by Ken Williams <KWILLIAMS@cpan.org> 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate=head1 SEE ALSO 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gateL<File::chdir> 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gate=cut 144*0Sstevel@tonic-gate 145*0Sstevel@tonic-gateuse strict; 146*0Sstevel@tonic-gateuse Exporter; 147*0Sstevel@tonic-gateuse vars qw(@ISA @EXPORT @EXPORT_OK); 148*0Sstevel@tonic-gate 149*0Sstevel@tonic-gate@ISA = qw/ Exporter /; 150*0Sstevel@tonic-gate@EXPORT = qw(cwd getcwd fastcwd fastgetcwd); 151*0Sstevel@tonic-gate@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath); 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gate# sys_cwd may keep the builtin command 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gate# All the functionality of this module may provided by builtins, 156*0Sstevel@tonic-gate# there is no sense to process the rest of the file. 157*0Sstevel@tonic-gate# The best choice may be to have this in BEGIN, but how to return from BEGIN? 158*0Sstevel@tonic-gate 159*0Sstevel@tonic-gateif ($^O eq 'os2') { 160*0Sstevel@tonic-gate local $^W = 0; 161*0Sstevel@tonic-gate 162*0Sstevel@tonic-gate *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd; 163*0Sstevel@tonic-gate *getcwd = \&cwd; 164*0Sstevel@tonic-gate *fastgetcwd = \&cwd; 165*0Sstevel@tonic-gate *fastcwd = \&cwd; 166*0Sstevel@tonic-gate 167*0Sstevel@tonic-gate *fast_abs_path = \&sys_abspath if defined &sys_abspath; 168*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 169*0Sstevel@tonic-gate *realpath = \&fast_abs_path; 170*0Sstevel@tonic-gate *fast_realpath = \&fast_abs_path; 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gate return 1; 173*0Sstevel@tonic-gate} 174*0Sstevel@tonic-gate 175*0Sstevel@tonic-gateeval { 176*0Sstevel@tonic-gate require XSLoader; 177*0Sstevel@tonic-gate local $^W = 0; 178*0Sstevel@tonic-gate XSLoader::load('Cwd'); 179*0Sstevel@tonic-gate}; 180*0Sstevel@tonic-gate 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gate# Find the pwd command in the expected locations. We assume these 183*0Sstevel@tonic-gate# are safe. This prevents _backtick_pwd() consulting $ENV{PATH} 184*0Sstevel@tonic-gate# so everything works under taint mode. 185*0Sstevel@tonic-gatemy $pwd_cmd; 186*0Sstevel@tonic-gateforeach my $try ('/bin/pwd', 187*0Sstevel@tonic-gate '/usr/bin/pwd', 188*0Sstevel@tonic-gate '/QOpenSys/bin/pwd', # OS/400 PASE. 189*0Sstevel@tonic-gate ) { 190*0Sstevel@tonic-gate 191*0Sstevel@tonic-gate if( -x $try ) { 192*0Sstevel@tonic-gate $pwd_cmd = $try; 193*0Sstevel@tonic-gate last; 194*0Sstevel@tonic-gate } 195*0Sstevel@tonic-gate} 196*0Sstevel@tonic-gateunless ($pwd_cmd) { 197*0Sstevel@tonic-gate # Isn't this wrong? _backtick_pwd() will fail if somenone has 198*0Sstevel@tonic-gate # pwd in their path but it is not /bin/pwd or /usr/bin/pwd? 199*0Sstevel@tonic-gate # See [perl #16774]. --jhi 200*0Sstevel@tonic-gate $pwd_cmd = 'pwd'; 201*0Sstevel@tonic-gate} 202*0Sstevel@tonic-gate 203*0Sstevel@tonic-gate# Lazy-load Carp 204*0Sstevel@tonic-gatesub _carp { require Carp; Carp::carp(@_) } 205*0Sstevel@tonic-gatesub _croak { require Carp; Carp::croak(@_) } 206*0Sstevel@tonic-gate 207*0Sstevel@tonic-gate# The 'natural and safe form' for UNIX (pwd may be setuid root) 208*0Sstevel@tonic-gatesub _backtick_pwd { 209*0Sstevel@tonic-gate local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; 210*0Sstevel@tonic-gate my $cwd = `$pwd_cmd`; 211*0Sstevel@tonic-gate # Belt-and-suspenders in case someone said "undef $/". 212*0Sstevel@tonic-gate local $/ = "\n"; 213*0Sstevel@tonic-gate # `pwd` may fail e.g. if the disk is full 214*0Sstevel@tonic-gate chomp($cwd) if defined $cwd; 215*0Sstevel@tonic-gate $cwd; 216*0Sstevel@tonic-gate} 217*0Sstevel@tonic-gate 218*0Sstevel@tonic-gate# Since some ports may predefine cwd internally (e.g., NT) 219*0Sstevel@tonic-gate# we take care not to override an existing definition for cwd(). 220*0Sstevel@tonic-gate 221*0Sstevel@tonic-gateunless(defined &cwd) { 222*0Sstevel@tonic-gate # The pwd command is not available in some chroot(2)'ed environments 223*0Sstevel@tonic-gate if( $^O eq 'MacOS' || (defined $ENV{PATH} && 224*0Sstevel@tonic-gate grep { -x "$_/pwd" } split(':', $ENV{PATH})) ) 225*0Sstevel@tonic-gate { 226*0Sstevel@tonic-gate *cwd = \&_backtick_pwd; 227*0Sstevel@tonic-gate } 228*0Sstevel@tonic-gate else { 229*0Sstevel@tonic-gate *cwd = \&getcwd; 230*0Sstevel@tonic-gate } 231*0Sstevel@tonic-gate} 232*0Sstevel@tonic-gate 233*0Sstevel@tonic-gate# set a reasonable (and very safe) default for fastgetcwd, in case it 234*0Sstevel@tonic-gate# isn't redefined later (20001212 rspier) 235*0Sstevel@tonic-gate*fastgetcwd = \&cwd; 236*0Sstevel@tonic-gate 237*0Sstevel@tonic-gate# By Brandon S. Allbery 238*0Sstevel@tonic-gate# 239*0Sstevel@tonic-gate# Usage: $cwd = getcwd(); 240*0Sstevel@tonic-gate 241*0Sstevel@tonic-gatesub getcwd 242*0Sstevel@tonic-gate{ 243*0Sstevel@tonic-gate abs_path('.'); 244*0Sstevel@tonic-gate} 245*0Sstevel@tonic-gate 246*0Sstevel@tonic-gate 247*0Sstevel@tonic-gate# By John Bazik 248*0Sstevel@tonic-gate# 249*0Sstevel@tonic-gate# Usage: $cwd = &fastcwd; 250*0Sstevel@tonic-gate# 251*0Sstevel@tonic-gate# This is a faster version of getcwd. It's also more dangerous because 252*0Sstevel@tonic-gate# you might chdir out of a directory that you can't chdir back into. 253*0Sstevel@tonic-gate 254*0Sstevel@tonic-gatesub fastcwd { 255*0Sstevel@tonic-gate my($odev, $oino, $cdev, $cino, $tdev, $tino); 256*0Sstevel@tonic-gate my(@path, $path); 257*0Sstevel@tonic-gate local(*DIR); 258*0Sstevel@tonic-gate 259*0Sstevel@tonic-gate my($orig_cdev, $orig_cino) = stat('.'); 260*0Sstevel@tonic-gate ($cdev, $cino) = ($orig_cdev, $orig_cino); 261*0Sstevel@tonic-gate for (;;) { 262*0Sstevel@tonic-gate my $direntry; 263*0Sstevel@tonic-gate ($odev, $oino) = ($cdev, $cino); 264*0Sstevel@tonic-gate CORE::chdir('..') || return undef; 265*0Sstevel@tonic-gate ($cdev, $cino) = stat('.'); 266*0Sstevel@tonic-gate last if $odev == $cdev && $oino == $cino; 267*0Sstevel@tonic-gate opendir(DIR, '.') || return undef; 268*0Sstevel@tonic-gate for (;;) { 269*0Sstevel@tonic-gate $direntry = readdir(DIR); 270*0Sstevel@tonic-gate last unless defined $direntry; 271*0Sstevel@tonic-gate next if $direntry eq '.'; 272*0Sstevel@tonic-gate next if $direntry eq '..'; 273*0Sstevel@tonic-gate 274*0Sstevel@tonic-gate ($tdev, $tino) = lstat($direntry); 275*0Sstevel@tonic-gate last unless $tdev != $odev || $tino != $oino; 276*0Sstevel@tonic-gate } 277*0Sstevel@tonic-gate closedir(DIR); 278*0Sstevel@tonic-gate return undef unless defined $direntry; # should never happen 279*0Sstevel@tonic-gate unshift(@path, $direntry); 280*0Sstevel@tonic-gate } 281*0Sstevel@tonic-gate $path = '/' . join('/', @path); 282*0Sstevel@tonic-gate if ($^O eq 'apollo') { $path = "/".$path; } 283*0Sstevel@tonic-gate # At this point $path may be tainted (if tainting) and chdir would fail. 284*0Sstevel@tonic-gate # Untaint it then check that we landed where we started. 285*0Sstevel@tonic-gate $path =~ /^(.*)\z/s # untaint 286*0Sstevel@tonic-gate && CORE::chdir($1) or return undef; 287*0Sstevel@tonic-gate ($cdev, $cino) = stat('.'); 288*0Sstevel@tonic-gate die "Unstable directory path, current directory changed unexpectedly" 289*0Sstevel@tonic-gate if $cdev != $orig_cdev || $cino != $orig_cino; 290*0Sstevel@tonic-gate $path; 291*0Sstevel@tonic-gate} 292*0Sstevel@tonic-gate 293*0Sstevel@tonic-gate 294*0Sstevel@tonic-gate# Keeps track of current working directory in PWD environment var 295*0Sstevel@tonic-gate# Usage: 296*0Sstevel@tonic-gate# use Cwd 'chdir'; 297*0Sstevel@tonic-gate# chdir $newdir; 298*0Sstevel@tonic-gate 299*0Sstevel@tonic-gatemy $chdir_init = 0; 300*0Sstevel@tonic-gate 301*0Sstevel@tonic-gatesub chdir_init { 302*0Sstevel@tonic-gate if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') { 303*0Sstevel@tonic-gate my($dd,$di) = stat('.'); 304*0Sstevel@tonic-gate my($pd,$pi) = stat($ENV{'PWD'}); 305*0Sstevel@tonic-gate if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { 306*0Sstevel@tonic-gate $ENV{'PWD'} = cwd(); 307*0Sstevel@tonic-gate } 308*0Sstevel@tonic-gate } 309*0Sstevel@tonic-gate else { 310*0Sstevel@tonic-gate my $wd = cwd(); 311*0Sstevel@tonic-gate $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32'; 312*0Sstevel@tonic-gate $ENV{'PWD'} = $wd; 313*0Sstevel@tonic-gate } 314*0Sstevel@tonic-gate # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar) 315*0Sstevel@tonic-gate if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) { 316*0Sstevel@tonic-gate my($pd,$pi) = stat($2); 317*0Sstevel@tonic-gate my($dd,$di) = stat($1); 318*0Sstevel@tonic-gate if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { 319*0Sstevel@tonic-gate $ENV{'PWD'}="$2$3"; 320*0Sstevel@tonic-gate } 321*0Sstevel@tonic-gate } 322*0Sstevel@tonic-gate $chdir_init = 1; 323*0Sstevel@tonic-gate} 324*0Sstevel@tonic-gate 325*0Sstevel@tonic-gatesub chdir { 326*0Sstevel@tonic-gate my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) 327*0Sstevel@tonic-gate $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; 328*0Sstevel@tonic-gate chdir_init() unless $chdir_init; 329*0Sstevel@tonic-gate my $newpwd; 330*0Sstevel@tonic-gate if ($^O eq 'MSWin32') { 331*0Sstevel@tonic-gate # get the full path name *before* the chdir() 332*0Sstevel@tonic-gate $newpwd = Win32::GetFullPathName($newdir); 333*0Sstevel@tonic-gate } 334*0Sstevel@tonic-gate 335*0Sstevel@tonic-gate return 0 unless CORE::chdir $newdir; 336*0Sstevel@tonic-gate 337*0Sstevel@tonic-gate if ($^O eq 'VMS') { 338*0Sstevel@tonic-gate return $ENV{'PWD'} = $ENV{'DEFAULT'} 339*0Sstevel@tonic-gate } 340*0Sstevel@tonic-gate elsif ($^O eq 'MacOS') { 341*0Sstevel@tonic-gate return $ENV{'PWD'} = cwd(); 342*0Sstevel@tonic-gate } 343*0Sstevel@tonic-gate elsif ($^O eq 'MSWin32') { 344*0Sstevel@tonic-gate $ENV{'PWD'} = $newpwd; 345*0Sstevel@tonic-gate return 1; 346*0Sstevel@tonic-gate } 347*0Sstevel@tonic-gate 348*0Sstevel@tonic-gate if ($newdir =~ m#^/#s) { 349*0Sstevel@tonic-gate $ENV{'PWD'} = $newdir; 350*0Sstevel@tonic-gate } else { 351*0Sstevel@tonic-gate my @curdir = split(m#/#,$ENV{'PWD'}); 352*0Sstevel@tonic-gate @curdir = ('') unless @curdir; 353*0Sstevel@tonic-gate my $component; 354*0Sstevel@tonic-gate foreach $component (split(m#/#, $newdir)) { 355*0Sstevel@tonic-gate next if $component eq '.'; 356*0Sstevel@tonic-gate pop(@curdir),next if $component eq '..'; 357*0Sstevel@tonic-gate push(@curdir,$component); 358*0Sstevel@tonic-gate } 359*0Sstevel@tonic-gate $ENV{'PWD'} = join('/',@curdir) || '/'; 360*0Sstevel@tonic-gate } 361*0Sstevel@tonic-gate 1; 362*0Sstevel@tonic-gate} 363*0Sstevel@tonic-gate 364*0Sstevel@tonic-gate 365*0Sstevel@tonic-gate# In case the XS version doesn't load. 366*0Sstevel@tonic-gate*abs_path = \&_perl_abs_path unless defined &abs_path; 367*0Sstevel@tonic-gatesub _perl_abs_path 368*0Sstevel@tonic-gate{ 369*0Sstevel@tonic-gate my $start = @_ ? shift : '.'; 370*0Sstevel@tonic-gate my($dotdots, $cwd, @pst, @cst, $dir, @tst); 371*0Sstevel@tonic-gate 372*0Sstevel@tonic-gate unless (@cst = stat( $start )) 373*0Sstevel@tonic-gate { 374*0Sstevel@tonic-gate _carp("stat($start): $!"); 375*0Sstevel@tonic-gate return ''; 376*0Sstevel@tonic-gate } 377*0Sstevel@tonic-gate $cwd = ''; 378*0Sstevel@tonic-gate $dotdots = $start; 379*0Sstevel@tonic-gate do 380*0Sstevel@tonic-gate { 381*0Sstevel@tonic-gate $dotdots .= '/..'; 382*0Sstevel@tonic-gate @pst = @cst; 383*0Sstevel@tonic-gate local *PARENT; 384*0Sstevel@tonic-gate unless (opendir(PARENT, $dotdots)) 385*0Sstevel@tonic-gate { 386*0Sstevel@tonic-gate _carp("opendir($dotdots): $!"); 387*0Sstevel@tonic-gate return ''; 388*0Sstevel@tonic-gate } 389*0Sstevel@tonic-gate unless (@cst = stat($dotdots)) 390*0Sstevel@tonic-gate { 391*0Sstevel@tonic-gate _carp("stat($dotdots): $!"); 392*0Sstevel@tonic-gate closedir(PARENT); 393*0Sstevel@tonic-gate return ''; 394*0Sstevel@tonic-gate } 395*0Sstevel@tonic-gate if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) 396*0Sstevel@tonic-gate { 397*0Sstevel@tonic-gate $dir = undef; 398*0Sstevel@tonic-gate } 399*0Sstevel@tonic-gate else 400*0Sstevel@tonic-gate { 401*0Sstevel@tonic-gate do 402*0Sstevel@tonic-gate { 403*0Sstevel@tonic-gate unless (defined ($dir = readdir(PARENT))) 404*0Sstevel@tonic-gate { 405*0Sstevel@tonic-gate _carp("readdir($dotdots): $!"); 406*0Sstevel@tonic-gate closedir(PARENT); 407*0Sstevel@tonic-gate return ''; 408*0Sstevel@tonic-gate } 409*0Sstevel@tonic-gate $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir")) 410*0Sstevel@tonic-gate } 411*0Sstevel@tonic-gate while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || 412*0Sstevel@tonic-gate $tst[1] != $pst[1]); 413*0Sstevel@tonic-gate } 414*0Sstevel@tonic-gate $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ; 415*0Sstevel@tonic-gate closedir(PARENT); 416*0Sstevel@tonic-gate } while (defined $dir); 417*0Sstevel@tonic-gate chop($cwd) unless $cwd eq '/'; # drop the trailing / 418*0Sstevel@tonic-gate $cwd; 419*0Sstevel@tonic-gate} 420*0Sstevel@tonic-gate 421*0Sstevel@tonic-gate 422*0Sstevel@tonic-gate# added function alias for those of us more 423*0Sstevel@tonic-gate# used to the libc function. --tchrist 27-Jan-00 424*0Sstevel@tonic-gate*realpath = \&abs_path; 425*0Sstevel@tonic-gate 426*0Sstevel@tonic-gatemy $Curdir; 427*0Sstevel@tonic-gatesub fast_abs_path { 428*0Sstevel@tonic-gate my $cwd = getcwd(); 429*0Sstevel@tonic-gate require File::Spec; 430*0Sstevel@tonic-gate my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir); 431*0Sstevel@tonic-gate 432*0Sstevel@tonic-gate # Detaint else we'll explode in taint mode. This is safe because 433*0Sstevel@tonic-gate # we're not doing anything dangerous with it. 434*0Sstevel@tonic-gate ($path) = $path =~ /(.*)/; 435*0Sstevel@tonic-gate ($cwd) = $cwd =~ /(.*)/; 436*0Sstevel@tonic-gate 437*0Sstevel@tonic-gate if (!CORE::chdir($path)) { 438*0Sstevel@tonic-gate _croak("Cannot chdir to $path: $!"); 439*0Sstevel@tonic-gate } 440*0Sstevel@tonic-gate my $realpath = getcwd(); 441*0Sstevel@tonic-gate if (! ((-d $cwd) && (CORE::chdir($cwd)))) { 442*0Sstevel@tonic-gate _croak("Cannot chdir back to $cwd: $!"); 443*0Sstevel@tonic-gate } 444*0Sstevel@tonic-gate $realpath; 445*0Sstevel@tonic-gate} 446*0Sstevel@tonic-gate 447*0Sstevel@tonic-gate# added function alias to follow principle of least surprise 448*0Sstevel@tonic-gate# based on previous aliasing. --tchrist 27-Jan-00 449*0Sstevel@tonic-gate*fast_realpath = \&fast_abs_path; 450*0Sstevel@tonic-gate 451*0Sstevel@tonic-gate 452*0Sstevel@tonic-gate# --- PORTING SECTION --- 453*0Sstevel@tonic-gate 454*0Sstevel@tonic-gate# VMS: $ENV{'DEFAULT'} points to default directory at all times 455*0Sstevel@tonic-gate# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu 456*0Sstevel@tonic-gate# Note: Use of Cwd::chdir() causes the logical name PWD to be defined 457*0Sstevel@tonic-gate# in the process logical name table as the default device and directory 458*0Sstevel@tonic-gate# seen by Perl. This may not be the same as the default device 459*0Sstevel@tonic-gate# and directory seen by DCL after Perl exits, since the effects 460*0Sstevel@tonic-gate# the CRTL chdir() function persist only until Perl exits. 461*0Sstevel@tonic-gate 462*0Sstevel@tonic-gatesub _vms_cwd { 463*0Sstevel@tonic-gate return $ENV{'DEFAULT'}; 464*0Sstevel@tonic-gate} 465*0Sstevel@tonic-gate 466*0Sstevel@tonic-gatesub _vms_abs_path { 467*0Sstevel@tonic-gate return $ENV{'DEFAULT'} unless @_; 468*0Sstevel@tonic-gate my $path = VMS::Filespec::pathify($_[0]); 469*0Sstevel@tonic-gate if (! defined $path) 470*0Sstevel@tonic-gate { 471*0Sstevel@tonic-gate _croak("Invalid path name $_[0]") 472*0Sstevel@tonic-gate } 473*0Sstevel@tonic-gate return VMS::Filespec::rmsexpand($path); 474*0Sstevel@tonic-gate} 475*0Sstevel@tonic-gate 476*0Sstevel@tonic-gatesub _os2_cwd { 477*0Sstevel@tonic-gate $ENV{'PWD'} = `cmd /c cd`; 478*0Sstevel@tonic-gate chomp $ENV{'PWD'}; 479*0Sstevel@tonic-gate $ENV{'PWD'} =~ s:\\:/:g ; 480*0Sstevel@tonic-gate return $ENV{'PWD'}; 481*0Sstevel@tonic-gate} 482*0Sstevel@tonic-gate 483*0Sstevel@tonic-gatesub _win32_cwd { 484*0Sstevel@tonic-gate $ENV{'PWD'} = Win32::GetCwd(); 485*0Sstevel@tonic-gate $ENV{'PWD'} =~ s:\\:/:g ; 486*0Sstevel@tonic-gate return $ENV{'PWD'}; 487*0Sstevel@tonic-gate} 488*0Sstevel@tonic-gate 489*0Sstevel@tonic-gate*_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd && 490*0Sstevel@tonic-gate defined &Win32::GetCwd); 491*0Sstevel@tonic-gate 492*0Sstevel@tonic-gate*_NT_cwd = \&_os2_cwd unless defined &_NT_cwd; 493*0Sstevel@tonic-gate 494*0Sstevel@tonic-gatesub _dos_cwd { 495*0Sstevel@tonic-gate if (!defined &Dos::GetCwd) { 496*0Sstevel@tonic-gate $ENV{'PWD'} = `command /c cd`; 497*0Sstevel@tonic-gate chomp $ENV{'PWD'}; 498*0Sstevel@tonic-gate $ENV{'PWD'} =~ s:\\:/:g ; 499*0Sstevel@tonic-gate } else { 500*0Sstevel@tonic-gate $ENV{'PWD'} = Dos::GetCwd(); 501*0Sstevel@tonic-gate } 502*0Sstevel@tonic-gate return $ENV{'PWD'}; 503*0Sstevel@tonic-gate} 504*0Sstevel@tonic-gate 505*0Sstevel@tonic-gatesub _qnx_cwd { 506*0Sstevel@tonic-gate local $ENV{PATH} = ''; 507*0Sstevel@tonic-gate local $ENV{CDPATH} = ''; 508*0Sstevel@tonic-gate local $ENV{ENV} = ''; 509*0Sstevel@tonic-gate $ENV{'PWD'} = `/usr/bin/fullpath -t`; 510*0Sstevel@tonic-gate chomp $ENV{'PWD'}; 511*0Sstevel@tonic-gate return $ENV{'PWD'}; 512*0Sstevel@tonic-gate} 513*0Sstevel@tonic-gate 514*0Sstevel@tonic-gatesub _qnx_abs_path { 515*0Sstevel@tonic-gate local $ENV{PATH} = ''; 516*0Sstevel@tonic-gate local $ENV{CDPATH} = ''; 517*0Sstevel@tonic-gate local $ENV{ENV} = ''; 518*0Sstevel@tonic-gate my $path = @_ ? shift : '.'; 519*0Sstevel@tonic-gate local *REALPATH; 520*0Sstevel@tonic-gate 521*0Sstevel@tonic-gate open(REALPATH, '-|', '/usr/bin/fullpath', '-t', $path) or 522*0Sstevel@tonic-gate die "Can't open /usr/bin/fullpath: $!"; 523*0Sstevel@tonic-gate my $realpath = <REALPATH>; 524*0Sstevel@tonic-gate close REALPATH; 525*0Sstevel@tonic-gate chomp $realpath; 526*0Sstevel@tonic-gate return $realpath; 527*0Sstevel@tonic-gate} 528*0Sstevel@tonic-gate 529*0Sstevel@tonic-gatesub _epoc_cwd { 530*0Sstevel@tonic-gate $ENV{'PWD'} = EPOC::getcwd(); 531*0Sstevel@tonic-gate return $ENV{'PWD'}; 532*0Sstevel@tonic-gate} 533*0Sstevel@tonic-gate 534*0Sstevel@tonic-gate{ 535*0Sstevel@tonic-gate no warnings; # assignments trigger 'subroutine redefined' warning 536*0Sstevel@tonic-gate 537*0Sstevel@tonic-gate if ($^O eq 'VMS') { 538*0Sstevel@tonic-gate *cwd = \&_vms_cwd; 539*0Sstevel@tonic-gate *getcwd = \&_vms_cwd; 540*0Sstevel@tonic-gate *fastcwd = \&_vms_cwd; 541*0Sstevel@tonic-gate *fastgetcwd = \&_vms_cwd; 542*0Sstevel@tonic-gate *abs_path = \&_vms_abs_path; 543*0Sstevel@tonic-gate *fast_abs_path = \&_vms_abs_path; 544*0Sstevel@tonic-gate } 545*0Sstevel@tonic-gate elsif ($^O eq 'NT' or $^O eq 'MSWin32') { 546*0Sstevel@tonic-gate # We assume that &_NT_cwd is defined as an XSUB or in the core. 547*0Sstevel@tonic-gate *cwd = \&_NT_cwd; 548*0Sstevel@tonic-gate *getcwd = \&_NT_cwd; 549*0Sstevel@tonic-gate *fastcwd = \&_NT_cwd; 550*0Sstevel@tonic-gate *fastgetcwd = \&_NT_cwd; 551*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 552*0Sstevel@tonic-gate *realpath = \&fast_abs_path; 553*0Sstevel@tonic-gate } 554*0Sstevel@tonic-gate elsif ($^O eq 'dos') { 555*0Sstevel@tonic-gate *cwd = \&_dos_cwd; 556*0Sstevel@tonic-gate *getcwd = \&_dos_cwd; 557*0Sstevel@tonic-gate *fastgetcwd = \&_dos_cwd; 558*0Sstevel@tonic-gate *fastcwd = \&_dos_cwd; 559*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 560*0Sstevel@tonic-gate } 561*0Sstevel@tonic-gate elsif ($^O =~ m/^(?:qnx|nto)$/ ) { 562*0Sstevel@tonic-gate *cwd = \&_qnx_cwd; 563*0Sstevel@tonic-gate *getcwd = \&_qnx_cwd; 564*0Sstevel@tonic-gate *fastgetcwd = \&_qnx_cwd; 565*0Sstevel@tonic-gate *fastcwd = \&_qnx_cwd; 566*0Sstevel@tonic-gate *abs_path = \&_qnx_abs_path; 567*0Sstevel@tonic-gate *fast_abs_path = \&_qnx_abs_path; 568*0Sstevel@tonic-gate } 569*0Sstevel@tonic-gate elsif ($^O eq 'cygwin') { 570*0Sstevel@tonic-gate *getcwd = \&cwd; 571*0Sstevel@tonic-gate *fastgetcwd = \&cwd; 572*0Sstevel@tonic-gate *fastcwd = \&cwd; 573*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 574*0Sstevel@tonic-gate *realpath = \&abs_path; 575*0Sstevel@tonic-gate } 576*0Sstevel@tonic-gate elsif ($^O eq 'epoc') { 577*0Sstevel@tonic-gate *cwd = \&_epoc_cwd; 578*0Sstevel@tonic-gate *getcwd = \&_epoc_cwd; 579*0Sstevel@tonic-gate *fastgetcwd = \&_epoc_cwd; 580*0Sstevel@tonic-gate *fastcwd = \&_epoc_cwd; 581*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 582*0Sstevel@tonic-gate } 583*0Sstevel@tonic-gate elsif ($^O eq 'MacOS') { 584*0Sstevel@tonic-gate *getcwd = \&cwd; 585*0Sstevel@tonic-gate *fastgetcwd = \&cwd; 586*0Sstevel@tonic-gate *fastcwd = \&cwd; 587*0Sstevel@tonic-gate *abs_path = \&fast_abs_path; 588*0Sstevel@tonic-gate } 589*0Sstevel@tonic-gate} 590*0Sstevel@tonic-gate 591*0Sstevel@tonic-gate 592*0Sstevel@tonic-gate1; 593