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 | |
1fef88e7 | 27 | directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow |
a73990fd | 28 | the use of modules in the lib directory without knowing where the software |
29 | tree is installed. | |
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 | ||
42 | =head1 KNOWN BUGS | |
43 | ||
44 | if perl is invoked as | |
45 | ||
46 | perl filename | |
47 | ||
48 | and I<filename> does not have executable rights and a program called I<filename> | |
84dc3c4d | 49 | exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin |
a73990fd | 50 | assumes that it was invoked via the C<$ENV{PATH}>. |
51 | ||
52 | Workaround is to invoke perl as | |
53 | ||
54 | perl ./filename | |
55 | ||
56 | =head1 AUTHORS | |
57 | ||
1fef88e7 JM |
58 | Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt> |
59 | Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt> | |
a73990fd | 60 | |
61 | =head1 COPYRIGHT | |
62 | ||
63 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. | |
64 | This program is free software; you can redistribute it and/or modify it | |
65 | under the same terms as Perl itself. | |
66 | ||
67 | =head1 REVISION | |
68 | ||
69 | $Revision: 1.4 $ | |
70 | ||
71 | =cut | |
72 | ||
73 | package FindBin; | |
74 | use Carp; | |
75 | require 5.000; | |
76 | require Exporter; | |
8b88ae92 NIS |
77 | use Cwd qw(getcwd abs_path); |
78 | use Config; | |
79 | use File::Basename; | |
a73990fd | 80 | |
81 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); | |
82 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); | |
83 | @ISA = qw(Exporter); | |
84 | ||
85 | $VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); | |
86 | ||
8b88ae92 | 87 | sub is_abs_path |
a73990fd | 88 | { |
8b88ae92 NIS |
89 | local $_ = shift if (@_); |
90 | if ($^O eq 'MSWin32') | |
91 | { | |
92 | return m#^[a-z]:[\\/]#i; | |
93 | } | |
96e4d5b1 | 94 | elsif ($^O eq 'VMS') |
95 | { | |
96 | # If it's a logical name, expand it. | |
97 | $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_}; | |
98 | return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/; | |
99 | } | |
8b88ae92 NIS |
100 | else |
101 | { | |
102 | return m#^/#; | |
103 | } | |
a73990fd | 104 | } |
105 | ||
a73990fd | 106 | BEGIN |
107 | { | |
108 | *Dir = \$Bin; | |
109 | *RealDir = \$RealBin; | |
110 | ||
111 | if($0 eq '-e' || $0 eq '-') | |
112 | { | |
113 | # perl invoked with -e or script is on C<STDIN> | |
114 | ||
115 | $Script = $RealScript = $0; | |
116 | $Bin = $RealBin = getcwd(); | |
117 | } | |
118 | else | |
119 | { | |
120 | my $script = $0; | |
121 | ||
122 | if ($^O eq 'VMS') | |
123 | { | |
124 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/; | |
125 | ($RealBin,$RealScript) = ($Bin,$Script); | |
126 | } | |
127 | else | |
128 | { | |
8b88ae92 NIS |
129 | my $IsWin32 = $^O eq 'MSWin32'; |
130 | unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#)) | |
131 | && -f $script) | |
a73990fd | 132 | { |
133 | my $dir; | |
8b88ae92 NIS |
134 | my $pathvar = ($IsWin32) ? 'Path' : 'PATH'; |
135 | ||
136 | foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar})) | |
a73990fd | 137 | { |
8b88ae92 | 138 | if(-r "$dir/$script" && (!$IsWin32 || -x _)) |
a73990fd | 139 | { |
140 | $script = "$dir/$script"; | |
8b88ae92 NIS |
141 | |
142 | if (-f $0) | |
a73990fd | 143 | { |
144 | # $script has been found via PATH but perl could have | |
145 | # been invoked as 'perl file'. Do a dumb check to see | |
146 | # if $script is a perl program, if not then $script = $0 | |
147 | # | |
148 | # well we actually only check that it is an ASCII file | |
149 | # we know its executable so it is probably a script | |
150 | # of some sort. | |
8b88ae92 | 151 | |
a73990fd | 152 | $script = $0 unless(-T $script); |
153 | } | |
154 | last; | |
155 | } | |
156 | } | |
157 | } | |
8b88ae92 | 158 | |
a73990fd | 159 | croak("Cannot find current script '$0'") unless(-f $script); |
8b88ae92 | 160 | |
a73990fd | 161 | # Ensure $script contains the complete path incase we C<chdir> |
8b88ae92 NIS |
162 | |
163 | $script = getcwd() . "/" . $script unless is_abs_path($script); | |
164 | ||
165 | ($Script,$Bin) = fileparse($script); | |
166 | ||
a73990fd | 167 | # Resolve $script if it is a link |
168 | while(1) | |
169 | { | |
170 | my $linktext = readlink($script); | |
8b88ae92 NIS |
171 | |
172 | ($RealScript,$RealBin) = fileparse($script); | |
a73990fd | 173 | last unless defined $linktext; |
8b88ae92 NIS |
174 | |
175 | $script = (is_abs_path($linktext)) | |
a73990fd | 176 | ? $linktext |
177 | : $RealBin . "/" . $linktext; | |
178 | } | |
179 | ||
180 | # Get absolute paths to directories | |
181 | $Bin = abs_path($Bin) if($Bin); | |
182 | $RealBin = abs_path($RealBin) if($RealBin); | |
183 | } | |
184 | } | |
185 | } | |
186 | ||
187 | 1; # Keep require happy | |
188 |