X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/cb8c84586a7e77e1b9100e6d88a6a9d18041ae96..fb7054ba7bb9bc87ce6a32c6fad702be20e10077:/dist/PathTools/Cwd.pm diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index d9de63c..1811a24 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -1,177 +1,9 @@ package Cwd; - -=head1 NAME - -Cwd - get pathname of current working directory - -=head1 SYNOPSIS - - use Cwd; - my $dir = getcwd; - - use Cwd 'abs_path'; - my $abs_path = abs_path($file); - -=head1 DESCRIPTION - -This module provides functions for determining the pathname of the -current working directory. It is recommended that getcwd (or another -*cwd() function) be used in I code to ensure portability. - -By default, it exports the functions cwd(), getcwd(), fastcwd(), and -fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace. - - -=head2 getcwd and friends - -Each of these functions are called without arguments and return the -absolute path of the current working directory. - -=over 4 - -=item getcwd - - my $cwd = getcwd(); - -Returns the current working directory. - -Exposes the POSIX function getcwd(3) or re-implements it if it's not -available. - -=item cwd - - my $cwd = cwd(); - -The cwd() is the most natural form for the current architecture. For -most systems it is identical to `pwd` (but without the trailing line -terminator). - -=item fastcwd - - my $cwd = fastcwd(); - -A more dangerous version of getcwd(), but potentially faster. - -It might conceivably chdir() you out of a directory that it can't -chdir() you back into. If fastcwd encounters a problem it will return -undef but will probably leave you in a different directory. For a -measure of extra security, if everything appears to have worked, the -fastcwd() function will check that it leaves you in the same directory -that it started in. If it has changed it will C with the message -"Unstable directory path, current directory changed -unexpectedly". That should never happen. - -=item fastgetcwd - - my $cwd = fastgetcwd(); - -The fastgetcwd() function is provided as a synonym for cwd(). - -=item getdcwd - - my $cwd = getdcwd(); - my $cwd = getdcwd('C:'); - -The getdcwd() function is also provided on Win32 to get the current working -directory on the specified drive, since Windows maintains a separate current -working directory for each drive. If no drive is specified then the current -drive is assumed. - -This function simply calls the Microsoft C library _getdcwd() function. - -=back - - -=head2 abs_path and friends - -These functions are exported only on request. They each take a single -argument and return the absolute pathname for it. If no argument is -given they'll use the current working directory. - -=over 4 - -=item abs_path - - my $abs_path = abs_path($file); - -Uses the same algorithm as getcwd(). Symbolic links and relative-path -components ("." and "..") are resolved to return the canonical -pathname, just like realpath(3). - -=item realpath - - my $abs_path = realpath($file); - -A synonym for abs_path(). - -=item fast_abs_path - - my $abs_path = fast_abs_path($file); - -A more dangerous, but potentially faster version of abs_path. - -=back - -=head2 $ENV{PWD} - -If you ask to override your chdir() built-in function, - - use Cwd qw(chdir); - -then your PWD environment variable will be kept up to date. Note that -it will only be kept up to date if all packages which use chdir import -it from Cwd. - - -=head1 NOTES - -=over 4 - -=item * - -Since the path separators are different on some operating systems ('/' -on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec -modules wherever portability is a concern. - -=item * - -Actually, on Mac OS, the C, C and C -functions are all aliases for the C function, which, on Mac OS, -calls `pwd`. Likewise, the C function is an alias for -C. - -=back - -=head1 AUTHOR - -Originally by the perl5-porters. - -Maintained by Ken Williams - -=head1 COPYRIGHT - -Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -Portions of the C code in this library are copyright (c) 1994 by the -Regents of the University of California. All rights reserved. The -license on this code is compatible with the licensing of the rest of -the distribution - please see the source code in F for the -details. - -=head1 SEE ALSO - -L - -=cut - use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.45'; +$VERSION = '3.54'; my $xs_version = $VERSION; $VERSION =~ tr/_//; @@ -242,8 +74,10 @@ sub _vms_efs { # If loading the XS stuff doesn't work, we can fall back to pure perl -unless (defined &getcwd) { - eval { +if(! defined &getcwd && defined &DynaLoader::boot_DynaLoader) { + eval {#eval is questionable since we are handling potential errors like + #"Cwd object version 3.48 does not match bootstrap parameter 3.50 + #at lib/DynaLoader.pm line 216." by having this eval if ( $] >= 5.006 ) { require XSLoader; XSLoader::load( __PACKAGE__, $xs_version); @@ -333,16 +167,35 @@ $METHOD_MAP{NT} = $METHOD_MAP{MSWin32}; # are safe. This prevents _backtick_pwd() consulting $ENV{PATH} # so everything works under taint mode. my $pwd_cmd; -foreach my $try ('/bin/pwd', - '/usr/bin/pwd', - '/QOpenSys/bin/pwd', # OS/400 PASE. - ) { +if($^O ne 'MSWin32') { + foreach my $try ('/bin/pwd', + '/usr/bin/pwd', + '/QOpenSys/bin/pwd', # OS/400 PASE. + ) { + if( -x $try ) { + $pwd_cmd = $try; + last; + } + } +} - if( -x $try ) { - $pwd_cmd = $try; - last; +# Android has a built-in pwd. Using $pwd_cmd will DTRT if +# this perl was compiled with -Dd_useshellcmds, which is the +# default for Android, but the block below is needed for the +# miniperl running on the host when cross-compiling, and +# potentially for native builds with -Ud_useshellcmds. +if ($^O =~ /android/) { + # If targetsh is executable, then we're either a full + # perl, or a miniperl for a native build. + if (-x $Config::Config{targetsh}) { + $pwd_cmd = "$Config::Config{targetsh} -c pwd" + } + else { + my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh'); + $pwd_cmd = "$sh -c pwd" } } + my $found_pwd_cmd = defined($pwd_cmd); unless ($pwd_cmd) { # Isn't this wrong? _backtick_pwd() will fail if someone has @@ -498,7 +351,13 @@ sub chdir_init { sub chdir { my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir) - $newdir =~ s|///*|/|g unless $^O eq 'MSWin32'; + if ($^O eq "cygwin") { + $newdir =~ s|\A///+|//|; + $newdir =~ s|(?<=[^/])//+|/|g; + } + elsif ($^O ne 'MSWin32') { + $newdir =~ s|///*|/|g; + } chdir_init() unless $chdir_init; my $newpwd; if ($^O eq 'MSWin32') { @@ -836,3 +695,171 @@ if (exists $METHOD_MAP{$^O}) { *realpath = \&abs_path; 1; +__END__ + +=head1 NAME + +Cwd - get pathname of current working directory + +=head1 SYNOPSIS + + use Cwd; + my $dir = getcwd; + + use Cwd 'abs_path'; + my $abs_path = abs_path($file); + +=head1 DESCRIPTION + +This module provides functions for determining the pathname of the +current working directory. It is recommended that getcwd (or another +*cwd() function) be used in I code to ensure portability. + +By default, it exports the functions cwd(), getcwd(), fastcwd(), and +fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace. + + +=head2 getcwd and friends + +Each of these functions are called without arguments and return the +absolute path of the current working directory. + +=over 4 + +=item getcwd + + my $cwd = getcwd(); + +Returns the current working directory. + +Exposes the POSIX function getcwd(3) or re-implements it if it's not +available. + +=item cwd + + my $cwd = cwd(); + +The cwd() is the most natural form for the current architecture. For +most systems it is identical to `pwd` (but without the trailing line +terminator). + +=item fastcwd + + my $cwd = fastcwd(); + +A more dangerous version of getcwd(), but potentially faster. + +It might conceivably chdir() you out of a directory that it can't +chdir() you back into. If fastcwd encounters a problem it will return +undef but will probably leave you in a different directory. For a +measure of extra security, if everything appears to have worked, the +fastcwd() function will check that it leaves you in the same directory +that it started in. If it has changed it will C with the message +"Unstable directory path, current directory changed +unexpectedly". That should never happen. + +=item fastgetcwd + + my $cwd = fastgetcwd(); + +The fastgetcwd() function is provided as a synonym for cwd(). + +=item getdcwd + + my $cwd = getdcwd(); + my $cwd = getdcwd('C:'); + +The getdcwd() function is also provided on Win32 to get the current working +directory on the specified drive, since Windows maintains a separate current +working directory for each drive. If no drive is specified then the current +drive is assumed. + +This function simply calls the Microsoft C library _getdcwd() function. + +=back + + +=head2 abs_path and friends + +These functions are exported only on request. They each take a single +argument and return the absolute pathname for it. If no argument is +given they'll use the current working directory. + +=over 4 + +=item abs_path + + my $abs_path = abs_path($file); + +Uses the same algorithm as getcwd(). Symbolic links and relative-path +components ("." and "..") are resolved to return the canonical +pathname, just like realpath(3). + +=item realpath + + my $abs_path = realpath($file); + +A synonym for abs_path(). + +=item fast_abs_path + + my $abs_path = fast_abs_path($file); + +A more dangerous, but potentially faster version of abs_path. + +=back + +=head2 $ENV{PWD} + +If you ask to override your chdir() built-in function, + + use Cwd qw(chdir); + +then your PWD environment variable will be kept up to date. Note that +it will only be kept up to date if all packages which use chdir import +it from Cwd. + + +=head1 NOTES + +=over 4 + +=item * + +Since the path separators are different on some operating systems ('/' +on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec +modules wherever portability is a concern. + +=item * + +Actually, on Mac OS, the C, C and C +functions are all aliases for the C function, which, on Mac OS, +calls `pwd`. Likewise, the C function is an alias for +C. + +=back + +=head1 AUTHOR + +Originally by the perl5-porters. + +Maintained by Ken Williams + +=head1 COPYRIGHT + +Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +Portions of the C code in this library are copyright (c) 1994 by the +Regents of the University of California. All rights reserved. The +license on this code is compatible with the licensing of the rest of +the distribution - please see the source code in F for the +details. + +=head1 SEE ALSO + +L + +=cut