I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / FindBin.pm
CommitLineData
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
9FindBin - 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
23Locates the full path to the script bin directory to allow the use
24of paths relative to the bin directory.
25
26This allows a user to setup a directory tree for some software with
1fef88e7 27directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
a73990fd 28the use of modules in the lib directory without knowing where the software
29tree is installed.
30
84dc3c4d 31If perl is invoked using the B<-e> option or the perl script is read from
a73990fd 32C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
33directory.
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 42=head1 KNOWN ISSUES
43
44If there are two modules using C<FindBin> from different directories
45under the same interpreter, this won't work. Since C<FindBin> uses
46C<BEGIN> block, it'll be executed only once, and only the first caller
47will get it right. This is a problem under mod_perl and other persistent
48Perl environments, where you shouldn't use this module. Which also means
49that you should avoid using C<FindBin> in modules that you plan to put
50on CPAN. The only way to make sure that C<FindBin> will work is to force
51the C<BEGIN> block to be executed again:
52
53 delete $INC{'FindBin.pm'};
54 require FindBin;
55
a73990fd 56=head1 KNOWN BUGS
57
11cd4567 58If perl is invoked as
a73990fd 59
60 perl filename
61
62and I<filename> does not have executable rights and a program called I<filename>
84dc3c4d 63exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
a73990fd 64assumes that it was invoked via the C<$ENV{PATH}>.
65
66Workaround is to invoke perl as
67
68 perl ./filename
69
70=head1 AUTHORS
71
d250f4d1 72FindBin is supported as part of the core perl distribution. Please send bug
73reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl.
74
75Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
1fef88e7 76Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
a73990fd 77
78=head1 COPYRIGHT
79
80Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
81This program is free software; you can redistribute it and/or modify it
82under the same terms as Perl itself.
83
a73990fd 84=cut
85
86package FindBin;
87use Carp;
88require 5.000;
89require Exporter;
8b88ae92 90use Cwd qw(getcwd abs_path);
91use Config;
92use File::Basename;
d250f4d1 93use 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 101BEGIN
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 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 157 $script = File::Spec->catfile(getcwd(), $script)
158 unless File::Spec->file_name_is_absolute($script);
8b88ae92 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 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
1821; # Keep require happy
183