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     $dir = cwd;
  12
  13     use Cwd;
  14     $dir = getcwd;
  15
  16     use Cwd;
  17     $dir = fastcwd;
  18
  19     use Cwd;
  20     $dir = fastgetcwd;
  21
  22     use Cwd 'chdir';
  23     chdir "/tmp";
  24     print $ENV{'PWD'};
  25
  26     use Cwd 'abs_path';     # aka realpath()
  27     print abs_path($ENV{'PWD'});
  28
  29     use Cwd 'fast_abs_path';
  30     print fast_abs_path($ENV{'PWD'});
  31
  32 =head1 DESCRIPTION
  33
  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
  46 The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
  47 in Perl.
  48
  49 The fastcwd() function looks the same as getcwd(), but runs faster.
  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.
  58
  59 The fastgetcwd() function is provided as a synonym for cwd().
  60
  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.
  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
  73 L<perlsub/Overriding Builtin Functions>.) Note that it will only be
  74 kept up to date if all packages which use chdir import it from Cwd.
  75
  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
  98 =cut
  99
 100 use strict;
 101
 102 use Carp;
 103
 104 our $VERSION = '2.05';
 105
 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);
 109
 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
 129 eval {
 130     require XSLoader;
 131     XSLoader::load('Cwd');
 132 };
 133
 134
 135 # Find the pwd command in the expected locations.  We assume these
 136 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
 137 # so everything works under taint mode.
 138 my $pwd_cmd;
 139 foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
 140     if( -x $try ) {
 141         $pwd_cmd = $try;
 142         last;
 143     }
 144 }
 145 $pwd_cmd ||= 'pwd';
 146
 147 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 148 sub _backtick_pwd {
 149     my $cwd = `$pwd_cmd`;
 150     # `pwd` may fail e.g. if the disk is full
 151     chomp($cwd) if defined $cwd;
 152     $cwd;
 153 }
 154
 155 # Since some ports may predefine cwd internally (e.g., NT)
 156 # we take care not to override an existing definition for cwd().
 157
 158 unless(defined &cwd) {
 159     # The pwd command is not available in some chroot(2)'ed environments
 160     if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
 161         *cwd = \&_backtick_pwd;
 162     }
 163     else {
 164         *cwd = \&getcwd;
 165     }
 166 }
 167
 168 # set a reasonable (and very safe) default for fastgetcwd, in case it
 169 # isn't redefined later (20001212 rspier)
 170 *fastgetcwd = \&cwd;
 171
 172 # By Brandon S. Allbery
 173 #
 174 # Usage: $cwd = getcwd();
 175
 176 sub getcwd
 177 {
 178     abs_path('.');
 179 }
 180
 181 # Keeps track of current working directory in PWD environment var
 182 # Usage:
 183 #       use Cwd 'chdir';
 184 #       chdir $newdir;
 185
 186 my $chdir_init = 0;
 187
 188 sub chdir_init {
 189     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
 190         my($dd,$di) = stat('.');
 191         my($pd,$pi) = stat($ENV{'PWD'});
 192         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
 193             $ENV{'PWD'} = cwd();
 194         }
 195     }
 196     else {
 197         my $wd = cwd();
 198         $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
 199         $ENV{'PWD'} = $wd;
 200     }
 201     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
 202     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
 203         my($pd,$pi) = stat($2);
 204         my($dd,$di) = stat($1);
 205         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
 206             $ENV{'PWD'}="$2$3";
 207         }
 208     }
 209     $chdir_init = 1;
 210 }
 211
 212 sub chdir {
 213     my $newdir = @_ ? shift : '';       # allow for no arg (chdir to HOME dir)
 214     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
 215     chdir_init() unless $chdir_init;
 216     my $newpwd;
 217     if ($^O eq 'MSWin32') {
 218         # get the full path name *before* the chdir()
 219         $newpwd = Win32::GetFullPathName($newdir);
 220     }
 221
 222     return 0 unless CORE::chdir $newdir;
 223
 224     if ($^O eq 'VMS') {
 225         return $ENV{'PWD'} = $ENV{'DEFAULT'}
 226     }
 227     elsif ($^O eq 'MacOS') {
 228         return $ENV{'PWD'} = cwd();
 229     }
 230     elsif ($^O eq 'MSWin32') {
 231         $ENV{'PWD'} = $newpwd;
 232         return 1;
 233     }
 234
 235     if ($newdir =~ m#^/#s) {
 236         $ENV{'PWD'} = $newdir;
 237     } else {
 238         my @curdir = split(m#/#,$ENV{'PWD'});
 239         @curdir = ('') unless @curdir;
 240         my $component;
 241         foreach $component (split(m#/#, $newdir)) {
 242             next if $component eq '.';
 243             pop(@curdir),next if $component eq '..';
 244             push(@curdir,$component);
 245         }
 246         $ENV{'PWD'} = join('/',@curdir) || '/';
 247     }
 248     1;
 249 }
 250
 251 # added function alias for those of us more
 252 # used to the libc function.  --tchrist 27-Jan-00
 253 *realpath = \&abs_path;
 254
 255 sub fast_abs_path {
 256     my $cwd = getcwd();
 257     require File::Spec;
 258     my $path = @_ ? shift : File::Spec->curdir;
 259     CORE::chdir($path) || croak "Cannot chdir to $path:$!";
 260     my $realpath = getcwd();
 261     CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
 262     $realpath;
 263 }
 264
 265 # added function alias to follow principle of least surprise
 266 # based on previous aliasing.  --tchrist 27-Jan-00
 267 *fast_realpath = \&fast_abs_path;
 268
 269
 270 # --- PORTING SECTION ---
 271
 272 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 273 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
 274 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
 275 #   in the process logical name table as the default device and directory
 276 #   seen by Perl. This may not be the same as the default device
 277 #   and directory seen by DCL after Perl exits, since the effects
 278 #   the CRTL chdir() function persist only until Perl exits.
 279
 280 sub _vms_cwd {
 281     return $ENV{'DEFAULT'};
 282 }
 283
 284 sub _vms_abs_path {
 285     return $ENV{'DEFAULT'} unless @_;
 286     my $path = VMS::Filespec::pathify($_[0]);
 287     croak("Invalid path name $_[0]") unless defined $path;
 288     return VMS::Filespec::rmsexpand($path);
 289 }
 290
 291 sub _os2_cwd {
 292     $ENV{'PWD'} = `cmd /c cd`;
 293     chop $ENV{'PWD'};
 294     $ENV{'PWD'} =~ s:\\:/:g ;
 295     return $ENV{'PWD'};
 296 }
 297
 298 sub _win32_cwd {
 299     $ENV{'PWD'} = Win32::GetCwd();
 300     $ENV{'PWD'} =~ s:\\:/:g ;
 301     return $ENV{'PWD'};
 302 }
 303
 304 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
 305                             defined &Win32::GetCwd);
 306
 307 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
 308
 309 sub _dos_cwd {
 310     if (!defined &Dos::GetCwd) {
 311         $ENV{'PWD'} = `command /c cd`;
 312         chop $ENV{'PWD'};
 313         $ENV{'PWD'} =~ s:\\:/:g ;
 314     } else {
 315         $ENV{'PWD'} = Dos::GetCwd();
 316     }
 317     return $ENV{'PWD'};
 318 }
 319
 320 sub _qnx_cwd {
 321     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
 322     chop $ENV{'PWD'};
 323     return $ENV{'PWD'};
 324 }
 325
 326 sub _qnx_abs_path {
 327     my $path = @_ ? shift : '.';
 328     my $realpath=`/usr/bin/fullpath -t $path`;
 329     chop $realpath;
 330     return $realpath;
 331 }
 332
 333 sub _epoc_cwd {
 334     $ENV{'PWD'} = EPOC::getcwd();
 335     return $ENV{'PWD'};
 336 }
 337
 338 {
 339     no warnings;        # assignments trigger 'subroutine redefined' warning
 340
 341     if ($^O eq 'VMS') {
 342         *cwd            = \&_vms_cwd;
 343         *getcwd         = \&_vms_cwd;
 344         *fastcwd        = \&_vms_cwd;
 345         *fastgetcwd     = \&_vms_cwd;
 346         *abs_path       = \&_vms_abs_path;
 347         *fast_abs_path  = \&_vms_abs_path;
 348     }
 349     elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
 350         # We assume that &_NT_cwd is defined as an XSUB or in the core.
 351         *cwd            = \&_NT_cwd;
 352         *getcwd         = \&_NT_cwd;
 353         *fastcwd        = \&_NT_cwd;
 354         *fastgetcwd     = \&_NT_cwd;
 355         *abs_path       = \&fast_abs_path;
 356     }
 357     elsif ($^O eq 'os2') {
 358         # sys_cwd may keep the builtin command
 359         *cwd            = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
 360         *getcwd         = \&cwd;
 361         *fastgetcwd     = \&cwd;
 362         *fastcwd        = \&cwd;
 363         *abs_path       = \&fast_abs_path;
 364     }
 365     elsif ($^O eq 'dos') {
 366         *cwd            = \&_dos_cwd;
 367         *getcwd         = \&_dos_cwd;
 368         *fastgetcwd     = \&_dos_cwd;
 369         *fastcwd        = \&_dos_cwd;
 370         *abs_path       = \&fast_abs_path;
 371     }
 372     elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
 373         *cwd            = \&_qnx_cwd;
 374         *getcwd         = \&_qnx_cwd;
 375         *fastgetcwd     = \&_qnx_cwd;
 376         *fastcwd        = \&_qnx_cwd;
 377         *abs_path       = \&_qnx_abs_path;
 378         *fast_abs_path  = \&_qnx_abs_path;
 379     }
 380     elsif ($^O eq 'cygwin') {
 381         *getcwd = \&cwd;
 382         *fastgetcwd     = \&cwd;
 383         *fastcwd        = \&cwd;
 384         *abs_path       = \&fast_abs_path;
 385     }
 386     elsif ($^O eq 'epoc') {
 387         *cwd            = \&_epoc_cwd;
 388         *getcwd         = \&_epoc_cwd;
 389         *fastgetcwd     = \&_epoc_cwd;
 390         *fastcwd        = \&_epoc_cwd;
 391         *abs_path       = \&fast_abs_path;
 392     }
 393     elsif ($^O eq 'MacOS') {
 394         *getcwd     = \&cwd;
 395         *fastgetcwd = \&cwd;
 396         *fastcwd    = \&cwd;
 397         *abs_path   = \&fast_abs_path;
 398     }
 399 }
 400
 401 # package main; eval join('',<DATA>) || die $@; # quick test
 402
 403 1;
 404
 405 __END__
 406 BEGIN { import Cwd qw(:DEFAULT chdir); }
 407 print join("\n", cwd, getcwd, fastcwd, "");
 408 chdir('..');
 409 print join("\n", cwd, getcwd, fastcwd, "");
 410 print "$ENV{PWD}\n";