Update PathTools to CPAN version 3.60
[perl.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.60';
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     # Need to avoid taking any sort of reference to the typeglob or the code in
632     # the optree, so that this tests the runtime state of things, as the
633     # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
634     # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
635     # lookup avoids needing a string eval, which has been reported to cause
636     # problems (for reasons that we haven't been able to get to the bottom of -
637     # rt.cpan.org #56225)
638     if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
639         $pwd = Win32::GetCwd();
640     }
641     else { # miniperl
642         chomp($pwd = `cd`);
643     }
644     $pwd =~ s:\\:/:g ;
645     $ENV{'PWD'} = $pwd;
646     return $pwd;
647 }
648
649 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
650
651 sub _dos_cwd {
652     my $pwd;
653     if (!defined &Dos::GetCwd) {
654         chomp($pwd = `command /c cd`);
655         $pwd =~ s:\\:/:g ;
656     } else {
657         $pwd = Dos::GetCwd();
658     }
659     $ENV{'PWD'} = $pwd;
660     return $pwd;
661 }
662
663 sub _qnx_cwd {
664         local $ENV{PATH} = '';
665         local $ENV{CDPATH} = '';
666         local $ENV{ENV} = '';
667     my $pwd = `/usr/bin/fullpath -t`;
668     chomp $pwd;
669     $ENV{'PWD'} = $pwd;
670     return $pwd;
671 }
672
673 sub _qnx_abs_path {
674         local $ENV{PATH} = '';
675         local $ENV{CDPATH} = '';
676         local $ENV{ENV} = '';
677     my $path = @_ ? shift : '.';
678     local *REALPATH;
679
680     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
681       die "Can't open /usr/bin/fullpath: $!";
682     my $realpath = <REALPATH>;
683     close REALPATH;
684     chomp $realpath;
685     return $realpath;
686 }
687
688 sub _epoc_cwd {
689     return $ENV{'PWD'} = EPOC::getcwd();
690 }
691
692
693 # Now that all the base-level functions are set up, alias the
694 # user-level functions to the right places
695
696 if (exists $METHOD_MAP{$^O}) {
697   my $map = $METHOD_MAP{$^O};
698   foreach my $name (keys %$map) {
699     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
700     no strict 'refs';
701     *{$name} = \&{$map->{$name}};
702   }
703 }
704
705 # In case the XS version doesn't load.
706 *abs_path = \&_perl_abs_path unless defined &abs_path;
707 *getcwd = \&_perl_getcwd unless defined &getcwd;
708
709 # added function alias for those of us more
710 # used to the libc function.  --tchrist 27-Jan-00
711 *realpath = \&abs_path;
712
713 1;
714 __END__
715
716 =head1 NAME
717
718 Cwd - get pathname of current working directory
719
720 =head1 SYNOPSIS
721
722     use Cwd;
723     my $dir = getcwd;
724
725     use Cwd 'abs_path';
726     my $abs_path = abs_path($file);
727
728 =head1 DESCRIPTION
729
730 This module provides functions for determining the pathname of the
731 current working directory.  It is recommended that getcwd (or another
732 *cwd() function) be used in I<all> code to ensure portability.
733
734 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
735 fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
736
737
738 =head2 getcwd and friends
739
740 Each of these functions are called without arguments and return the
741 absolute path of the current working directory.
742
743 =over 4
744
745 =item getcwd
746
747     my $cwd = getcwd();
748
749 Returns the current working directory.
750
751 Exposes the POSIX function getcwd(3) or re-implements it if it's not
752 available.
753
754 =item cwd
755
756     my $cwd = cwd();
757
758 The cwd() is the most natural form for the current architecture.  For
759 most systems it is identical to `pwd` (but without the trailing line
760 terminator).
761
762 =item fastcwd
763
764     my $cwd = fastcwd();
765
766 A more dangerous version of getcwd(), but potentially faster.
767
768 It might conceivably chdir() you out of a directory that it can't
769 chdir() you back into.  If fastcwd encounters a problem it will return
770 undef but will probably leave you in a different directory.  For a
771 measure of extra security, if everything appears to have worked, the
772 fastcwd() function will check that it leaves you in the same directory
773 that it started in.  If it has changed it will C<die> with the message
774 "Unstable directory path, current directory changed
775 unexpectedly".  That should never happen.
776
777 =item fastgetcwd
778
779   my $cwd = fastgetcwd();
780
781 The fastgetcwd() function is provided as a synonym for cwd().
782
783 =item getdcwd
784
785     my $cwd = getdcwd();
786     my $cwd = getdcwd('C:');
787
788 The getdcwd() function is also provided on Win32 to get the current working
789 directory on the specified drive, since Windows maintains a separate current
790 working directory for each drive.  If no drive is specified then the current
791 drive is assumed.
792
793 This function simply calls the Microsoft C library _getdcwd() function.
794
795 =back
796
797
798 =head2 abs_path and friends
799
800 These functions are exported only on request.  They each take a single
801 argument and return the absolute pathname for it.  If no argument is
802 given they'll use the current working directory.
803
804 =over 4
805
806 =item abs_path
807
808   my $abs_path = abs_path($file);
809
810 Uses the same algorithm as getcwd().  Symbolic links and relative-path
811 components ("." and "..") are resolved to return the canonical
812 pathname, just like realpath(3).
813
814 =item realpath
815
816   my $abs_path = realpath($file);
817
818 A synonym for abs_path().
819
820 =item fast_abs_path
821
822   my $abs_path = fast_abs_path($file);
823
824 A more dangerous, but potentially faster version of abs_path.
825
826 =back
827
828 =head2 $ENV{PWD}
829
830 If you ask to override your chdir() built-in function, 
831
832   use Cwd qw(chdir);
833
834 then your PWD environment variable will be kept up to date.  Note that
835 it will only be kept up to date if all packages which use chdir import
836 it from Cwd.
837
838
839 =head1 NOTES
840
841 =over 4
842
843 =item *
844
845 Since the path separators are different on some operating systems ('/'
846 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
847 modules wherever portability is a concern.
848
849 =item *
850
851 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
852 functions are all aliases for the C<cwd()> function, which, on Mac OS,
853 calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
854 C<fast_abs_path()>.
855
856 =back
857
858 =head1 AUTHOR
859
860 Originally by the perl5-porters.
861
862 Maintained by Ken Williams <KWILLIAMS@cpan.org>
863
864 =head1 COPYRIGHT
865
866 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
867
868 This program is free software; you can redistribute it and/or modify
869 it under the same terms as Perl itself.
870
871 Portions of the C code in this library are copyright (c) 1994 by the
872 Regents of the University of California.  All rights reserved.  The
873 license on this code is compatible with the licensing of the rest of
874 the distribution - please see the source code in F<Cwd.xs> for the
875 details.
876
877 =head1 SEE ALSO
878
879 L<File::chdir>
880
881 =cut