This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
speed up building with less disk IO pod moves+__END__+misc
[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.51';
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     $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
355     chdir_init() unless $chdir_init;
356     my $newpwd;
357     if ($^O eq 'MSWin32') {
358         # get the full path name *before* the chdir()
359         $newpwd = Win32::GetFullPathName($newdir);
360     }
361
362     return 0 unless CORE::chdir $newdir;
363
364     if ($^O eq 'VMS') {
365         return $ENV{'PWD'} = $ENV{'DEFAULT'}
366     }
367     elsif ($^O eq 'MacOS') {
368         return $ENV{'PWD'} = cwd();
369     }
370     elsif ($^O eq 'MSWin32') {
371         $ENV{'PWD'} = $newpwd;
372         return 1;
373     }
374
375     if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
376         $ENV{'PWD'} = cwd();
377     } elsif ($newdir =~ m#^/#s) {
378         $ENV{'PWD'} = $newdir;
379     } else {
380         my @curdir = split(m#/#,$ENV{'PWD'});
381         @curdir = ('') unless @curdir;
382         my $component;
383         foreach $component (split(m#/#, $newdir)) {
384             next if $component eq '.';
385             pop(@curdir),next if $component eq '..';
386             push(@curdir,$component);
387         }
388         $ENV{'PWD'} = join('/',@curdir) || '/';
389     }
390     1;
391 }
392
393
394 sub _perl_abs_path
395 {
396     my $start = @_ ? shift : '.';
397     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
398
399     unless (@cst = stat( $start ))
400     {
401         _carp("stat($start): $!");
402         return '';
403     }
404
405     unless (-d _) {
406         # Make sure we can be invoked on plain files, not just directories.
407         # NOTE that this routine assumes that '/' is the only directory separator.
408         
409         my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
410             or return cwd() . '/' . $start;
411         
412         # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
413         if (-l $start) {
414             my $link_target = readlink($start);
415             die "Can't resolve link $start: $!" unless defined $link_target;
416             
417             require File::Spec;
418             $link_target = $dir . '/' . $link_target
419                 unless File::Spec->file_name_is_absolute($link_target);
420             
421             return abs_path($link_target);
422         }
423         
424         return $dir ? abs_path($dir) . "/$file" : "/$file";
425     }
426
427     $cwd = '';
428     $dotdots = $start;
429     do
430     {
431         $dotdots .= '/..';
432         @pst = @cst;
433         local *PARENT;
434         unless (opendir(PARENT, $dotdots))
435         {
436             # probably a permissions issue.  Try the native command.
437             require File::Spec;
438             return File::Spec->rel2abs( $start, _backtick_pwd() );
439         }
440         unless (@cst = stat($dotdots))
441         {
442             _carp("stat($dotdots): $!");
443             closedir(PARENT);
444             return '';
445         }
446         if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
447         {
448             $dir = undef;
449         }
450         else
451         {
452             do
453             {
454                 unless (defined ($dir = readdir(PARENT)))
455                 {
456                     _carp("readdir($dotdots): $!");
457                     closedir(PARENT);
458                     return '';
459                 }
460                 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
461             }
462             while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
463                    $tst[1] != $pst[1]);
464         }
465         $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
466         closedir(PARENT);
467     } while (defined $dir);
468     chop($cwd) unless $cwd eq '/'; # drop the trailing /
469     $cwd;
470 }
471
472
473 my $Curdir;
474 sub fast_abs_path {
475     local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
476     my $cwd = getcwd();
477     require File::Spec;
478     my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
479
480     # Detaint else we'll explode in taint mode.  This is safe because
481     # we're not doing anything dangerous with it.
482     ($path) = $path =~ /(.*)/s;
483     ($cwd)  = $cwd  =~ /(.*)/s;
484
485     unless (-e $path) {
486         _croak("$path: No such file or directory");
487     }
488
489     unless (-d _) {
490         # Make sure we can be invoked on plain files, not just directories.
491         
492         my ($vol, $dir, $file) = File::Spec->splitpath($path);
493         return File::Spec->catfile($cwd, $path) unless length $dir;
494
495         if (-l $path) {
496             my $link_target = readlink($path);
497             die "Can't resolve link $path: $!" unless defined $link_target;
498             
499             $link_target = File::Spec->catpath($vol, $dir, $link_target)
500                 unless File::Spec->file_name_is_absolute($link_target);
501             
502             return fast_abs_path($link_target);
503         }
504         
505         return $dir eq File::Spec->rootdir
506           ? File::Spec->catpath($vol, $dir, $file)
507           : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
508     }
509
510     if (!CORE::chdir($path)) {
511         _croak("Cannot chdir to $path: $!");
512     }
513     my $realpath = getcwd();
514     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
515         _croak("Cannot chdir back to $cwd: $!");
516     }
517     $realpath;
518 }
519
520 # added function alias to follow principle of least surprise
521 # based on previous aliasing.  --tchrist 27-Jan-00
522 *fast_realpath = \&fast_abs_path;
523
524
525 # --- PORTING SECTION ---
526
527 # VMS: $ENV{'DEFAULT'} points to default directory at all times
528 # 06-Mar-1996  Charles Bailey  bailey@newman.upenn.edu
529 # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
530 #   in the process logical name table as the default device and directory
531 #   seen by Perl. This may not be the same as the default device
532 #   and directory seen by DCL after Perl exits, since the effects
533 #   the CRTL chdir() function persist only until Perl exits.
534
535 sub _vms_cwd {
536     return $ENV{'DEFAULT'};
537 }
538
539 sub _vms_abs_path {
540     return $ENV{'DEFAULT'} unless @_;
541     my $path = shift;
542
543     my $efs = _vms_efs;
544     my $unix_rpt = _vms_unix_rpt;
545
546     if (defined &VMS::Filespec::vmsrealpath) {
547         my $path_unix = 0;
548         my $path_vms = 0;
549
550         $path_unix = 1 if ($path =~ m#(?<=\^)/#);
551         $path_unix = 1 if ($path =~ /^\.\.?$/);
552         $path_vms = 1 if ($path =~ m#[\[<\]]#);
553         $path_vms = 1 if ($path =~ /^--?$/);
554
555         my $unix_mode = $path_unix;
556         if ($efs) {
557             # In case of a tie, the Unix report mode decides.
558             if ($path_vms == $path_unix) {
559                 $unix_mode = $unix_rpt;
560             } else {
561                 $unix_mode = 0 if $path_vms;
562             }
563         }
564
565         if ($unix_mode) {
566             # Unix format
567             return VMS::Filespec::unixrealpath($path);
568         }
569
570         # VMS format
571
572         my $new_path = VMS::Filespec::vmsrealpath($path);
573
574         # Perl expects directories to be in directory format
575         $new_path = VMS::Filespec::pathify($new_path) if -d $path;
576         return $new_path;
577     }
578
579     # Fallback to older algorithm if correct ones are not
580     # available.
581
582     if (-l $path) {
583         my $link_target = readlink($path);
584         die "Can't resolve link $path: $!" unless defined $link_target;
585
586         return _vms_abs_path($link_target);
587     }
588
589     # may need to turn foo.dir into [.foo]
590     my $pathified = VMS::Filespec::pathify($path);
591     $path = $pathified if defined $pathified;
592         
593     return VMS::Filespec::rmsexpand($path);
594 }
595
596 sub _os2_cwd {
597     $ENV{'PWD'} = `cmd /c cd`;
598     chomp $ENV{'PWD'};
599     $ENV{'PWD'} =~ s:\\:/:g ;
600     return $ENV{'PWD'};
601 }
602
603 sub _win32_cwd_simple {
604     $ENV{'PWD'} = `cd`;
605     chomp $ENV{'PWD'};
606     $ENV{'PWD'} =~ s:\\:/:g ;
607     return $ENV{'PWD'};
608 }
609
610 sub _win32_cwd {
611     # Need to avoid taking any sort of reference to the typeglob or the code in
612     # the optree, so that this tests the runtime state of things, as the
613     # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
614     # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
615     # lookup avoids needing a string eval, which has been reported to cause
616     # problems (for reasons that we haven't been able to get to the bottom of -
617     # rt.cpan.org #56225)
618     if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
619         $ENV{'PWD'} = Win32::GetCwd();
620     }
621     else { # miniperl
622         chomp($ENV{'PWD'} = `cd`);
623     }
624     $ENV{'PWD'} =~ s:\\:/:g ;
625     return $ENV{'PWD'};
626 }
627
628 *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
629
630 sub _dos_cwd {
631     if (!defined &Dos::GetCwd) {
632         $ENV{'PWD'} = `command /c cd`;
633         chomp $ENV{'PWD'};
634         $ENV{'PWD'} =~ s:\\:/:g ;
635     } else {
636         $ENV{'PWD'} = Dos::GetCwd();
637     }
638     return $ENV{'PWD'};
639 }
640
641 sub _qnx_cwd {
642         local $ENV{PATH} = '';
643         local $ENV{CDPATH} = '';
644         local $ENV{ENV} = '';
645     $ENV{'PWD'} = `/usr/bin/fullpath -t`;
646     chomp $ENV{'PWD'};
647     return $ENV{'PWD'};
648 }
649
650 sub _qnx_abs_path {
651         local $ENV{PATH} = '';
652         local $ENV{CDPATH} = '';
653         local $ENV{ENV} = '';
654     my $path = @_ ? shift : '.';
655     local *REALPATH;
656
657     defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
658       die "Can't open /usr/bin/fullpath: $!";
659     my $realpath = <REALPATH>;
660     close REALPATH;
661     chomp $realpath;
662     return $realpath;
663 }
664
665 sub _epoc_cwd {
666     $ENV{'PWD'} = EPOC::getcwd();
667     return $ENV{'PWD'};
668 }
669
670
671 # Now that all the base-level functions are set up, alias the
672 # user-level functions to the right places
673
674 if (exists $METHOD_MAP{$^O}) {
675   my $map = $METHOD_MAP{$^O};
676   foreach my $name (keys %$map) {
677     local $^W = 0;  # assignments trigger 'subroutine redefined' warning
678     no strict 'refs';
679     *{$name} = \&{$map->{$name}};
680   }
681 }
682
683 # In case the XS version doesn't load.
684 *abs_path = \&_perl_abs_path unless defined &abs_path;
685 *getcwd = \&_perl_getcwd unless defined &getcwd;
686
687 # added function alias for those of us more
688 # used to the libc function.  --tchrist 27-Jan-00
689 *realpath = \&abs_path;
690
691 1;
692 __END__
693
694 =head1 NAME
695
696 Cwd - get pathname of current working directory
697
698 =head1 SYNOPSIS
699
700     use Cwd;
701     my $dir = getcwd;
702
703     use Cwd 'abs_path';
704     my $abs_path = abs_path($file);
705
706 =head1 DESCRIPTION
707
708 This module provides functions for determining the pathname of the
709 current working directory.  It is recommended that getcwd (or another
710 *cwd() function) be used in I<all> code to ensure portability.
711
712 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
713 fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
714
715
716 =head2 getcwd and friends
717
718 Each of these functions are called without arguments and return the
719 absolute path of the current working directory.
720
721 =over 4
722
723 =item getcwd
724
725     my $cwd = getcwd();
726
727 Returns the current working directory.
728
729 Exposes the POSIX function getcwd(3) or re-implements it if it's not
730 available.
731
732 =item cwd
733
734     my $cwd = cwd();
735
736 The cwd() is the most natural form for the current architecture.  For
737 most systems it is identical to `pwd` (but without the trailing line
738 terminator).
739
740 =item fastcwd
741
742     my $cwd = fastcwd();
743
744 A more dangerous version of getcwd(), but potentially faster.
745
746 It might conceivably chdir() you out of a directory that it can't
747 chdir() you back into.  If fastcwd encounters a problem it will return
748 undef but will probably leave you in a different directory.  For a
749 measure of extra security, if everything appears to have worked, the
750 fastcwd() function will check that it leaves you in the same directory
751 that it started in.  If it has changed it will C<die> with the message
752 "Unstable directory path, current directory changed
753 unexpectedly".  That should never happen.
754
755 =item fastgetcwd
756
757   my $cwd = fastgetcwd();
758
759 The fastgetcwd() function is provided as a synonym for cwd().
760
761 =item getdcwd
762
763     my $cwd = getdcwd();
764     my $cwd = getdcwd('C:');
765
766 The getdcwd() function is also provided on Win32 to get the current working
767 directory on the specified drive, since Windows maintains a separate current
768 working directory for each drive.  If no drive is specified then the current
769 drive is assumed.
770
771 This function simply calls the Microsoft C library _getdcwd() function.
772
773 =back
774
775
776 =head2 abs_path and friends
777
778 These functions are exported only on request.  They each take a single
779 argument and return the absolute pathname for it.  If no argument is
780 given they'll use the current working directory.
781
782 =over 4
783
784 =item abs_path
785
786   my $abs_path = abs_path($file);
787
788 Uses the same algorithm as getcwd().  Symbolic links and relative-path
789 components ("." and "..") are resolved to return the canonical
790 pathname, just like realpath(3).
791
792 =item realpath
793
794   my $abs_path = realpath($file);
795
796 A synonym for abs_path().
797
798 =item fast_abs_path
799
800   my $abs_path = fast_abs_path($file);
801
802 A more dangerous, but potentially faster version of abs_path.
803
804 =back
805
806 =head2 $ENV{PWD}
807
808 If you ask to override your chdir() built-in function, 
809
810   use Cwd qw(chdir);
811
812 then your PWD environment variable will be kept up to date.  Note that
813 it will only be kept up to date if all packages which use chdir import
814 it from Cwd.
815
816
817 =head1 NOTES
818
819 =over 4
820
821 =item *
822
823 Since the path separators are different on some operating systems ('/'
824 on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
825 modules wherever portability is a concern.
826
827 =item *
828
829 Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
830 functions are all aliases for the C<cwd()> function, which, on Mac OS,
831 calls `pwd`.  Likewise, the C<abs_path()> function is an alias for
832 C<fast_abs_path()>.
833
834 =back
835
836 =head1 AUTHOR
837
838 Originally by the perl5-porters.
839
840 Maintained by Ken Williams <KWILLIAMS@cpan.org>
841
842 =head1 COPYRIGHT
843
844 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
845
846 This program is free software; you can redistribute it and/or modify
847 it under the same terms as Perl itself.
848
849 Portions of the C code in this library are copyright (c) 1994 by the
850 Regents of the University of California.  All rights reserved.  The
851 license on this code is compatible with the licensing of the rest of
852 the distribution - please see the source code in F<Cwd.xs> for the
853 details.
854
855 =head1 SEE ALSO
856
857 L<File::chdir>
858
859 =cut