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