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