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