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 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 135
 136 sub _backtick_pwd {
 137     my $cwd = `pwd`;
 138     # `pwd` may fail e.g. if the disk is full
 139     chomp($cwd) if defined $cwd;
 140     $cwd;
 141 }
 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
 146 unless(defined &cwd) {
 147     # The pwd command is not available in some chroot(2)'ed environments
 148     if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
 149         *cwd = \&_backtick_pwd;
 150     }
 151     else {
 152         *cwd = \&getcwd;
 153     }
 154 }
 155
 156 # set a reasonable (and very safe) default for fastgetcwd, in case it
 157 # isn't redefined later (20001212 rspier)
 158 *fastgetcwd = \&cwd;
 159
 160 # By Brandon S. Allbery
 161 #
 162 # Usage: $cwd = getcwd();
 163
 164 sub getcwd
 165 {
 166     abs_path('.');
 167 }
 168
 169 # Keeps track of current working directory in PWD environment var
 170 # Usage:
 171 #       use Cwd 'chdir';
 172 #       chdir $newdir;
 173
 174 my $chdir_init = 0;
 175
 176 sub chdir_init {
 177     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
 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) {
 181             $ENV{'PWD'} = cwd();
 182         }
 183     }
 184     else {
 185         my $wd = cwd();
 186         $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
 187         $ENV{'PWD'} = $wd;
 188     }
 189     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
 190     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
 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 {
 201     my $newdir = @_ ? shift : '';       # allow for no arg (chdir to HOME dir)
 202     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
 203     chdir_init() unless $chdir_init;
 204     my $newpwd;
 205     if ($^O eq 'MSWin32') {
 206         # get the full path name *before* the chdir()
 207         $newpwd = Win32::GetFullPathName($newdir);
 208     }
 209
 210     return 0 unless CORE::chdir $newdir;
 211
 212     if ($^O eq 'VMS') {
 213         return $ENV{'PWD'} = $ENV{'DEFAULT'}
 214     }
 215     elsif ($^O eq 'MacOS') {
 216         return $ENV{'PWD'} = cwd();
 217     }
 218     elsif ($^O eq 'MSWin32') {
 219         $ENV{'PWD'} = $newpwd;
 220         return 1;
 221     }
 222
 223     if ($newdir =~ m#^/#s) {
 224         $ENV{'PWD'} = $newdir;
 225     } else {
 226         my @curdir = split(m#/#,$ENV{'PWD'});
 227         @curdir = ('') unless @curdir;
 228         my $component;
 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     }
 236     1;
 237 }
 238
 239 # added function alias for those of us more
 240 # used to the libc function.  --tchrist 27-Jan-00
 241 *realpath = \&abs_path;
 242
 243 sub fast_abs_path {
 244     my $cwd = getcwd();
 245     require File::Spec;
 246     my $path = @_ ? shift : File::Spec->curdir;
 247     CORE::chdir($path) || croak "Cannot chdir to $path:$!";
 248     my $realpath = getcwd();
 249     CORE::chdir($cwd)  || croak "Cannot chdir back to $cwd:$!";
 250     $realpath;
 251 }
 252
 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
 257
 258 # --- PORTING SECTION ---
 259
 260 # VMS: $ENV{'DEFAULT'} points to default directory at all times
 261 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
 262 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
 263 #   in the process logical name table as the default device and directory
 264 #   seen by Perl. This may not be the same as the default device
 265 #   and directory seen by DCL after Perl exits, since the effects
 266 #   the CRTL chdir() function persist only until Perl exits.
 267
 268 sub _vms_cwd {
 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);
 277 }
 278
 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
 286 sub _win32_cwd {
 287     $ENV{'PWD'} = Win32::GetCwd();
 288     $ENV{'PWD'} =~ s:\\:/:g ;
 289     return $ENV{'PWD'};
 290 }
 291
 292 *_NT_cwd = \&_win32_cwd if (!defined &_NT_cwd &&
 293                             defined &Win32::GetCwd);
 294
 295 *_NT_cwd = \&_os2_cwd unless defined &_NT_cwd;
 296
 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     }
 305     return $ENV{'PWD'};
 306 }
 307
 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 {
 315     my $path = @_ ? shift : '.';
 316     my $realpath=`/usr/bin/fullpath -t $path`;
 317     chop $realpath;
 318     return $realpath;
 319 }
 320
 321 sub _epoc_cwd {
 322     $ENV{'PWD'} = EPOC::getcwd();
 323     return $ENV{'PWD'};
 324 }
 325
 326 {
 327     no warnings;        # assignments trigger 'subroutine redefined' warning
 328
 329     if ($^O eq 'VMS') {
 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;
 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.
 339         *cwd            = \&_NT_cwd;
 340         *getcwd         = \&_NT_cwd;
 341         *fastcwd        = \&_NT_cwd;
 342         *fastgetcwd     = \&_NT_cwd;
 343         *abs_path       = \&fast_abs_path;
 344     }
 345     elsif ($^O eq 'os2') {
 346         # sys_cwd may keep the builtin command
 347         *cwd            = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
 348         *getcwd         = \&cwd;
 349         *fastgetcwd     = \&cwd;
 350         *fastcwd        = \&cwd;
 351         *abs_path       = \&fast_abs_path;
 352     }
 353     elsif ($^O eq 'dos') {
 354         *cwd            = \&_dos_cwd;
 355         *getcwd         = \&_dos_cwd;
 356         *fastgetcwd     = \&_dos_cwd;
 357         *fastcwd        = \&_dos_cwd;
 358         *abs_path       = \&fast_abs_path;
 359     }
 360     elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
 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     }
 368     elsif ($^O eq 'cygwin') {
 369         *getcwd = \&cwd;
 370         *fastgetcwd     = \&cwd;
 371         *fastcwd        = \&cwd;
 372         *abs_path       = \&fast_abs_path;
 373     }
 374     elsif ($^O eq 'epoc') {
 375         *cwd            = \&_epoc_cwd;
 376         *getcwd         = \&_epoc_cwd;
 377         *fastgetcwd     = \&_epoc_cwd;
 378         *fastcwd        = \&_epoc_cwd;
 379         *abs_path       = \&fast_abs_path;
 380     }
 381     elsif ($^O eq 'MacOS') {
 382         *getcwd     = \&cwd;
 383         *fastgetcwd = \&cwd;
 384         *fastcwd    = \&cwd;
 385         *abs_path   = \&fast_abs_path;
 386     }
 387 }
 388
 389 # package main; eval join('',<DATA>) || die $@; # quick test
 390
 391 1;
 392
 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";