=head1 SYNOPSIS
use FindBin;
- BEGIN { unshift(@INC,"$FindBin::Bin/../lib") }
+ use lib "$FindBin::Bin/../lib";
- or
+ or
use FindBin qw($Bin);
- BEGIN { unshift(@INC,"$Bin/../lib") }
+ use lib "$Bin/../lib";
=head1 DESCRIPTION
of paths relative to the bin directory.
This allows a user to setup a directory tree for some software with
-directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/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<< <root>/bin >> and C<< <root>/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<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
$RealBin - $Bin with all links resolved
$RealScript - $Script with all links resolved
-=head1 KNOWN BUGS
+=head1 KNOWN ISSUES
-if perl is invoked as
+If there are two modules using C<FindBin> from different directories
+under the same interpreter, this won't work. Since C<FindBin> uses a
+C<BEGIN> 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<FindBin> in modules that you plan to put
+on CPAN. To make sure that C<FindBin> will work is to call the C<again>
+function:
- perl filename
+ use FindBin;
+ FindBin::again(); # or FindBin->again;
-and I<filename> does not have executable rights and a program called I<filename>
-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}>.
+In former versions of FindBin there was no C<again> function. The
+workaround was to force the C<BEGIN> block to be executed again:
-Workaround is to invoke perl as
-
- perl ./filename
+ delete $INC{'FindBin.pm'};
+ require FindBin;
=head1 AUTHORS
-Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
+FindBin is supported as part of the core perl distribution. Please send bug
+reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program
+included with perl.
+
+Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
=head1 COPYRIGHT
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
-=head1 REVISION
-
-$Revision: 1.4 $
-
=cut
package FindBin;
use Carp;
require 5.000;
require Exporter;
-use Cwd qw(getcwd);
+use Cwd qw(getcwd cwd abs_path);
+use File::Basename;
+use File::Spec;
@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
-$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "1.51";
-# Taken from Cwd.pm It is really getcwd with an optional
-# parameter instead of '.'
-#
-# another way would be:
-#
-#sub abs_path
-#{
-# my $cwd = getcwd();
-# chdir(shift || '.');
-# my $realpath = getcwd();
-# chdir($cwd);
-# $realpath;
-#}
-
-sub abs_path
-{
- my $start = shift || '.';
- my($dotdots, $cwd, @pst, @cst, $dir, @tst);
- unless (@cst = stat( $start ))
- {
- warn "stat($start): $!";
- return '';
- }
- $cwd = '';
- $dotdots = $start;
- do
- {
- $dotdots .= '/..';
- @pst = @cst;
- unless (opendir(PARENT, $dotdots))
- {
- warn "opendir($dotdots): $!";
- return '';
- }
- unless (@cst = stat($dotdots))
- {
- warn "stat($dotdots): $!";
- closedir(PARENT);
- return '';
- }
- if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
- {
- $dir = '';
- }
- else
- {
- do
- {
- unless (defined ($dir = readdir(PARENT)))
- {
- warn "readdir($dotdots): $!";
- closedir(PARENT);
- return '';
- }
- $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
- }
- while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
- $tst[1] != $pst[1]);
- }
- $cwd = "$dir/$cwd";
- closedir(PARENT);
- } while ($dir);
- chop($cwd); # drop the trailing /
- $cwd;
+# 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;
if($0 eq '-e' || $0 eq '-')
{
# perl invoked with -e or script is on C<STDIN>
-
$Script = $RealScript = $0;
- $Bin = $RealBin = getcwd();
+ $Bin = $RealBin = cwd2();
+ $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS';
}
else
{
if ($^O eq 'VMS')
{
- ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/;
+ ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s;
+ # C<use disk:[dev]/lib> isn't going to work, so unixify first
+ ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//;
($RealBin,$RealScript) = ($Bin,$Script);
}
else
{
- unless($script =~ m#/# && -f $script)
- {
- my $dir;
-
- foreach $dir (split(/:/,$ENV{PATH}))
- {
- if(-x "$dir/$script")
- {
- $script = "$dir/$script";
-
- 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;
- }
- }
- }
-
croak("Cannot find current script '$0'") unless(-f $script);
-
- # Ensure $script contains the complete path incase we C<chdir>
-
- $script = getcwd() . "/" . $script unless($script =~ m,^/,);
-
- ($Bin,$Script) = $script =~ m,^(.*?)/+([^/]+)$,;
-
+
+ # Ensure $script contains the complete path in case we C<chdir>
+
+ $script = File::Spec->catfile(cwd2(), $script)
+ unless File::Spec->file_name_is_absolute($script);
+
+ ($Script,$Bin) = fileparse($script);
+
# Resolve $script if it is a link
while(1)
{
my $linktext = readlink($script);
-
- ($RealBin,$RealScript) = $script =~ m,^(.*?)/+([^/]+)$,;
+
+ ($RealScript,$RealBin) = fileparse($script);
last unless defined $linktext;
-
- $script = ($linktext =~ m,^/,)
+
+ $script = (File::Spec->file_name_is_absolute($linktext))
? $linktext
- : $RealBin . "/" . $linktext;
+ : File::Spec->catfile($RealBin, $linktext);
}
# 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
https://perl5.git.perl.org / perl5.git / blobdiff