This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PathTools: bump version for CVE-2015-8607 fix
[perl5.git] / dist / PathTools / Cwd.pm
1 package Cwd;
2 use strict;
3 use Exporter;
4 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
5
6 $VERSION = '3.62';
7 my $xs_version = $VERSION;
8 $VERSION =~ tr/_//d;
9
10 @ISA = qw/ Exporter /;
11 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
12 push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
13 @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
14
15 # sys_cwd may keep the builtin command
16
17 # All the functionality of this module may provided by builtins,
18 # there is no sense to process the rest of the file.
19 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
20
21 if ($^O eq 'os2') {
22     local $^W = 0;
23
24     *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
25     *getcwd             = \&cwd;
26     *fastgetcwd         = \&cwd;
27     *fastcwd            = \&cwd;
28
29     *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
30     *abs_path           = \&fast_abs_path;
31     *realpath           = \&fast_abs_path;
32     *fast_realpath      = \&fast_abs_path;
33
34     return 1;
35 }
36
37 # Need to look up the feature settings on VMS.  The preferred way is to use the
38 # VMS::Feature module, but that may not be available to dual life modules.
39
40 my $use_vms_feature;
41 BEGIN {
42     if ($^O eq 'VMS') {
43         if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
44             $use_vms_feature = 1;
45         }
46     }
47 }
48
49 # Need to look up the UNIX report mode.  This may become a dynamic mode
50 # in the future.
51 sub _vms_unix_rpt {
52     my $unix_rpt;
53     if ($use_vms_feature) {
54         $unix_rpt = VMS::Feature::current("filename_unix_report");
55     } else {
56         my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
57         $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
58     }
59     return $unix_rpt;
60 }
61
62 # Need to look up the EFS character set mode.  This may become a dynamic
63 # mode in the future.
64 sub _vms_efs {
65     my $efs;
66     if ($use_vms_feature) {
67         $efs = VMS::Feature::current("efs_charset");
68     } else {
69         my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
70         $efs = $env_efs =~ /^[ET1]/i; 
71     }
72     return $efs;
73 }
74
75
76 # If loading the XS stuff doesn't work, we can fall back to pure perl
77 if(! defined &getcwd && defined &DynaLoader::boot_DynaLoader) {
78   eval {#eval is questionable since we are handling potential errors like
79         #"Cwd object version 3.48 does not match bootstrap parameter 3.50
80         #at lib/DynaLoader.pm line 216." by having this eval
81     if ( $] >= 5.006 ) {
82       require XSLoader;
83       XSLoader::load( __PACKAGE__, $xs_version);
84     } else {
85       require DynaLoader;
86       push @ISA, 'DynaLoader';
87       __PACKAGE__->bootstrap( $xs_version );
88     }
89   };
90 }
91
92 # Big nasty table of function aliases
93 my %METHOD_MAP =
94   (
95    VMS =>
96    {
97     cwd                 => '_vms_cwd',
98     getcwd              => '_vms_cwd',
99     fastcwd             => '_vms_cwd',
100     fastgetcwd          => '_vms_cwd',
101     abs_path            => '_vms_abs_path',
102     fast_abs_path       => '_vms_abs_path',
103    },
104
105    MSWin32 =>
106    {
107     # We assume that &_NT_cwd is defined as an XSUB or in the core.
108     cwd                 => '_NT_cwd',
109     getcwd              => '_NT_cwd',
110     fastcwd             => '_NT_cwd',
111     fastgetcwd          => '_NT_cwd',
112     abs_path            => 'fast_abs_path',
113     realpath            => 'fast_abs_path',
114    },
115
116    dos => 
117    {
118     cwd                 => '_dos_cwd',
119     getcwd              => '_dos_cwd',
120     fastgetcwd          => '_dos_cwd',
121     fastcwd             => '_dos_cwd',
122     abs_path            => 'fast_abs_path',
123    },
124
125    # QNX4.  QNX6 has a $os of 'nto'.
126    qnx =>
127    {
128     cwd                 => '_qnx_cwd',
129     getcwd              => '_qnx_cwd',
130     fastgetcwd          => '_qnx_cwd',
131     fastcwd             => '_qnx_cwd',
132     abs_path            => '_qnx_abs_path',
133     fast_abs_path       => '_qnx_abs_path',
134    },
135
136    cygwin =>
137    {
138     getcwd              => 'cwd',
139     fastgetcwd          => 'cwd',
140     fastcwd             => 'cwd',
141     abs_path            => 'fast_abs_path',
142     realpath            => 'fast_abs_path',
143    },
144
145    epoc =>
146    {
147     cwd                 => '_epoc_cwd',
148     getcwd              => '_epoc_cwd',
149     fastgetcwd          => '_epoc_cwd',
150     fastcwd             => '_epoc_cwd',
151     abs_path            => 'fast_abs_path',
152    },
153
154    MacOS =>
155    {
156     getcwd              => 'cwd',
157     fastgetcwd          => 'cwd',
158     fastcwd             => 'cwd',
159     abs_path            => 'fast_abs_path',
160    },
161
162    amigaos =>
163    {
164     getcwd              => '_backtick_pwd',
165     fastgetcwd          => '_backtick_pwd',
166     fastcwd             => '_backtick_pwd',
167     abs_path            => 'fast_abs_path',
168    }
169   );
170
171 $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
172
173
174 # Find the pwd command in the expected locations.  We assume these
175 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
176 # so everything works under taint mode.
177 my $pwd_cmd;
178 if($^O ne 'MSWin32') {
179     foreach my $try ('/bin/pwd',
180                      '/usr/bin/pwd',
181                      '/QOpenSys/bin/pwd', # OS/400 PASE.
182                     ) {
183         if( -x $try ) {
184             $pwd_cmd = $try;
185             last;
186         }
187     }
188 }
189
190 # Android has a built-in pwd. Using $pwd_cmd will DTRT if
191 # this perl was compiled with -Dd_useshellcmds, which is the
192 # default for Android, but the block below is needed for the
193 # miniperl running on the host when cross-compiling, and
194 # potentially for native builds with -Ud_useshellcmds.
195 if ($^O =~ /android/) {
196     # If targetsh is executable, then we're either a full
197     # perl, or a miniperl for a native build.
198     if (-x $Config::Config{targetsh}) {
199         $pwd_cmd = "$Config::Config{targetsh} -c pwd"
200     }
201     else {
202         my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh');
203         $pwd_cmd = "$sh -c pwd"
204     }
205 }
206
207 my $found_pwd_cmd = defined($pwd_cmd);
208 unless ($pwd_cmd) {
209     # Isn't this wrong?  _backtick_pwd() will fail if someone has
210     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
211     # See [perl #16774]. --jhi
212     $pwd_cmd = 'pwd';
213 }
214
215 # Lazy-load Carp
216 sub _carp  { require Carp; Carp::carp(@_)  }
217 sub _croak { require Carp; Carp::croak(@_) }
218
219 # The 'natural and safe form' for UNIX (pwd may be setuid root)
220 sub _backtick_pwd {
221
222     # Localize %ENV entries in a way that won't create new hash keys.
223     # Under AmigaOS we don't want to localize as it stops perl from
224     # finding 'sh' in the PATH.
225     my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV) if $^O ne "amigaos";
226     local @ENV{@localize} if @localize;
227     
228     my $cwd = `$pwd_cmd`;
229     # Belt-and-suspenders in case someone said "undef $/".
230     local $/ = "\n";
231     # `pwd` may fail e.g. if the disk is full
232     chomp($cwd) if defined $cwd;
233     $cwd;
234 }
235
236 # Since some ports may predefine cwd internally (e.g., NT)
237 # we take care not to override an existing definition for cwd().
238
239 unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
240     # The pwd command is not available in some chroot(2)'ed environments
241     my $sep = $Config::Config{path_sep} || ':';
242     my $os = $^O;  # Protect $^O from tainting
243
244
245     # Try again to find a pwd, this time searching the whole PATH.
246     if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
247         my @candidates = split($sep, $ENV{PATH});
248         while (!$found_pwd_cmd and @candidates) {
249             my $candidate = shift @candidates;
250             $found_pwd_cmd = 1 if -x "$candidate/pwd";
251         }
252     }
253
254     # MacOS has some special magic to make `pwd` work.
255     if( $os eq 'MacOS' || $found_pwd_cmd )
256     {
257         *cwd = \&_backtick_pwd;
258     }
259     else {
260         *cwd = \&getcwd;
261     }
262 }
263
264 if ($^O eq 'cygwin') {
265   # We need to make sure cwd() is called with no args, because it's
266   # got an arg-less prototype and will die if args are present.
267   local $^W = 0;
268   my $orig_cwd = \&cwd;
269   *cwd = sub { &$orig_cwd() }
270 }
271
272
273 # set a reasonable (and very safe) default for fastgetcwd, in case it
274 # isn't redefined later (20001212 rspier)
275 *fastgetcwd = \&cwd;
276
277 # A non-XS version of getcwd() - also used to bootstrap the perl build
278 # process, when miniperl is running and no XS loading happens.
279 sub _perl_getcwd
280 {
281     abs_path('.');
282 }
283
284 # By John Bazik
285 #
286 # Usage: $cwd = &fastcwd;
287 #
288 # This is a faster version of getcwd.  It's also more dangerous because
289 # you might chdir out of a directory that you can't chdir back into.
290     
291 sub fastcwd_ {
292     my($odev, $oino, $cdev, $cino, $tdev, $tino);
293     my(@path, $path);
294     local(*DIR);
295
296     my($orig_cdev, $orig_cino) = stat('.');
297     ($cdev, $cino) = ($orig_cdev, $orig_cino);
298     for (;;) {
299         my $direntry;
300         ($odev, $oino) = ($cdev, $cino);
301         CORE::chdir('..') || return undef;
302         ($cdev, $cino) = stat('.');
303         last if $odev == $cdev && $oino == $cino;
304         opendir(DIR, '.') || return undef;
305         for (;;) {
306             $direntry = readdir(DIR);
307             last unless defined $direntry;
308             next if $direntry eq '.';
309             next if $direntry eq '..';
310
311             ($tdev, $tino) = lstat($direntry);
312             last unless $tdev != $odev || $tino != $oino;
313         }
314         closedir(DIR);
315         return undef unless defined $direntry; # should never happen
316         unshift(@path, $direntry);
317     }
318     $path = '/' . join('/', @path);
319     if ($^O eq 'apollo') { $path = "/".$path; }
320     # At this point $path may be tainted (if tainting) and chdir would fail.
321     # Untaint it then check that we landed where we started.
322     $path =~ /^(.*)\z/s         # untaint
323         && CORE::chdir($1) or return undef;
324     ($cdev, $cino) = stat('.');
325     die "Unstable directory path, current directory changed unexpectedly"
326         if $cdev != $orig_cdev || $cino != $orig_cino;
327     $path;
328 }
329 if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
330
331
332 # Keeps track of current working directory in PWD environment var
333 # Usage:
334 #       use Cwd 'chdir';
335 #       chdir $newdir;
336
337 my $chdir_init = 0;
338
339 sub chdir_init {
340     if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
341         my($dd,$di) = stat('.');
342         my($pd,$pi) = stat($ENV{'PWD'});
343         if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
344             $ENV{'PWD'} = cwd();
345         }
346     }
347     else {
348         my $wd = cwd();
349         $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
350         $ENV{'PWD'} = $wd;
351     }
352     # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
353     if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
354         my($pd,$pi) = stat($2);
355         my($dd,$di) = stat($1);
356         if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
357             $ENV{'PWD'}="$2$3";
358         }
359     }
360     $chdir_init = 1;
361 }
362
363 sub chdir {
364     my $newdir = @_ ? shift : '';       # allow for no arg (chdir to HOME dir)
365     if ($^O eq "cygwin") {
366       $newdir =~ s|\A///+|//|;
367       $newdir =~ s|(?<=[^/])//+|/|g;
368     }
369     elsif ($^O ne 'MSWin32') {
370       $newdir =~ s|///*|/|g;
371     }
372     chdir_init() unless $chdir_init;
373     my $newpwd;
374     if ($^O eq 'MSWin32') {
375         # get the full path name *before* the chdir()
376         $newpwd = Win32::GetFullPathName($newdir);
377     }
378
379     return 0 unless CORE::chdir $newdir;
380
381     if ($^O eq 'VMS') {
382         return $ENV{'PWD'} = $ENV{'DEFAULT'}
383     }
384     elsif ($^O eq 'MacOS') {
385         return $ENV{'PWD'} = cwd();
386     }
387     elsif ($^O eq 'MSWin32') {
388         $ENV{'PWD'} = $newpwd;
389         return 1;
390     }
391
392     if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
393         $ENV{'PWD'} = cwd();
394     } elsif ($newdir =~ m#^/#s) {
395         $ENV{'PWD'} = $newdir;
396     } else {
397         my @curdir = split(m#/#,$ENV{'PWD'});
398         @curdir = ('') unless @curdir;
399         my $component;
400         foreach $component (split(m#/#, $newdir)) {
401             next if $component eq '.';
402             pop(@curdir),next if $component eq '..';
403             push(@curdir,$component);
404         }
405         $ENV{'PWD'} = join('/',@curdir) || '/';
406     }
407     1;
408 }
409
410
411 sub _perl_abs_path
412 {
413     my $start = @_ ? shift : '.';
414     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
415
416     unless (@cst = stat( $start ))
417     {
418         _carp("stat($start): $!");
419         return '';
420     }
421
422     unless (-d _) {
423         # Make sure we can be invoked on plain files, not just directories.
424         # NOTE that this routine assumes that '/' is the only directory separator.
425         
426         my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
427             or return cwd() . '/' . $start;
428         
429         # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
430         if (-l $start) {
431             my $link_target = readlink($start);
432             die "Can't resolve link $start: $!" unless defined $link_target;
433             
434             require File::Spec;
435             $link_target = $dir . '/' . $link_target
436                 unless File::Spec->file_name_is_absolute($link_target);
437             
438             return abs_path($link_target);
439         }
440         
441         return $dir ? abs_path($dir) . "/$file" : "/$file";
442     }
443
444     $cwd = '';
445     $dotdots = $start;
446     do
447     {
448         $dotdots .= '/..';
449         @pst = @cst;
450         local *PARENT;
451         unless (opendir(PARENT, $dotdots))
452         {
453             # probably a permissions issue.  Try the native command.
454             require File::Spec;
455             return File::Spec->rel2abs( $start, _backtick_pwd() );
456         }
457         unless (@cst = stat($dotdots))
458         {
459             _carp("stat($dotdots): $!");
460             closedir(PARENT);
461             return '';
462         }
463         if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
464         {
465             $dir = undef;
466         }
467         else
468         {
469             do
470             {
471                 unless (defined ($dir = readdir(PARENT)))
472                 {
473                     _carp("readdir($dotdots): $!");
474                     closedir(PARENT);
475                     return '';
476                 }
477                 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
478             }
479             while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
480                    $tst[1] != $pst[1]);
481         }
482         $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
483         closedir(PARENT);
484     } while (defined $dir);
485     chop($cwd) unless $cwd eq '/'; # drop the trailing /
486     $cwd;
487 }
488
489
490 my $Curdir;
491 sub fast_abs_path {
492     local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
493     my $cwd = getcwd();
494     require File::Spec;
495     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
496
497     # Detaint else we'll explode in taint mode.  This is safe because
498     # we're not doing anything dangerous with it.
499     ($path) = $path =~ /(.*)/s;
500     ($cwd)  = $cwd  =~ /(.*)/s;
501
502     unless (-e $path) {
503         _croak("$path: No such file or directory");
504     }
505
506     unless (-d _) {
507         # Make sure we can be invoked on plain files, not just directories.
508         
509         my ($vol, $dir, $file) = File::Spec->splitpath($path);
510         return File::Spec->catfile($cwd, $path) unless length $dir;
511
512         if (-l $path) {
513             my $link_target = readlink($path);
514             die "Can't resolve link $path: $!" unless defined $link_target;
515             
516             $link_target = File::Spec->catpath($vol, $dir, $link_target)
517                 unless File::Spec->file_name_is_absolute($link_target);
518             
519             return fast_abs_path($link_target);
520         }
521         
522         return $dir eq File::Spec->rootdir
523           ? File::Spec->catpath($vol, $dir, $file)
524           : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
525     }
526
527     if (!CORE::chdir($path)) {
528         _croak("Cannot chdir to $path: $!");
529     }
530     my $realpath = getcwd();
531     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
532         _croak("Cannot chdir back to $cwd: $!");
533     }
534     $realpath;
535 }
536
537 # added function alias to follow principle of least surprise
538 # based on previous aliasing.  --tchrist 27-Jan-00
539 *fast_realpath = \&fast_abs_path;
540
541
542 # --- PORTING SECTION ---
543
544 # VMS: $ENV{'DEFAULT'} points to default directory at all times
545 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
546 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
547 #   in the process logical name table as the default device and directory
548 #   seen by Perl. This may not be the same as the default device
549 #   and directory seen by DCL after Perl exits, since the effects
550 #   the CRTL chdir() function persist only until Perl exits.
551
552 sub _vms_cwd {
553     return $ENV{'DEFAULT'};
554 }
555
556 sub _vms_abs_path {
557     return $ENV{'DEFAULT'} unless @_;
558     my $path = shift;
559
560     my $efs = _vms_efs;
561     my $unix_rpt = _vms_unix_rpt;
562
563     if (defined &VMS::Filespec::vmsrealpath) {
564         my $path_unix = 0;
565         my $path_vms = 0;
566
567         $path_unix = 1 if ($path =~ m#(?<=\^)/#);
568         $path_unix = 1 if ($path =~ /^\.\.?$/);
569         $path_vms = 1 if ($path =~ m#[\[<\]]#);
570         $path_vms = 1 if ($path =~ /^--?$/);
571
572         my $unix_mode = $path_unix;
573         if ($efs) {
574             # In case of a tie, the Unix report mode decides.
575             if ($path_vms == $path_unix) {
576                 $unix_mode = $unix_rpt;
577             } else {
578                 $unix_mode = 0 if $path_vms;
579             }
580         }
581
582         if ($unix_mode) {
583             # Unix format
584             return VMS::Filespec::unixrealpath($path);
585         }
586
587         # VMS format
588
589         my $new_path = VMS::Filespec::vmsrealpath($path);
590
591         # Perl expects directories to be in directory format
592         $new_path = VMS::Filespec::pathify($new_path) if -d $path;
593         return $new_path;
594     }
595
596     # Fallback to older algorithm if correct ones are not
597     # available.
598
599     if (-l $path) {
600         my $link_target = readlink($path);
601         die "Can't resolve link $path: $!" unless defined $link_target;
602
603         return _vms_abs_path($link_target);
604     }
605
606     # may need to turn foo.dir into [.foo]
607     my $pathified = VMS::Filespec::pathify($path);
608     $path = $pathified if defined $pathified;
609         
610     return VMS::Filespec::rmsexpand($path);
611 }
612
613 sub _os2_cwd {
614     my $pwd = `cmd /c cd`;
615     chomp $pwd;
616     $pwd =~ s:\\:/:g ;
617     $ENV{'PWD'} = $pwd;
618     return $pwd;
619 }
620
621 sub _win32_cwd_simple {
622     my $pwd = `cd`;
623     chomp $pwd;
624     $pwd =~ s:\\:/:g ;
625     $ENV{'PWD'} = $pwd;
626     return $pwd;
627 }
628
629 sub _win32_cwd {
630     my $pwd;
631     $pwd = Win32::GetCwd();
632     $pwd =~ s:\\:/:g ;
633     $ENV{'PWD'} = $pwd;
634     return $pwd;
635 }
636
637 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
638
639 sub _dos_cwd {
640     my $pwd;
641     if (!defined &Dos::GetCwd) {
642         chomp($pwd = `command /c cd`);
643         $pwd =~ s:\\:/:g ;
644     } else {
645         $pwd = Dos::GetCwd();
646     }
647     $ENV{'PWD'} = $pwd;
648     return $pwd;
649 }
650
651 sub _qnx_cwd {
652         local $ENV{PATH} = '';
653         local $ENV{CDPATH} = '';
654         local $ENV{ENV} = '';
655     my $pwd = `/usr/bin/fullpath -t`;
656     chomp $pwd;
657     $ENV{'PWD'} = $pwd;
658     return $pwd;
659 }
660
661 sub _qnx_abs_path {
662         local $ENV{PATH} = '';
663         local $ENV{CDPATH} = '';
664         local $ENV{ENV} = '';
665     my $path = @_ ? shift : '.';
666     local *REALPATH;
667
668     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
669       die "Can't open /usr/bin/fullpath: $!";
670     my $realpath = <REALPATH>;
671     close REALPATH;
672     chomp $realpath;
673     return $realpath;
674 }
675
676 sub _epoc_cwd {
677     return $ENV{'PWD'} = EPOC::getcwd();
678 }
679
680
681 # Now that all the base-level functions are set up, alias the
682 # user-level functions to the right places
683
684 if (exists $METHOD_MAP{$^O}) {
685   my $map = $METHOD_MAP{$^O};
686   foreach my $name (keys %$map) {
687     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
688     no strict 'refs';
689     *{$name} = \&{$map->{$name}};
690   }
691 }
692
693 # In case the XS version doesn't load.
694 *abs_path = \&_perl_abs_path unless defined &abs_path;
695 *getcwd = \&_perl_getcwd unless defined &getcwd;
696
697 # added function alias for those of us more
698 # used to the libc function.  --tchrist 27-Jan-00
699 *realpath = \&abs_path;
700
701 1;
702 __END__
703
704 =head1 NAME
705
706 Cwd - get pathname of current working directory
707
708 =head1 SYNOPSIS
709
710     use Cwd;
711     my $dir = getcwd;
712
713     use Cwd 'abs_path';
714     my $abs_path = abs_path($file);
715
716 =head1 DESCRIPTION
717
718 This module provides functions for determining the pathname of the
719 current working directory.  It is recommended that getcwd (or another
720 *cwd() function) be used in I<all> code to ensure portability.
721
722 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
723 fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
724
725
726 =head2 getcwd and friends
727
728 Each of these functions are called without arguments and return the
729 absolute path of the current working directory.
730
731 =over 4
732
733 =item getcwd
734
735     my $cwd = getcwd();
736
737 Returns the current working directory.
738
739 Exposes the POSIX function getcwd(3) or re-implements it if it's not
740 available.
741
742 =item cwd
743
744     my $cwd = cwd();
745
746 The cwd() is the most natural form for the current architecture.  For
747 most systems it is identical to `pwd` (but without the trailing line
748 terminator).
749
750 =item fastcwd
751
752     my $cwd = fastcwd();
753
754 A more dangerous version of getcwd(), but potentially faster.
755
756 It might conceivably chdir() you out of a directory that it can't
757 chdir() you back into.  If fastcwd encounters a problem it will return
758 undef but will probably leave you in a different directory.  For a
759 measure of extra security, if everything appears to have worked, the
760 fastcwd() function will check that it leaves you in the same directory
761 that it started in.  If it has changed it will C<die> with the message
762 "Unstable directory path, current directory changed
763 unexpectedly".  That should never happen.
764
765 =item fastgetcwd
766
767   my $cwd = fastgetcwd();
768
769 The fastgetcwd() function is provided as a synonym for cwd().
770
771 =item getdcwd
772
773     my $cwd = getdcwd();
774     my $cwd = getdcwd('C:');
775
776 The getdcwd() function is also provided on Win32 to get the current working
777 directory on the specified drive, since Windows maintains a separate current
778 working directory for each drive.  If no drive is specified then the current
779 drive is assumed.
780
781 This function simply calls the Microsoft C library _getdcwd() function.
782
783 =back
784
785
786 =head2 abs_path and friends
787
788 These functions are exported only on request.  They each take a single
789 argument and return the absolute pathname for it.  If no argument is
790 given they'll use the current working directory.
791
792 =over 4
793
794 =item abs_path
795
796   my $abs_path = abs_path($file);
797
798 Uses the same algorithm as getcwd().  Symbolic links and relative-path
799 components ("." and "..") are resolved to return the canonical
800 pathname, just like realpath(3).
801
802 =item realpath
803
804   my $abs_path = realpath($file);
805
806 A synonym for abs_path().
807
808 =item fast_abs_path
809
810   my $abs_path = fast_abs_path($file);
811
812 A more dangerous, but potentially faster version of abs_path.
813
814 =back
815
816 =head2 $ENV{PWD}
817
818 If you ask to override your chdir() built-in function, 
819
820   use Cwd qw(chdir);
821
822 then your PWD environment variable will be kept up to date.  Note that
823 it will only be kept up to date if all packages which use chdir import
824 it from Cwd.
825
826
827 =head1 NOTES
828
829 =over 4
830
831 =item *
832
833 Since the path separators are different on some operating systems ('/'
834 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
835 modules wherever portability is a concern.
836
837 =item *
838
839 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
840 functions are all aliases for the C<cwd()> function, which, on Mac OS,
841 calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
842 C<fast_abs_path()>.
843
844 =back
845
846 =head1 AUTHOR
847
848 Originally by the perl5-porters.
849
850 Maintained by Ken Williams <KWILLIAMS@cpan.org>
851
852 =head1 COPYRIGHT
853
854 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
855
856 This program is free software; you can redistribute it and/or modify
857 it under the same terms as Perl itself.
858
859 Portions of the C code in this library are copyright (c) 1994 by the
860 Regents of the University of California.  All rights reserved.  The
861 license on this code is compatible with the licensing of the rest of
862 the distribution - please see the source code in F<Cwd.xs> for the
863 details.
864
865 =head1 SEE ALSO
866
867 L<File::chdir>
868
869 =cut