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 | |
34da6cec JPO |
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. | |
a73990fd | 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 | |
f5094128 | 45 | under the same interpreter, this won't work. Since C<FindBin> uses a |
11cd4567 SB |
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 | |
f5094128 SR |
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: | |
11cd4567 SB |
58 | |
59 | delete $INC{'FindBin.pm'}; | |
60 | require FindBin; | |
61 | ||
a73990fd | 62 | =head1 AUTHORS |
63 | ||
d250f4d1 | 64 | FindBin is supported as part of the core perl distribution. Please send bug |
34da6cec JPO |
65 | reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program |
66 | included with perl. | |
d250f4d1 JH |
67 | |
68 | Graham Barr E<lt>F<gbarr@pobox.com>E<gt> | |
1fef88e7 | 69 | Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt> |
a73990fd | 70 | |
71 | =head1 COPYRIGHT | |
72 | ||
73 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. | |
74 | This program is free software; you can redistribute it and/or modify it | |
75 | under the same terms as Perl itself. | |
76 | ||
a73990fd | 77 | =cut |
78 | ||
79 | package FindBin; | |
80 | use Carp; | |
81 | require 5.000; | |
82 | require Exporter; | |
7d161605 | 83 | use Cwd qw(getcwd cwd abs_path); |
8b88ae92 | 84 | use File::Basename; |
d250f4d1 | 85 | use File::Spec; |
a73990fd | 86 | |
87 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); | |
88 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); | |
89 | @ISA = qw(Exporter); | |
90 | ||
ce6c0f31 | 91 | $VERSION = "1.51"; |
34da6cec | 92 | |
1cc0bb18 CB |
93 | |
94 | # needed for VMS-specific filename translation | |
95 | if( $^O eq 'VMS' ) { | |
96 | require VMS::Filespec; | |
97 | VMS::Filespec->import; | |
98 | } | |
99 | ||
34da6cec JPO |
100 | sub cwd2 { |
101 | my $cwd = getcwd(); | |
102 | # getcwd might fail if it hasn't access to the current directory. | |
103 | # try harder. | |
104 | defined $cwd or $cwd = cwd(); | |
105 | $cwd; | |
106 | } | |
a73990fd | 107 | |
f5094128 | 108 | sub init |
a73990fd | 109 | { |
110 | *Dir = \$Bin; | |
111 | *RealDir = \$RealBin; | |
112 | ||
113 | if($0 eq '-e' || $0 eq '-') | |
114 | { | |
115 | # perl invoked with -e or script is on C<STDIN> | |
a73990fd | 116 | $Script = $RealScript = $0; |
34da6cec | 117 | $Bin = $RealBin = cwd2(); |
1cc0bb18 | 118 | $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS'; |
a73990fd | 119 | } |
120 | else | |
121 | { | |
122 | my $script = $0; | |
123 | ||
124 | if ($^O eq 'VMS') | |
125 | { | |
8fc8005d | 126 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s; |
1cc0bb18 CB |
127 | # C<use disk:[dev]/lib> isn't going to work, so unixify first |
128 | ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//; | |
a73990fd | 129 | ($RealBin,$RealScript) = ($Bin,$Script); |
130 | } | |
131 | else | |
132 | { | |
a73990fd | 133 | croak("Cannot find current script '$0'") unless(-f $script); |
8b88ae92 | 134 | |
7d161605 | 135 | # Ensure $script contains the complete path in case we C<chdir> |
8b88ae92 | 136 | |
34da6cec | 137 | $script = File::Spec->catfile(cwd2(), $script) |
d250f4d1 | 138 | unless File::Spec->file_name_is_absolute($script); |
8b88ae92 NIS |
139 | |
140 | ($Script,$Bin) = fileparse($script); | |
141 | ||
a73990fd | 142 | # Resolve $script if it is a link |
143 | while(1) | |
144 | { | |
145 | my $linktext = readlink($script); | |
8b88ae92 NIS |
146 | |
147 | ($RealScript,$RealBin) = fileparse($script); | |
a73990fd | 148 | last unless defined $linktext; |
8b88ae92 | 149 | |
51a19bc0 | 150 | $script = (File::Spec->file_name_is_absolute($linktext)) |
a73990fd | 151 | ? $linktext |
d250f4d1 | 152 | : File::Spec->catfile($RealBin, $linktext); |
a73990fd | 153 | } |
154 | ||
155 | # Get absolute paths to directories | |
942068f5 JPO |
156 | if ($Bin) { |
157 | my $BinOld = $Bin; | |
158 | $Bin = abs_path($Bin); | |
159 | defined $Bin or $Bin = File::Spec->canonpath($BinOld); | |
160 | } | |
a73990fd | 161 | $RealBin = abs_path($RealBin) if($RealBin); |
162 | } | |
163 | } | |
164 | } | |
165 | ||
f5094128 SR |
166 | BEGIN { init } |
167 | ||
168 | *again = \&init; | |
169 | ||
a73990fd | 170 | 1; # Keep require happy |