X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFindBin.pm;h=e218de986a353fcc9fe0bb37f390389d044eebbc;hb=aaf9c2b26697492a8234a7efe890beef8868ea9b;hp=8be9cb6b5af0659ab0bc41728de7e248e536199a;hpb=11cd456717832dc5bfb7473a0667ecb3cbb5071b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/FindBin.pm b/lib/FindBin.pm index 8be9cb6..e218de9 100644 --- a/lib/FindBin.pm +++ b/lib/FindBin.pm @@ -24,9 +24,9 @@ Locates the full path to the script bin directory to allow the use of paths relative to the bin directory. This allows a user to setup a directory tree for some software with -directories ErootE/bin and ErootE/lib and then the above example will allow -the use of modules in the lib directory without knowing where the software -tree is installed. +directories C<< /bin >> and C<< /lib >>, and then the above +example will allow the use of modules in the lib directory without knowing +where the software tree is installed. If perl is invoked using the B<-e> option or the perl script is read from C then FindBin sets both C<$Bin> and C<$RealBin> to the current @@ -42,13 +42,19 @@ directory. =head1 KNOWN ISSUES If there are two modules using C from different directories -under the same interpreter, this won't work. Since C uses +under the same interpreter, this won't work. Since C uses a C block, it'll be executed only once, and only the first caller will get it right. This is a problem under mod_perl and other persistent Perl environments, where you shouldn't use this module. Which also means that you should avoid using C in modules that you plan to put -on CPAN. The only way to make sure that C will work is to force -the C block to be executed again: +on CPAN. To make sure that C will work is to call the C +function: + + use FindBin; + FindBin::again(); # or FindBin->again; + +In former versions of FindBin there was no C function. The +workaround was to force the C block to be executed again: delete $INC{'FindBin.pm'}; require FindBin; @@ -59,9 +65,10 @@ If perl is invoked as perl filename -and I does not have executable rights and a program called I -exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin -assumes that it was invoked via the C<$ENV{PATH}>. +and I does not have executable rights and a program called +I exists in the users C<$ENV{PATH}> which satisfies both B<-x> +and B<-T> then FindBin assumes that it was invoked via the +C<$ENV{PATH}>. Workaround is to invoke perl as @@ -70,7 +77,8 @@ Workaround is to invoke perl as =head1 AUTHORS FindBin is supported as part of the core perl distribution. Please send bug -reports to EFE using the perlbug program included with perl. +reports to EFE using the perlbug program +included with perl. Graham Barr EFE Nick Ing-Simmons EFE @@ -87,7 +95,7 @@ package FindBin; use Carp; require 5.000; require Exporter; -use Cwd qw(getcwd abs_path); +use Cwd qw(getcwd cwd abs_path); use Config; use File::Basename; use File::Spec; @@ -96,9 +104,24 @@ use File::Spec; %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); @ISA = qw(Exporter); -$VERSION = "1.43"; +$VERSION = "1.49"; + + +# needed for VMS-specific filename translation +if( $^O eq 'VMS' ) { + require VMS::Filespec; + VMS::Filespec->import; +} + +sub cwd2 { + my $cwd = getcwd(); + # getcwd might fail if it hasn't access to the current directory. + # try harder. + defined $cwd or $cwd = cwd(); + $cwd; +} -BEGIN +sub init { *Dir = \$Bin; *RealDir = \$RealBin; @@ -106,9 +129,9 @@ BEGIN if($0 eq '-e' || $0 eq '-') { # perl invoked with -e or script is on C - $Script = $RealScript = $0; - $Bin = $RealBin = getcwd(); + $Bin = $RealBin = cwd2(); + $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS'; } else { @@ -116,7 +139,9 @@ BEGIN if ($^O eq 'VMS') { - ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s; + ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s; + # C isn't going to work, so unixify first + ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//; ($RealBin,$RealScript) = ($Bin,$Script); } else @@ -127,24 +152,19 @@ BEGIN { my $dir; foreach $dir (File::Spec->path) - { + { my $scr = File::Spec->catfile($dir, $script); - if(-r $scr && (!$dosish || -x _)) + + # $script can been found via PATH but perl could have + # been invoked as 'perl file'. Do a dumb check to see + # if $script is a perl program, if not then keep $script = $0 + # + # well we actually only check that it is an ASCII file + # we know its executable so it is probably a script + # of some sort. + if(-f $scr && -r _ && ($dosish || -x _) && -s _ && -T _) { $script = $scr; - - if (-f $0) - { - # $script has been found via PATH but perl could have - # been invoked as 'perl file'. Do a dumb check to see - # if $script is a perl program, if not then $script = $0 - # - # well we actually only check that it is an ASCII file - # we know its executable so it is probably a script - # of some sort. - - $script = $0 unless(-T $script); - } last; } } @@ -152,9 +172,9 @@ BEGIN croak("Cannot find current script '$0'") unless(-f $script); - # Ensure $script contains the complete path incase we C + # Ensure $script contains the complete path in case we C - $script = File::Spec->catfile(getcwd(), $script) + $script = File::Spec->catfile(cwd2(), $script) unless File::Spec->file_name_is_absolute($script); ($Script,$Bin) = fileparse($script); @@ -173,11 +193,18 @@ BEGIN } # Get absolute paths to directories - $Bin = abs_path($Bin) if($Bin); + if ($Bin) { + my $BinOld = $Bin; + $Bin = abs_path($Bin); + defined $Bin or $Bin = File::Spec->canonpath($BinOld); + } $RealBin = abs_path($RealBin) if($RealBin); } } } -1; # Keep require happy +BEGIN { init } + +*again = \&init; +1; # Keep require happy