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