| File | /opt/wise/lib/perl5/5.10.0/FindBin.pm | Statements Executed | 44 | Total Time | 0.001394 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
|---|---|---|---|---|---|---|
| 1 | 1 | 1 | 6.3e-5 | 0.00063 | FindBin:: | init |
| 0 | 0 | 0 | 0 | 0 | FindBin:: | BEGIN |
| 0 | 0 | 0 | 0 | 0 | FindBin:: | cwd2 |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 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 KNOWN BUGS | |||
| 63 | ||||
| 64 | If perl is invoked as | |||
| 65 | ||||
| 66 | perl filename | |||
| 67 | ||||
| 68 | and I<filename> does not have executable rights and a program called | |||
| 69 | I<filename> exists in the users C<$ENV{PATH}> which satisfies both B<-x> | |||
| 70 | and B<-T> then FindBin assumes that it was invoked via the | |||
| 71 | C<$ENV{PATH}>. | |||
| 72 | ||||
| 73 | Workaround is to invoke perl as | |||
| 74 | ||||
| 75 | perl ./filename | |||
| 76 | ||||
| 77 | =head1 AUTHORS | |||
| 78 | ||||
| 79 | FindBin is supported as part of the core perl distribution. Please send bug | |||
| 80 | reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program | |||
| 81 | included with perl. | |||
| 82 | ||||
| 83 | Graham Barr E<lt>F<gbarr@pobox.com>E<gt> | |||
| 84 | Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt> | |||
| 85 | ||||
| 86 | =head1 COPYRIGHT | |||
| 87 | ||||
| 88 | Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved. | |||
| 89 | This program is free software; you can redistribute it and/or modify it | |||
| 90 | under the same terms as Perl itself. | |||
| 91 | ||||
| 92 | =cut | |||
| 93 | ||||
| 94 | package FindBin; | |||
| 95 | 3 | 5.0e-5 | 1.7e-5 | use Carp; # spent 85µs making 1 call to Exporter::import |
| 96 | 1 | 2.5e-5 | 2.5e-5 | require 5.000; |
| 97 | 1 | 0 | 0 | require Exporter; |
| 98 | 3 | 3.0e-5 | 1.0e-5 | use Cwd qw(getcwd cwd abs_path); # spent 62µs making 1 call to Exporter::import |
| 99 | 3 | 3.0e-5 | 1.0e-5 | use Config; # spent 22µs making 1 call to Config::import |
| 100 | 3 | 3.0e-5 | 1.0e-5 | use File::Basename; # spent 50µs making 1 call to Exporter::import |
| 101 | 3 | 0.00060 | 0.00020 | use File::Spec; # spent 4µs making 1 call to import |
| 102 | ||||
| 103 | 1 | 3.0e-6 | 3.0e-6 | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); |
| 104 | 1 | 4.0e-6 | 4.0e-6 | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); |
| 105 | 1 | 6.0e-6 | 6.0e-6 | @ISA = qw(Exporter); |
| 106 | ||||
| 107 | 1 | 1.0e-6 | 1.0e-6 | $VERSION = "1.49"; |
| 108 | ||||
| 109 | ||||
| 110 | # needed for VMS-specific filename translation | |||
| 111 | 1 | 1.0e-6 | 1.0e-6 | if( $^O eq 'VMS' ) { |
| 112 | require VMS::Filespec; | |||
| 113 | VMS::Filespec->import; | |||
| 114 | } | |||
| 115 | ||||
| 116 | sub cwd2 { | |||
| 117 | my $cwd = getcwd(); | |||
| 118 | # getcwd might fail if it hasn't access to the current directory. | |||
| 119 | # try harder. | |||
| 120 | defined $cwd or $cwd = cwd(); | |||
| 121 | $cwd; | |||
| 122 | } | |||
| 123 | ||||
| 124 | sub init | |||
| 125 | # spent 630µs (63+567) within FindBin::init which was called
# once (63µs+567µs) by FindBin::BEGIN at line 206 | |||
| 126 | 19 | 0.00056 | 3.0e-5 | *Dir = \$Bin; |
| 127 | *RealDir = \$RealBin; | |||
| 128 | ||||
| 129 | if($0 eq '-e' || $0 eq '-') | |||
| 130 | { | |||
| 131 | # perl invoked with -e or script is on C<STDIN> | |||
| 132 | $Script = $RealScript = $0; | |||
| 133 | $Bin = $RealBin = cwd2(); | |||
| 134 | $Bin = VMS::Filespec::unixify($Bin) if $^O eq 'VMS'; | |||
| 135 | } | |||
| 136 | else | |||
| 137 | { | |||
| 138 | my $script = $0; | |||
| 139 | ||||
| 140 | if ($^O eq 'VMS') | |||
| 141 | { | |||
| 142 | ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*[\]>\/]+)(.*)/s; | |||
| 143 | # C<use disk:[dev]/lib> isn't going to work, so unixify first | |||
| 144 | ($Bin = VMS::Filespec::unixify($Bin)) =~ s/\/\z//; | |||
| 145 | ($RealBin,$RealScript) = ($Bin,$Script); | |||
| 146 | } | |||
| 147 | else | |||
| 148 | { | |||
| 149 | my $dosish = ($^O eq 'MSWin32' or $^O eq 'os2'); | |||
| 150 | unless(($script =~ m#/# || ($dosish && $script =~ m#\\#)) | |||
| 151 | && -f $script) | |||
| 152 | { | |||
| 153 | my $dir; | |||
| 154 | foreach $dir (File::Spec->path) | |||
| 155 | { | |||
| 156 | my $scr = File::Spec->catfile($dir, $script); | |||
| 157 | ||||
| 158 | # $script can been found via PATH but perl could have | |||
| 159 | # been invoked as 'perl file'. Do a dumb check to see | |||
| 160 | # if $script is a perl program, if not then keep $script = $0 | |||
| 161 | # | |||
| 162 | # well we actually only check that it is an ASCII file | |||
| 163 | # we know its executable so it is probably a script | |||
| 164 | # of some sort. | |||
| 165 | if(-f $scr && -r _ && ($dosish || -x _) && -s _ && -T _) | |||
| 166 | { | |||
| 167 | $script = $scr; | |||
| 168 | last; | |||
| 169 | } | |||
| 170 | } | |||
| 171 | } | |||
| 172 | ||||
| 173 | croak("Cannot find current script '$0'") unless(-f $script); | |||
| 174 | ||||
| 175 | # Ensure $script contains the complete path in case we C<chdir> | |||
| 176 | ||||
| 177 | $script = File::Spec->catfile(cwd2(), $script) # spent 13µs making 1 call to File::Spec::Unix::file_name_is_absolute | |||
| 178 | unless File::Spec->file_name_is_absolute($script); | |||
| 179 | ||||
| 180 | ($Script,$Bin) = fileparse($script); # spent 42µs making 1 call to File::Basename::fileparse | |||
| 181 | ||||
| 182 | # Resolve $script if it is a link | |||
| 183 | while(1) | |||
| 184 | { | |||
| 185 | my $linktext = readlink($script); | |||
| 186 | ||||
| 187 | ($RealScript,$RealBin) = fileparse($script); # spent 22µs making 1 call to File::Basename::fileparse | |||
| 188 | last unless defined $linktext; | |||
| 189 | ||||
| 190 | $script = (File::Spec->file_name_is_absolute($linktext)) | |||
| 191 | ? $linktext | |||
| 192 | : File::Spec->catfile($RealBin, $linktext); | |||
| 193 | } | |||
| 194 | ||||
| 195 | # Get absolute paths to directories | |||
| 196 | if ($Bin) { | |||
| 197 | my $BinOld = $Bin; | |||
| 198 | $Bin = abs_path($Bin); # spent 234µs making 1 call to Cwd::abs_path | |||
| 199 | defined $Bin or $Bin = File::Spec->canonpath($BinOld); | |||
| 200 | } | |||
| 201 | $RealBin = abs_path($RealBin) if($RealBin); # spent 256µs making 1 call to Cwd::abs_path | |||
| 202 | } | |||
| 203 | } | |||
| 204 | } | |||
| 205 | ||||
| 206 | 1 | 4.3e-5 | 4.3e-5 | BEGIN { init } # spent 630µs making 1 call to FindBin::init |
| 207 | ||||
| 208 | 1 | 1.0e-6 | 1.0e-6 | *again = \&init; |
| 209 | ||||
| 210 | 1 | 1.0e-5 | 1.0e-5 | 1; # Keep require happy |