"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Cwd.pm" (7 Mar 2020, 21942 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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