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.
9 FindBin - Locate directory of original perl script
14 use lib "$FindBin::Bin/../lib";
19 use lib "$Bin/../lib";
23 Locates the full path to the script bin directory to allow the use
24 of paths relative to the bin directory.
26 This allows a user to setup a directory tree for some software with
27 directories E<lt>rootE<gt>/bin and E<lt>rootE<gt>/lib and then the above example will allow
28 the use of modules in the lib directory without knowing where the software
31 If perl is invoked using the B<-e> option or the perl script is read from
32 C<STDIN> then FindBin sets both C<$Bin> and C<$RealBin> to the current
35 =head1 EXPORTABLE VARIABLES
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
48 and I<filename> does not have executable rights and a program called I<filename>
49 exists in the users C<$ENV{PATH}> which satisfies both B<-x> and B<-T> then FindBin
50 assumes that it was invoked via the C<$ENV{PATH}>.
52 Workaround is to invoke perl as
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>
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.
79 @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
80 %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
83 $VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
85 # Taken from Cwd.pm It is really getcwd with an optional
86 # parameter instead of '.'
88 # another way would be:
93 # chdir(shift || '.');
94 # my $realpath = getcwd();
101 my $start = shift || '.';
102 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
104 unless (@cst = stat( $start ))
106 warn "stat($start): $!";
115 unless (opendir(PARENT, $dotdots))
117 warn "opendir($dotdots): $!";
120 unless (@cst = stat($dotdots))
122 warn "stat($dotdots): $!";
126 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
134 unless (defined ($dir = readdir(PARENT)))
136 warn "readdir($dotdots): $!";
140 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
142 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
148 chop($cwd); # drop the trailing /
156 *RealDir = \$RealBin;
157 if (defined &Cwd::sys_abspath) { *abs_path = \&Cwd::sys_abspath}
158 else { *abs_path = \&my_abs_path}
160 if($0 eq '-e' || $0 eq '-')
162 # perl invoked with -e or script is on C<STDIN>
164 $Script = $RealScript = $0;
165 $Bin = $RealBin = getcwd();
173 ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/;
174 ($RealBin,$RealScript) = ($Bin,$Script);
178 unless($script =~ m#/# && -f $script)
182 foreach $dir (split(/:/,$ENV{PATH}))
184 if(-x "$dir/$script")
186 $script = "$dir/$script";
190 # $script has been found via PATH but perl could have
191 # been invoked as 'perl file'. Do a dumb check to see
192 # if $script is a perl program, if not then $script = $0
194 # well we actually only check that it is an ASCII file
195 # we know its executable so it is probably a script
198 $script = $0 unless(-T $script);
205 croak("Cannot find current script '$0'") unless(-f $script);
207 # Ensure $script contains the complete path incase we C<chdir>
209 $script = getcwd() . "/" . $script unless($script =~ m,^/,);
211 ($Bin,$Script) = $script =~ m,^(.*?)/+([^/]+)$,;
213 # Resolve $script if it is a link
216 my $linktext = readlink($script);
218 ($RealBin,$RealScript) = $script =~ m,^(.*?)/+([^/]+)$,;
219 last unless defined $linktext;
221 $script = ($linktext =~ m,^/,)
223 : $RealBin . "/" . $linktext;
226 # Get absolute paths to directories
227 $Bin = abs_path($Bin) if($Bin);
228 $RealBin = abs_path($RealBin) if($RealBin);
233 1; # Keep require happy