lib/Cwd.pm

   1 package Cwd;
   2 require 5.6.0;
   3
   4 =head1 NAME
   5
   6 Cwd - get pathname of current working directory
   7
   8 =head1 SYNOPSIS
   9
  10     use Cwd;
  11     my $dir = getcwd;
  12
  13     use Cwd 'abs_path';
  14     my $abs_path = abs_path($file);
  15
  16 =head1 DESCRIPTION
  17
  18 This module provides functions for determining the pathname of the
  19 current working directory.  It is recommended that getcwd (or another
  20 *cwd() function) be used in I<all> code to ensure portability.
  21
  22 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
  23 fastgetcwd() into the caller's namespace.
  24
  25
  26 =head2 getcwd and friends
  27
  28 Each of these functions are called without arguments and return the
  29 absolute path of the current working directory.
  30
  31 =over 4
  32
  33 =item getcwd
  34
  35     my $cwd = getcwd();
  36
  37 Returns the current working directory.
  38
  39 Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
  40
  41 =item cwd
  42
  43     my $cwd = cwd();
  44
  45 The cwd() is the most natural form for the current architecture. For
  46 most systems it is identical to `pwd` (but without the trailing line
  47 terminator).
  48
  49 Unfortunately, cwd() tends to break if called under taint mode.
  50
  51 =item fastcwd
  52
  53     my $cwd = fastcwd();
  54
  55 A more dangerous version of getcwd(), but potentially faster.
  56
  57 It might conceivably chdir() you out of a directory that it can't
  58 chdir() you back into.  If fastcwd encounters a problem it will return
  59 undef but will probably leave you in a different directory.  For a
  60 measure of extra security, if everything appears to have worked, the
  61 fastcwd() function will check that it leaves you in the same directory
  62 that it started in. If it has changed it will C<die> with the message
  63 "Unstable directory path, current directory changed
  64 unexpectedly". That should never happen.
  65
  66 =item fastgetcwd
  67
  68   my $cwd = fastgetcwd();
  69
  70 The fastgetcwd() function is provided as a synonym for cwd().
  71
  72 =back
  73
  74
  75 =head2 abs_path and friends
  76
  77 These functions are exported only on request.  They each take a single
  78 argument and return the absolute pathname for it.
  79
  80 =over 4
  81
  82 =item abs_path
  83
  84   my $abs_path = abs_path($file);
  85
  86 Uses the same algorithm as getcwd().  Symbolic links and relative-path
  87 components ("." and "..") are resolved to return the canonical
  88 pathname, just like realpath(3).
  89
  90 =item realpath
  91
  92   my $abs_path = realpath($file);
  93
  94 A synonym for abs_path().
  95
  96 =item fast_abs_path
  97
  98   my $abs_path = abs_path($file);
  99
 100 A more dangerous, but potentially faster version of abs_path.
 101
 102 =back
 103
 104 =head2 $ENV{PWD}
 105
 106 If you ask to override your chdir() built-in function,
 107
 108   use Cwd qw(chdir);
 109
 110 then your PWD environment variable will be kept up to date.  Note that
 111 it will only be kept up to date if all packages which use chdir import
 112 it from Cwd.
 113
 114
 115 =head1 NOTES
 116
 117 =over 4
 118
 119 =item *
 120
 121 Since the path seperators are different on some operating systems ('/'
 122 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
 123 modules wherever portability is a concern.
 124
 125 =item *
 126
 127 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
 128 functions  are all aliases for the C<cwd()> function, which, on Mac OS,
 129 calls `pwd`. Likewise, the C<abs_path()> function is an alias for
 130 C<fast_abs_path()>.
 131
 132 =back
 133
 134 =head1 SEE ALSO
 135
 136 L<File::chdir>
 137
 138 =cut
 139
 140 use strict;
 141
 142 use Carp;
 143
 144 our $VERSION = '2.06';
 145
 146 use base qw/ Exporter /;
 147 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 148 our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 149
 150 # sys_cwd may keep the builtin command
 151
 152 # All the functionality of this module may provided by builtins,
 153 # there is no sense to process the rest of the file.
 154 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
 155
 156 if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
 157     local $^W = 0;
 158     *cwd                = \&sys_cwd;
 159     *getcwd             = \&cwd;
 160     *fastgetcwd         = \&cwd;
 161     *fastcwd            = \&cwd;
 162     *abs_path           = \&sys_abspath;
 163     *fast_abs_path      = \&abs_path;
 164     *realpath           = \&abs_path;
 165     *fast_realpath      = \&abs_path;
 166     return 1;
 167 }
 168
 169 eval {
 170     require XSLoader;
 171     XSLoader::load('Cwd');
 172 };
 173
 174
 175 # Find the pwd command in the expected locations.  We assume these
 176 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
 177 # so everything works under taint mode.
 178 my $pwd_cmd;
 179 foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
 180     if( -x $try ) {
 181         $pwd_cmd = $try;
 182         last;
 183     }
 184 }
 185 $pwd_cmd ||= 'pwd';
 186
 187 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 188 sub _backtick_pwd {
 189     my $cwd = `$pwd_cmd`;
 190     # `pwd` may fail e.g. if the disk is full
 191     chomp($cwd) if defined $cwd;
 192     $cwd;
 193 }
 194
 195 # Since some ports may predefine cwd internally (e.g., NT)
 196 # we take care not to override an existing definition for cwd().
 197
 198 unless(defined &cwd) {
 199     # The pwd command is not available in some chroot(2)'ed environments
 200     if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
 201         *cwd = \&_backtick_pwd;
 202     }
 203     else {
 204         *cwd = \&getcwd;
 205     }
 206 }
 207
 208 # set a reasonable (and very safe) default for fastgetcwd, in case it
 209 # isn't redefined later (20001212 rspier)
 210 *fastgetcwd = \&cwd;
 211
 212 # By Brandon S. Allbery
 213 #
 214 # Usage: $cwd = getcwd();
 215
 216 sub getcwd
 217 {
 218     abs_path('.');
 219 }
 220
 221 # Keeps track of current working directory in PWD environment var
 222 # Usage:
 223 #       use Cwd 'chdir';
 224 #       chdir $newdir;
 225
 226 my $chdir_init = 0;
 227
 228 sub chdir_init {
 229     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
 230         my($dd,$di) = stat('.');
 231         my($pd,$pi) = stat($ENV{'PWD'});
 232         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
 233             $ENV{'PWD'} = cwd();
 234         }
 235     }
 236     else {
 237         my $wd = cwd();
 238         $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
 239         $ENV{'PWD'} = $wd;
 240     }
 241     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
 242     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
 243         my($pd,$pi) = stat($2);
 244         my($dd,$di) = stat($1);
 245         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
 246             $ENV{'PWD'}="$2$3";
 247         }
 248     }
 249     $chdir_init = 1;
 250 }
 251
 252 sub chdir {
 253     my $newdir = @_ ? shift : '';       # allow for no arg (chdir to HOME dir)
 254     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
 255     chdir_init() unless $chdir_init;
 256     my $newpwd;
 257     if ($^O eq 'MSWin32') {
 258         # get the full path name *before* the chdir()
 259         $newpwd = Win32::GetFullPathName($newdir);
 260     }
 261
 262     return 0 unless CORE::chdir $newdir;
 263
 264     if ($^O eq 'VMS') {
 265         return $ENV{'PWD'} = $ENV{'DEFAULT'}
 266     }
 267     elsif ($^O eq 'MacOS') {
 268         return $ENV{'PWD'} = cwd();
 269     }
 270     elsif ($^O eq 'MSWin32') {
 271         $ENV{'PWD'} = $newpwd;
 272         return 1;
 273     }
 274
 275     if ($newdir =~ m#^/#s) {
 276         $ENV{'PWD'} = $newdir;
 277     } else {
 278         my @curdir = split(m#/#,$ENV{'PWD'});
 279         @curdir = ('') unless @curdir;
 280         my $component;
 281         foreach $component (split(m#/#, $newdir)) {
 282             next if $component eq '.';
 283             pop(@curdir),next if $component eq '..';
 284             push(@curdir,$component);
 285         }
 286         $ENV{'PWD'} = join('/',@curdir) || '/';
 287     }
 288     1;
 289 }
 290
 291 # added function alias for those of us more
 292 # used to the libc function.  --tchrist 27-Jan-00
 293 *realpath = \&abs_path;
 294
 295 sub fast_abs_path {
 296     my $cwd = getcwd();
 297     require File::Spec;
 298     my $path = @_ ? shift : File::Spec->curdir;
 299     CORE::chdir($path) || croak "Cannot chdir to $path:$!";
 300     my $realpath = getcwd();
 301     CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
 302     $realpath;
 303 }
 304
 305 # added function alias to follow principle of least surprise
 306 # based on previous aliasing.  --tchrist 27-Jan-00
 307 *fast_realpath = \&fast_abs_path;
 308
 309
 310 # --- PORTING SECTION ---
 311
 312 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 313 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
 314 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
 315 #   in the process logical name table as the default device and directory
 316 #   seen by Perl. This may not be the same as the default device
 317 #   and directory seen by DCL after Perl exits, since the effects
 318 #   the CRTL chdir() function persist only until Perl exits.
 319
 320 sub _vms_cwd {
 321     return $ENV{'DEFAULT'};
 322 }
 323
 324 sub _vms_abs_path {
 325     return $ENV{'DEFAULT'} unless @_;
 326     my $path = VMS::Filespec::pathify($_[0]);
 327     croak("Invalid path name $_[0]") unless defined $path;
 328     return VMS::Filespec::rmsexpand($path);
 329 }
 330
 331 sub _os2_cwd {
 332     $ENV{'PWD'} = `cmd /c cd`;
 333     chop $ENV{'PWD'};
 334     $ENV{'PWD'} =~ s:\\:/:g ;
 335     return $ENV{'PWD'};
 336 }
 337
 338 sub _win32_cwd {
 339     $ENV{'PWD'} = Win32::GetCwd();
 340     $ENV{'PWD'} =~ s:\\:/:g ;
 341     return $ENV{'PWD'};
 342 }
 343
 344 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
 345                             defined &Win32::GetCwd);
 346
 347 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
 348
 349 sub _dos_cwd {
 350     if (!defined &Dos::GetCwd) {
 351         $ENV{'PWD'} = `command /c cd`;
 352         chop $ENV{'PWD'};
 353         $ENV{'PWD'} =~ s:\\:/:g ;
 354     } else {
 355         $ENV{'PWD'} = Dos::GetCwd();
 356     }
 357     return $ENV{'PWD'};
 358 }
 359
 360 sub _qnx_cwd {
 361     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
 362     chop $ENV{'PWD'};
 363     return $ENV{'PWD'};
 364 }
 365
 366 sub _qnx_abs_path {
 367     my $path = @_ ? shift : '.';
 368     my $realpath=`/usr/bin/fullpath -t $path`;
 369     chop $realpath;
 370     return $realpath;
 371 }
 372
 373 sub _epoc_cwd {
 374     $ENV{'PWD'} = EPOC::getcwd();
 375     return $ENV{'PWD'};
 376 }
 377
 378 {
 379     no warnings;        # assignments trigger 'subroutine redefined' warning
 380
 381     if ($^O eq 'VMS') {
 382         *cwd            = \&_vms_cwd;
 383         *getcwd         = \&_vms_cwd;
 384         *fastcwd        = \&_vms_cwd;
 385         *fastgetcwd     = \&_vms_cwd;
 386         *abs_path       = \&_vms_abs_path;
 387         *fast_abs_path  = \&_vms_abs_path;
 388     }
 389     elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
 390         # We assume that &_NT_cwd is defined as an XSUB or in the core.
 391         *cwd            = \&_NT_cwd;
 392         *getcwd         = \&_NT_cwd;
 393         *fastcwd        = \&_NT_cwd;
 394         *fastgetcwd     = \&_NT_cwd;
 395         *abs_path       = \&fast_abs_path;
 396     }
 397     elsif ($^O eq 'os2') {
 398         # sys_cwd may keep the builtin command
 399         *cwd            = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
 400         *getcwd         = \&cwd;
 401         *fastgetcwd     = \&cwd;
 402         *fastcwd        = \&cwd;
 403         *abs_path       = \&fast_abs_path;
 404     }
 405     elsif ($^O eq 'dos') {
 406         *cwd            = \&_dos_cwd;
 407         *getcwd         = \&_dos_cwd;
 408         *fastgetcwd     = \&_dos_cwd;
 409         *fastcwd        = \&_dos_cwd;
 410         *abs_path       = \&fast_abs_path;
 411     }
 412     elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
 413         *cwd            = \&_qnx_cwd;
 414         *getcwd         = \&_qnx_cwd;
 415         *fastgetcwd     = \&_qnx_cwd;
 416         *fastcwd        = \&_qnx_cwd;
 417         *abs_path       = \&_qnx_abs_path;
 418         *fast_abs_path  = \&_qnx_abs_path;
 419     }
 420     elsif ($^O eq 'cygwin') {
 421         *getcwd = \&cwd;
 422         *fastgetcwd     = \&cwd;
 423         *fastcwd        = \&cwd;
 424         *abs_path       = \&fast_abs_path;
 425     }
 426     elsif ($^O eq 'epoc') {
 427         *cwd            = \&_epoc_cwd;
 428         *getcwd         = \&_epoc_cwd;
 429         *fastgetcwd     = \&_epoc_cwd;
 430         *fastcwd        = \&_epoc_cwd;
 431         *abs_path       = \&fast_abs_path;
 432     }
 433     elsif ($^O eq 'MacOS') {
 434         *getcwd     = \&cwd;
 435         *fastgetcwd = \&cwd;
 436         *fastcwd    = \&cwd;
 437         *abs_path   = \&fast_abs_path;
 438     }
 439 }
 440
 441 # package main; eval join('',<DATA>) || die $@; # quick test
 442
 443 1;
 444
 445 __END__
 446 BEGIN { import Cwd qw(:DEFAULT chdir); }
 447 print join("\n", cwd, getcwd, fastcwd, "");
 448 chdir('..');
 449 print join("\n", cwd, getcwd, fastcwd, "");
 450 print "$ENV{PWD}\n";