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;
|
---|
14 | use lib "$FindBin::Bin/../lib";
|
---|
15 |
|
---|
16 | or
|
---|
17 |
|
---|
18 | use FindBin qw($Bin);
|
---|
19 | use lib "$Bin/../lib";
|
---|
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
|
---|
27 | directories C<< <root>/bin >> and C<< <root>/lib >>, and then the above
|
---|
28 | example will allow the use of modules in the lib directory without knowing
|
---|
29 | where the software tree is installed.
|
---|
30 |
|
---|
31 | If perl is invoked using the B<-e> option or the perl script is read from
|
---|
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 |
|
---|
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 a
|
---|
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. To make sure that C<FindBin> will work is to call the C<again>
|
---|
51 | function:
|
---|
52 |
|
---|
53 | use FindBin;
|
---|
54 | FindBin::again(); # or FindBin->again;
|
---|
55 |
|
---|
56 | In former versions of FindBin there was no C<again> function. The
|
---|
57 | workaround was to force the C<BEGIN> block to be executed again:
|
---|
58 |
|
---|
59 | delete $INC{'FindBin.pm'};
|
---|
60 | require FindBin;
|
---|
61 |
|
---|
62 | =head1 KNOWN BUGS
|
---|
63 |
|
---|
64 | If perl is invoked as
|
---|
65 |
|
---|
66 | perl filename
|
---|
67 |
|
---|
68 | and I<filename> does not have executable rights and a program called
|
---|
69 | I<filename> exists in the users C<$ENV{PATH}> which satisfies both B<-x>
|
---|
70 | and B<-T> then FindBin assumes that it was invoked via the
|
---|
71 | C<$ENV{PATH}>.
|
---|
72 |
|
---|
73 | Workaround is to invoke perl as
|
---|
74 |
|
---|
75 | perl ./filename
|
---|
76 |
|
---|
77 | =head1 AUTHORS
|
---|
78 |
|
---|
79 | FindBin is supported as part of the core perl distribution. Please send bug
|
---|
80 | reports to E<lt>F<[email protected]>E<gt> using the perlbug program
|
---|
81 | included with perl.
|
---|
82 |
|
---|
83 | Graham Barr E<lt>F<[email protected]>E<gt>
|
---|
84 | Nick Ing-Simmons E<lt>F<[email protected]>E<gt>
|
---|
85 |
|
---|
86 | =head1 COPYRIGHT
|
---|
87 |
|
---|
88 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
|
---|
89 | This program is free software; you can redistribute it and/or modify it
|
---|
90 | under the same terms as Perl itself.
|
---|
91 |
|
---|
92 | =cut
|
---|
93 |
|
---|
94 | package FindBin;
|
---|
95 | use Carp;
|
---|
96 | require 5.000;
|
---|
97 | require Exporter;
|
---|
98 | use Cwd qw(getcwd cwd abs_path);
|
---|
99 | use Config;
|
---|
100 | use File::Basename;
|
---|
101 | use File::Spec;
|
---|
102 |
|
---|
103 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
|
---|
104 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
|
---|
105 | @ISA = qw(Exporter);
|
---|
106 |
|
---|
107 | $VERSION = "1.47";
|
---|
108 |
|
---|
109 | sub cwd2 {
|
---|
110 | my $cwd = getcwd();
|
---|
111 | # getcwd might fail if it hasn't access to the current directory.
|
---|
112 | # try harder.
|
---|
113 | defined $cwd or $cwd = cwd();
|
---|
114 | $cwd;
|
---|
115 | }
|
---|
116 |
|
---|
117 | sub init
|
---|
118 | {
|
---|
119 | *Dir = \$Bin;
|
---|
120 | *RealDir = \$RealBin;
|
---|
121 |
|
---|
122 | if($0 eq '-e' || $0 eq '-')
|
---|
123 | {
|
---|
124 | # perl invoked with -e or script is on C<STDIN>
|
---|
125 | $Script = $RealScript = $0;
|
---|
126 | $Bin = $RealBin = cwd2();
|
---|
127 | }
|
---|
128 | else
|
---|
129 | {
|
---|
130 | my $script = $0;
|
---|
131 |
|
---|
132 | if ($^O eq 'VMS')
|
---|
133 | {
|
---|
134 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s;
|
---|
135 | ($RealBin,$RealScript) = ($Bin,$Script);
|
---|
136 | }
|
---|
137 | else
|
---|
138 | {
|
---|
139 | my $dosish = ($^O eq 'MSWin32' or $^O eq 'os2');
|
---|
140 | unless(($script =~ m#/# || ($dosish && $script =~ m#\\#))
|
---|
141 | && -f $script)
|
---|
142 | {
|
---|
143 | my $dir;
|
---|
144 | foreach $dir (File::Spec->path)
|
---|
145 | {
|
---|
146 | my $scr = File::Spec->catfile($dir, $script);
|
---|
147 | if(-r $scr && (!$dosish || -x _))
|
---|
148 | {
|
---|
149 | $script = $scr;
|
---|
150 |
|
---|
151 | if (-f $0)
|
---|
152 | {
|
---|
153 | # $script has been found via PATH but perl could have
|
---|
154 | # been invoked as 'perl file'. Do a dumb check to see
|
---|
155 | # if $script is a perl program, if not then $script = $0
|
---|
156 | #
|
---|
157 | # well we actually only check that it is an ASCII file
|
---|
158 | # we know its executable so it is probably a script
|
---|
159 | # of some sort.
|
---|
160 |
|
---|
161 | $script = $0 unless(-T $script);
|
---|
162 | }
|
---|
163 | last;
|
---|
164 | }
|
---|
165 | }
|
---|
166 | }
|
---|
167 |
|
---|
168 | croak("Cannot find current script '$0'") unless(-f $script);
|
---|
169 |
|
---|
170 | # Ensure $script contains the complete path in case we C<chdir>
|
---|
171 |
|
---|
172 | $script = File::Spec->catfile(cwd2(), $script)
|
---|
173 | unless File::Spec->file_name_is_absolute($script);
|
---|
174 |
|
---|
175 | ($Script,$Bin) = fileparse($script);
|
---|
176 |
|
---|
177 | # Resolve $script if it is a link
|
---|
178 | while(1)
|
---|
179 | {
|
---|
180 | my $linktext = readlink($script);
|
---|
181 |
|
---|
182 | ($RealScript,$RealBin) = fileparse($script);
|
---|
183 | last unless defined $linktext;
|
---|
184 |
|
---|
185 | $script = (File::Spec->file_name_is_absolute($linktext))
|
---|
186 | ? $linktext
|
---|
187 | : File::Spec->catfile($RealBin, $linktext);
|
---|
188 | }
|
---|
189 |
|
---|
190 | # Get absolute paths to directories
|
---|
191 | if ($Bin) {
|
---|
192 | my $BinOld = $Bin;
|
---|
193 | $Bin = abs_path($Bin);
|
---|
194 | defined $Bin or $Bin = File::Spec->canonpath($BinOld);
|
---|
195 | }
|
---|
196 | $RealBin = abs_path($RealBin) if($RealBin);
|
---|
197 | }
|
---|
198 | }
|
---|
199 | }
|
---|
200 |
|
---|
201 | BEGIN { init }
|
---|
202 |
|
---|
203 | *again = \&init;
|
---|
204 |
|
---|
205 | 1; # Keep require happy
|
---|