| 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; |
| 14 | use lib "$FindBin::Bin/../lib"; |
| 15 | |
| 16 | or |
| 17 | |
| 18 | use FindBin qw($Bin); |
| 19 | use lib "$Bin/../lib"; |
| 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 |
| 27 | directories C<< <root>/bin >> and C<< <root>/lib >>, and then the above |
| 28 | example will allow the use of modules in the lib directory without knowing |
| 29 | where the software tree is installed. |
| 30 | |
| 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 |
| 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 ISSUES |
| 43 | |
| 44 | If there are two modules using C<FindBin> from different directories |
| 45 | under the same interpreter, this won't work. Since C<FindBin> uses a |
| 46 | C<BEGIN> block, it'll be executed only once, and only the first caller |
| 47 | will get it right. This is a problem under mod_perl and other persistent |
| 48 | Perl environments, where you shouldn't use this module. Which also means |
| 49 | that you should avoid using C<FindBin> in modules that you plan to put |
| 50 | on CPAN. To make sure that C<FindBin> will work is to call the C<again> |
| 51 | function: |
| 52 | |
| 53 | use FindBin; |
| 54 | FindBin::again(); # or FindBin->again; |
| 55 | |
| 56 | In former versions of FindBin there was no C<again> function. The |
| 57 | workaround was to force the C<BEGIN> block to be executed again: |
| 58 | |
| 59 | delete $INC{'FindBin.pm'}; |
| 60 | require FindBin; |
| 61 | |
| 62 | =head1 AUTHORS |
| 63 | |
| 64 | FindBin is supported as part of the core perl distribution. Please send bug |
| 65 | reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program |
| 66 | included with perl. |
| 67 | |
| 68 | Graham Barr E<lt>F<gbarr@pobox.com>E<gt> |
| 69 | Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt> |
| 70 | |
| 71 | =head1 COPYRIGHT |
| 72 | |
| 73 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. |
| 74 | This program is free software; you can redistribute it and/or modify it |
| 75 | under the same terms as Perl itself. |
| 76 | |
| 77 | =cut |
| 78 | |
| 79 | package FindBin; |
| 80 | use Carp; |
| 81 | require 5.000; |
| 82 | require Exporter; |
| 83 | use Cwd qw(getcwd cwd abs_path); |
| 84 | use File::Basename; |
| 85 | use File::Spec; |
| 86 | |
| 87 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); |
| 88 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); |
| 89 | @ISA = qw(Exporter); |
| 90 | |
| 91 | $VERSION = "1.51"; |
| 92 | |
| 93 | |
| 94 | # needed for VMS-specific filename translation |
| 95 | if( $^O eq 'VMS' ) { |
| 96 | require VMS::Filespec; |
| 97 | VMS::Filespec->import; |
| 98 | } |
| 99 | |
| 100 | sub cwd2 { |
| 101 | my $cwd = getcwd(); |
| 102 | # getcwd might fail if it hasn't access to the current directory. |
| 103 | # try harder. |
| 104 | defined $cwd or $cwd = cwd(); |
| 105 | $cwd; |
| 106 | } |
| 107 | |
| 108 | sub init |
| 109 | { |
| 110 | *Dir = \$Bin; |
| 111 | *RealDir = \$RealBin; |
| 112 | |
| 113 | if($0 eq '-e' || $0 eq '-') |
| 114 | { |
| 115 | # perl invoked with -e or script is on C<STDIN> |
| 116 | $Script = $RealScript = $0; |
| 117 | $Bin = $RealBin = cwd2(); |
| 118 | $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS'; |
| 119 | } |
| 120 | else |
| 121 | { |
| 122 | my $script = $0; |
| 123 | |
| 124 | if ($^O eq 'VMS') |
| 125 | { |
| 126 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s; |
| 127 | # C<use disk:[dev]/lib> isn't going to work, so unixify first |
| 128 | ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//; |
| 129 | ($RealBin,$RealScript) = ($Bin,$Script); |
| 130 | } |
| 131 | else |
| 132 | { |
| 133 | croak("Cannot find current script '$0'") unless(-f $script); |
| 134 | |
| 135 | # Ensure $script contains the complete path in case we C<chdir> |
| 136 | |
| 137 | $script = File::Spec->catfile(cwd2(), $script) |
| 138 | unless File::Spec->file_name_is_absolute($script); |
| 139 | |
| 140 | ($Script,$Bin) = fileparse($script); |
| 141 | |
| 142 | # Resolve $script if it is a link |
| 143 | while(1) |
| 144 | { |
| 145 | my $linktext = readlink($script); |
| 146 | |
| 147 | ($RealScript,$RealBin) = fileparse($script); |
| 148 | last unless defined $linktext; |
| 149 | |
| 150 | $script = (File::Spec->file_name_is_absolute($linktext)) |
| 151 | ? $linktext |
| 152 | : File::Spec->catfile($RealBin, $linktext); |
| 153 | } |
| 154 | |
| 155 | # Get absolute paths to directories |
| 156 | if ($Bin) { |
| 157 | my $BinOld = $Bin; |
| 158 | $Bin = abs_path($Bin); |
| 159 | defined $Bin or $Bin = File::Spec->canonpath($BinOld); |
| 160 | } |
| 161 | $RealBin = abs_path($RealBin) if($RealBin); |
| 162 | } |
| 163 | } |
| 164 | } |
| 165 | |
| 166 | BEGIN { init } |
| 167 | |
| 168 | *again = \&init; |
| 169 | |
| 170 | 1; # Keep require happy |