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 use FindBin qw($Bin);
17 use lib "$Bin/../lib";
18
19=head1 DESCRIPTION
20
21Locates the full path to the script bin directory to allow the use
22of paths relative to the bin directory.
23
24This allows a user to setup a directory tree for some software with
25directories C<< <root>/bin >> and C<< <root>/lib >>, and then the above
26example will allow the use of modules in the lib directory without knowing
27where the software tree is installed.
28
29If C<perl> is invoked using the C<-e> option or the Perl script is read from
30C<STDIN>, then C<FindBin> sets both C<$Bin> and C<$RealBin> to the current
31directory.
32
33=head1 EXPORTABLE VARIABLES
34
35=over
36
37=item C<$Bin> or C<$Dir>
38
39Path to the bin B<directory> from where script was invoked
40
41=item C<$Script>
42
43B<Basename> of the script from which C<perl> was invoked
44
45=item C<$RealBin> or C<$RealDir>
46
47C<$Bin> with all links resolved
48
49=item C<$RealScript>
50
51C<$Script> with all links resolved
52
53=back
54
55You can also use the C<ALL> tag to export all of the above variables together:
56
57  use FindBin ':ALL';
58
59=head1 KNOWN ISSUES
60
61If there are two modules using C<FindBin> from different directories
62under the same interpreter, this won't work. Since C<FindBin> uses a
63C<BEGIN> block, it'll be executed only once, and only the first caller
64will get it right. This is a problem under C<mod_perl> and other persistent
65Perl environments, where you shouldn't use this module. Which also means
66that you should avoid using C<FindBin> in modules that you plan to put
67on CPAN. Call the C<again> function to make sure that C<FindBin> will work:
68
69  use FindBin;
70  FindBin::again(); # or FindBin->again;
71
72In former versions of C<FindBin> there was no C<again> function.
73The workaround was to force the C<BEGIN> block to be executed again:
74
75  delete $INC{'FindBin.pm'};
76  require FindBin;
77
78=head1 AUTHORS
79
80C<FindBin> is supported as part of the core perl distribution.  Please submit bug
81reports at L<https://github.com/Perl/perl5/issues>.
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 strict;
96use warnings;
97
98use Carp;
99require Exporter;
100use Cwd qw(getcwd cwd abs_path);
101use File::Basename;
102use File::Spec;
103
104our ($Bin, $Script, $RealBin, $RealScript, $Dir, $RealDir);
105our @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
106our %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
107our @ISA = qw(Exporter);
108
109our $VERSION = "1.54";
110
111# needed for VMS-specific filename translation
112if( $^O eq 'VMS' ) {
113    require VMS::Filespec;
114    VMS::Filespec->import;
115}
116
117sub cwd2 {
118   my $cwd = getcwd();
119   # getcwd might fail if it hasn't access to the current directory.
120   # try harder.
121   defined $cwd or $cwd = cwd();
122   $cwd;
123}
124
125sub init
126{
127 *Dir = \$Bin;
128 *RealDir = \$RealBin;
129
130 if($0 eq '-e' || $0 eq '-')
131  {
132   # perl invoked with -e or script is on C<STDIN>
133   $Script = $RealScript = $0;
134   $Bin    = $RealBin    = cwd2();
135   $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS';
136  }
137 else
138  {
139   my $script = $0;
140
141   if ($^O eq 'VMS')
142    {
143     ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s;
144     # C<use disk:[dev]/lib> isn't going to work, so unixify first
145     ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//;
146     ($RealBin,$RealScript) = ($Bin,$Script);
147    }
148   else
149    {
150     croak("Cannot find current script '$0'") unless(-f $script);
151
152     # Ensure $script contains the complete path in case we C<chdir>
153
154     $script = File::Spec->catfile(cwd2(), $script)
155       unless File::Spec->file_name_is_absolute($script);
156
157     ($Script,$Bin) = fileparse($script);
158
159     # Resolve $script if it is a link
160     while(1)
161      {
162       my $linktext = readlink($script);
163
164       ($RealScript,$RealBin) = fileparse($script);
165       last unless defined $linktext;
166
167       $script = (File::Spec->file_name_is_absolute($linktext))
168                  ? $linktext
169                  : File::Spec->catfile($RealBin, $linktext);
170      }
171
172     # Get absolute paths to directories
173     if ($Bin) {
174      my $BinOld = $Bin;
175      $Bin = abs_path($Bin);
176      defined $Bin or $Bin = File::Spec->canonpath($BinOld);
177     }
178     $RealBin = abs_path($RealBin) if($RealBin);
179    }
180  }
181}
182
183BEGIN { init }
184
185*again = \&init;
186
1871; # Keep require happy
188