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;
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
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
27directories C<< <root>/bin >> and C<< <root>/lib >>, and then the above
28example will allow the use of modules in the lib directory without knowing
29where the software tree is installed.
30
31If perl is invoked using the B<-e> option or the perl script is read from
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
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 a
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. To make sure that C<FindBin> will work is to call the C<again>
51function:
52
53  use FindBin;
54  FindBin::again(); # or FindBin->again;
55
56In former versions of FindBin there was no C<again> function. The
57workaround 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
64If perl is invoked as
65
66   perl filename
67
68and I<filename> does not have executable rights and a program called
69I<filename> exists in the users C<$ENV{PATH}> which satisfies both B<-x>
70and B<-T> then FindBin assumes that it was invoked via the
71C<$ENV{PATH}>.
72
73Workaround is to invoke perl as
74
75 perl ./filename
76
77=head1 AUTHORS
78
79FindBin is supported as part of the core perl distribution. Please send bug
80reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program
81included with perl.
82
83Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
84Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
85
86=head1 COPYRIGHT
87
88Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
89This program is free software; you can redistribute it and/or modify it
90under the same terms as Perl itself.
91
92=cut
93
94package FindBin;
95use Carp;
96require 5.000;
97require Exporter;
98use Cwd qw(getcwd cwd abs_path);
99use Config;
100use File::Basename;
101use 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
109sub 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
117sub 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
201BEGIN { init }
202
203*again = \&init;
204
2051; # Keep require happy
206