Commit | Line | Data |
---|---|---|
a73990fd | 1 | # FindBin.pm |
2 | # | |
3 | # Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. | |
4 | # This program is free software; you can redistribute it and/or modify it | |
5 | # under the same terms as Perl itself. | |
6 | ||
7 | =head1 NAME | |
8 | ||
9 | FindBin - Locate directory of original perl script | |
10 | ||
11 | =head1 SYNOPSIS | |
12 | ||
13 | use FindBin; | |
d7791a84 | 14 | use lib "$FindBin::Bin/../lib"; |
a73990fd | 15 | |
8b88ae92 | 16 | or |
a73990fd | 17 | |
18 | use FindBin qw($Bin); | |
d7791a84 | 19 | use lib "$Bin/../lib"; |
a73990fd | 20 | |
21 | =head1 DESCRIPTION | |
22 | ||
23 | Locates the full path to the script bin directory to allow the use | |
24 | of paths relative to the bin directory. | |
25 | ||
26 | This allows a user to setup a directory tree for some software with | |
1fef88e7 | 27 | directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow |
a73990fd | 28 | the use of modules in the lib directory without knowing where the software |
29 | tree is installed. | |
30 | ||
84dc3c4d | 31 | If perl is invoked using the B<-e> option or the perl script is read from |
a73990fd | 32 | C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current |
33 | directory. | |
34 | ||
35 | =head1 EXPORTABLE VARIABLES | |
36 | ||
37 | $Bin - path to bin directory from where script was invoked | |
38 | $Script - basename of script from which perl was invoked | |
39 | $RealBin - $Bin with all links resolved | |
40 | $RealScript - $Script with all links resolved | |
41 | ||
11cd4567 SB |
42 | =head1 KNOWN ISSUES |
43 | ||
44 | If there are two modules using C<FindBin> from different directories | |
45 | under the same interpreter, this won't work. Since C<FindBin> uses | |
46 | C<BEGIN> block, it'll be executed only once, and only the first caller | |
47 | will get it right. This is a problem under mod_perl and other persistent | |
48 | Perl environments, where you shouldn't use this module. Which also means | |
49 | that you should avoid using C<FindBin> in modules that you plan to put | |
50 | on CPAN. The only way to make sure that C<FindBin> will work is to force | |
51 | the C<BEGIN> block to be executed again: | |
52 | ||
53 | delete $INC{'FindBin.pm'}; | |
54 | require FindBin; | |
55 | ||
a73990fd | 56 | =head1 KNOWN BUGS |
57 | ||
11cd4567 | 58 | If perl is invoked as |
a73990fd | 59 | |
60 | perl filename | |
61 | ||
62 | and I<filename> does not have executable rights and a program called I<filename> | |
84dc3c4d | 63 | exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin |
a73990fd | 64 | assumes that it was invoked via the C<$ENV{PATH}>. |
65 | ||
66 | Workaround is to invoke perl as | |
67 | ||
68 | perl ./filename | |
69 | ||
70 | =head1 AUTHORS | |
71 | ||
d250f4d1 JH |
72 | FindBin is supported as part of the core perl distribution. Please send bug |
73 | reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl. | |
74 | ||
75 | Graham Barr E<lt>F<gbarr@pobox.com>E<gt> | |
1fef88e7 | 76 | Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt> |
a73990fd | 77 | |
78 | =head1 COPYRIGHT | |
79 | ||
80 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. | |
81 | This program is free software; you can redistribute it and/or modify it | |
82 | under the same terms as Perl itself. | |
83 | ||
a73990fd | 84 | =cut |
85 | ||
86 | package FindBin; | |
87 | use Carp; | |
88 | require 5.000; | |
89 | require Exporter; | |
8b88ae92 NIS |
90 | use Cwd qw(getcwd abs_path); |
91 | use Config; | |
92 | use File::Basename; | |
d250f4d1 | 93 | use File::Spec; |
a73990fd | 94 | |
95 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); | |
96 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); | |
97 | @ISA = qw(Exporter); | |
98 | ||
88d01e8d | 99 | $VERSION = "1.43"; |
a73990fd | 100 | |
a73990fd | 101 | BEGIN |
102 | { | |
103 | *Dir = \$Bin; | |
104 | *RealDir = \$RealBin; | |
105 | ||
106 | if($0 eq '-e' || $0 eq '-') | |
107 | { | |
108 | # perl invoked with -e or script is on C<STDIN> | |
109 | ||
110 | $Script = $RealScript = $0; | |
111 | $Bin = $RealBin = getcwd(); | |
112 | } | |
113 | else | |
114 | { | |
115 | my $script = $0; | |
116 | ||
117 | if ($^O eq 'VMS') | |
118 | { | |
4f44ac69 | 119 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s; |
a73990fd | 120 | ($RealBin,$RealScript) = ($Bin,$Script); |
121 | } | |
122 | else | |
123 | { | |
386d1046 | 124 | my $dosish = ($^O eq 'MSWin32' or $^O eq 'os2'); |
f5f423e4 | 125 | unless(($script =~ m#/# || ($dosish && $script =~ m#\\#)) |
8b88ae92 | 126 | && -f $script) |
a73990fd | 127 | { |
128 | my $dir; | |
d250f4d1 | 129 | foreach $dir (File::Spec->path) |
a73990fd | 130 | { |
d250f4d1 | 131 | my $scr = File::Spec->catfile($dir, $script); |
f5f423e4 | 132 | if(-r $scr && (!$dosish || -x _)) |
a73990fd | 133 | { |
d250f4d1 | 134 | $script = $scr; |
8b88ae92 NIS |
135 | |
136 | if (-f $0) | |
a73990fd | 137 | { |
138 | # $script has been found via PATH but perl could have | |
139 | # been invoked as 'perl file'. Do a dumb check to see | |
140 | # if $script is a perl program, if not then $script = $0 | |
141 | # | |
142 | # well we actually only check that it is an ASCII file | |
143 | # we know its executable so it is probably a script | |
144 | # of some sort. | |
8b88ae92 | 145 | |
a73990fd | 146 | $script = $0 unless(-T $script); |
147 | } | |
148 | last; | |
149 | } | |
150 | } | |
151 | } | |
8b88ae92 | 152 | |
a73990fd | 153 | croak("Cannot find current script '$0'") unless(-f $script); |
8b88ae92 | 154 | |
a73990fd | 155 | # Ensure $script contains the complete path incase we C<chdir> |
8b88ae92 | 156 | |
d250f4d1 JH |
157 | $script = File::Spec->catfile(getcwd(), $script) |
158 | unless File::Spec->file_name_is_absolute($script); | |
8b88ae92 NIS |
159 | |
160 | ($Script,$Bin) = fileparse($script); | |
161 | ||
a73990fd | 162 | # Resolve $script if it is a link |
163 | while(1) | |
164 | { | |
165 | my $linktext = readlink($script); | |
8b88ae92 NIS |
166 | |
167 | ($RealScript,$RealBin) = fileparse($script); | |
a73990fd | 168 | last unless defined $linktext; |
8b88ae92 | 169 | |
51a19bc0 | 170 | $script = (File::Spec->file_name_is_absolute($linktext)) |
a73990fd | 171 | ? $linktext |
d250f4d1 | 172 | : File::Spec->catfile($RealBin, $linktext); |
a73990fd | 173 | } |
174 | ||
175 | # Get absolute paths to directories | |
176 | $Bin = abs_path($Bin) if($Bin); | |
177 | $RealBin = abs_path($RealBin) if($RealBin); | |
178 | } | |
179 | } | |
180 | } | |
181 | ||
182 | 1; # Keep require happy | |
183 |