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 BEGIN { unshift(@INC,"$FindBin::Bin/../lib") }
19 BEGIN { unshift(@INC,"$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 <root>/bin and <root>/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 <bodg@tiuk.ti.com>
59 Nick Ing-Simmons <nik@tiuk.ti.com>
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;
158 if($0 eq '-e' || $0 eq '-')
160 # perl invoked with -e or script is on C<STDIN>
162 $Script = $RealScript = $0;
163 $Bin = $RealBin = getcwd();
171 ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/;
172 ($RealBin,$RealScript) = ($Bin,$Script);
176 unless($script =~ m#/# && -f $script)
180 foreach $dir (split(/:/,$ENV{PATH}))
182 if(-x "$dir/$script")
184 $script = "$dir/$script";
188 # $script has been found via PATH but perl could have
189 # been invoked as 'perl file'. Do a dumb check to see
190 # if $script is a perl program, if not then $script = $0
192 # well we actually only check that it is an ASCII file
193 # we know its executable so it is probably a script
196 $script = $0 unless(-T $script);
203 croak("Cannot find current script '$0'") unless(-f $script);
205 # Ensure $script contains the complete path incase we C<chdir>
207 $script = getcwd() . "/" . $script unless($script =~ m,^/,);
209 ($Bin,$Script) = $script =~ m,^(.*?)/+([^/]+)$,;
211 # Resolve $script if it is a link
214 my $linktext = readlink($script);
216 ($RealBin,$RealScript) = $script =~ m,^(.*?)/+([^/]+)$,;
217 last unless defined $linktext;
219 $script = ($linktext =~ m,^/,)
221 : $RealBin . "/" . $linktext;
224 # Get absolute paths to directories
225 $Bin = abs_path($Bin) if($Bin);
226 $RealBin = abs_path($RealBin) if($RealBin);
231 1; # Keep require happy