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