| Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/FindBin.pm |
| Statements | Executed 38 statements in 490µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 43µs | 180µs | FindBin::init |
| 1 | 1 | 1 | 19µs | 46µs | FindBin::BEGIN@80 |
| 1 | 1 | 1 | 9µs | 34µs | FindBin::BEGIN@84 |
| 1 | 1 | 1 | 9µs | 52µs | FindBin::BEGIN@83 |
| 1 | 1 | 1 | 6µs | 6µs | FindBin::CORE:readlink (opcode) |
| 1 | 1 | 1 | 5µs | 185µs | FindBin::BEGIN@166 |
| 1 | 1 | 1 | 5µs | 12µs | FindBin::cwd2 |
| 1 | 1 | 1 | 4µs | 4µs | FindBin::BEGIN@85 |
| 1 | 1 | 1 | 3µs | 3µs | FindBin::CORE:ftfile (opcode) |
| Line | State ments |
Time on line |
Calls | Time in subs |
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 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 | 2 | 28µs | 2 | 74µs | # spent 46µs (19+28) within FindBin::BEGIN@80 which was called:
# once (19µs+28µs) by Benchmark::Perl::Formance::BEGIN@22 at line 80 # spent 46µs making 1 call to FindBin::BEGIN@80
# spent 28µs making 1 call to Exporter::import |
| 81 | 1 | 9µs | require 5.000; | ||
| 82 | 1 | 300ns | require Exporter; | ||
| 83 | 2 | 21µs | 2 | 96µs | # spent 52µs (9+43) within FindBin::BEGIN@83 which was called:
# once (9µs+43µs) by Benchmark::Perl::Formance::BEGIN@22 at line 83 # spent 52µs making 1 call to FindBin::BEGIN@83
# spent 43µs making 1 call to Exporter::import |
| 84 | 2 | 20µs | 2 | 59µs | # spent 34µs (9+25) within FindBin::BEGIN@84 which was called:
# once (9µs+25µs) by Benchmark::Perl::Formance::BEGIN@22 at line 84 # spent 34µs making 1 call to FindBin::BEGIN@84
# spent 25µs making 1 call to Exporter::import |
| 85 | 2 | 293µs | 1 | 4µs | # spent 4µs within FindBin::BEGIN@85 which was called:
# once (4µs+0s) by Benchmark::Perl::Formance::BEGIN@22 at line 85 # spent 4µs making 1 call to FindBin::BEGIN@85 |
| 86 | |||||
| 87 | 1 | 1µs | @EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir); | ||
| 88 | 1 | 2µs | %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); | ||
| 89 | 1 | 5µs | @ISA = qw(Exporter); | ||
| 90 | |||||
| 91 | 1 | 300ns | $VERSION = "1.51"; | ||
| 92 | |||||
| 93 | |||||
| 94 | # needed for VMS-specific filename translation | ||||
| 95 | 1 | 600ns | if( $^O eq 'VMS' ) { | ||
| 96 | require VMS::Filespec; | ||||
| 97 | VMS::Filespec->import; | ||||
| 98 | } | ||||
| 99 | |||||
| 100 | # spent 12µs (5+7) within FindBin::cwd2 which was called:
# once (5µs+7µs) by FindBin::init at line 137 | ||||
| 101 | 1 | 11µs | 1 | 7µs | my $cwd = getcwd(); # spent 7µs making 1 call to Cwd::getcwd |
| 102 | # getcwd might fail if it hasn't access to the current directory. | ||||
| 103 | # try harder. | ||||
| 104 | 1 | 300ns | defined $cwd or $cwd = cwd(); | ||
| 105 | 1 | 2µs | $cwd; | ||
| 106 | } | ||||
| 107 | |||||
| 108 | sub init | ||||
| 109 | # spent 180µs (43+137) within FindBin::init which was called:
# once (43µs+137µs) by FindBin::BEGIN@166 at line 166 | ||||
| 110 | 1 | 600ns | *Dir = \$Bin; | ||
| 111 | 1 | 100ns | *RealDir = \$RealBin; | ||
| 112 | |||||
| 113 | 1 | 3µs | 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 | 1 | 500ns | my $script = $0; | ||
| 123 | |||||
| 124 | 1 | 600ns | 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 | 1 | 9µs | 1 | 3µs | croak("Cannot find current script '$0'") unless(-f $script); # spent 3µs making 1 call to FindBin::CORE:ftfile |
| 134 | |||||
| 135 | # Ensure $script contains the complete path in case we C<chdir> | ||||
| 136 | |||||
| 137 | 1 | 11µs | 3 | 82µs | $script = File::Spec->catfile(cwd2(), $script) # spent 63µs making 1 call to File::Spec::Unix::catfile
# spent 12µs making 1 call to FindBin::cwd2
# spent 7µs making 1 call to File::Spec::Unix::file_name_is_absolute |
| 138 | unless File::Spec->file_name_is_absolute($script); | ||||
| 139 | |||||
| 140 | 1 | 2µs | 1 | 18µs | ($Script,$Bin) = fileparse($script); # spent 18µs making 1 call to File::Basename::fileparse |
| 141 | |||||
| 142 | # Resolve $script if it is a link | ||||
| 143 | 1 | 200ns | while(1) | ||
| 144 | { | ||||
| 145 | 1 | 10µs | 1 | 6µs | my $linktext = readlink($script); # spent 6µs making 1 call to FindBin::CORE:readlink |
| 146 | |||||
| 147 | 1 | 2µs | 1 | 10µs | ($RealScript,$RealBin) = fileparse($script); # spent 10µs making 1 call to File::Basename::fileparse |
| 148 | 1 | 600ns | 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 | 1 | 200ns | if ($Bin) { | ||
| 157 | 1 | 200ns | my $BinOld = $Bin; | ||
| 158 | 1 | 18µs | 1 | 14µs | $Bin = abs_path($Bin); # spent 14µs making 1 call to Cwd::abs_path |
| 159 | 1 | 400ns | defined $Bin or $Bin = File::Spec->canonpath($BinOld); | ||
| 160 | } | ||||
| 161 | 1 | 7µs | 1 | 4µs | $RealBin = abs_path($RealBin) if($RealBin); # spent 4µs making 1 call to Cwd::abs_path |
| 162 | } | ||||
| 163 | } | ||||
| 164 | } | ||||
| 165 | |||||
| 166 | 1 | 28µs | 2 | 365µs | # spent 185µs (5+180) within FindBin::BEGIN@166 which was called:
# once (5µs+180µs) by Benchmark::Perl::Formance::BEGIN@22 at line 166 # spent 185µs making 1 call to FindBin::BEGIN@166
# spent 180µs making 1 call to FindBin::init |
| 167 | |||||
| 168 | 1 | 900ns | *again = \&init; | ||
| 169 | |||||
| 170 | 1 | 6µs | 1; # Keep require happy | ||
# spent 3µs within FindBin::CORE:ftfile which was called:
# once (3µs+0s) by FindBin::init at line 133 | |||||
# spent 6µs within FindBin::CORE:readlink which was called:
# once (6µs+0s) by FindBin::init at line 145 |