| Filename | /usr/share/perl/5.26/XSLoader.pm |
| Statements | Executed 0 statements in 0s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 2 | 2 | 213µs | 213µs | XSLoader::load |
| 0 | 0 | 0 | 0s | 0s | XSLoader::bootstrap_inherit |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # Generated from XSLoader_pm.PL (resolved %Config::Config value) | ||||
| 2 | # This file is unique for every OS | ||||
| 3 | |||||
| 4 | package XSLoader; | ||||
| 5 | |||||
| 6 | $VERSION = "0.27"; | ||||
| 7 | |||||
| 8 | #use strict; | ||||
| 9 | |||||
| 10 | package DynaLoader; | ||||
| 11 | |||||
| 12 | # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. | ||||
| 13 | # NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB | ||||
| 14 | boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && | ||||
| 15 | !defined(&dl_error); | ||||
| 16 | package XSLoader; | ||||
| 17 | |||||
| 18 | # spent 213µs within XSLoader::load which was called 2 times, avg 106µs/call:
# once (120µs+0s) by Function::Parameters::BEGIN@7 at line 23 of List/Util.pm
# once (92µs+0s) by Function::Parameters::BEGIN@15 at line 18 of Function/Parameters.pm | ||||
| 19 | package DynaLoader; | ||||
| 20 | |||||
| 21 | my ($caller, $modlibname) = caller(); | ||||
| 22 | my $module = $caller; | ||||
| 23 | |||||
| 24 | if (@_) { | ||||
| 25 | $module = $_[0]; | ||||
| 26 | } else { | ||||
| 27 | $_[0] = $module; | ||||
| 28 | } | ||||
| 29 | |||||
| 30 | # work with static linking too | ||||
| 31 | my $boots = "$module\::bootstrap"; | ||||
| 32 | goto &$boots if defined &$boots; | ||||
| 33 | |||||
| 34 | goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file; | ||||
| 35 | |||||
| 36 | my @modparts = split(/::/,$module); | ||||
| 37 | my $modfname = $modparts[-1]; | ||||
| 38 | |||||
| 39 | my $modpname = join('/',@modparts); | ||||
| 40 | my $c = () = split(/::/,$caller,-1); | ||||
| 41 | $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename | ||||
| 42 | # Does this look like a relative path? | ||||
| 43 | if ($modlibname !~ m{^/}) { | ||||
| 44 | # Someone may have a #line directive that changes the file name, or | ||||
| 45 | # may be calling XSLoader::load from inside a string eval. We cer- | ||||
| 46 | # tainly do not want to go loading some code that is not in @INC, | ||||
| 47 | # as it could be untrusted. | ||||
| 48 | # | ||||
| 49 | # We could just fall back to DynaLoader here, but then the rest of | ||||
| 50 | # this function would go untested in the perl core, since all @INC | ||||
| 51 | # paths are relative during testing. That would be a time bomb | ||||
| 52 | # waiting to happen, since bugs could be introduced into the code. | ||||
| 53 | # | ||||
| 54 | # So look through @INC to see if $modlibname is in it. A rela- | ||||
| 55 | # tive $modlibname is not a common occurrence, so this block is | ||||
| 56 | # not hot code. | ||||
| 57 | FOUND: { | ||||
| 58 | for (@INC) { | ||||
| 59 | if ($_ eq $modlibname) { | ||||
| 60 | last FOUND; | ||||
| 61 | } | ||||
| 62 | } | ||||
| 63 | # Not found. Fall back to DynaLoader. | ||||
| 64 | goto \&XSLoader::bootstrap_inherit; | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | my $file = "$modlibname/auto/$modpname/$modfname.so"; | ||||
| 68 | |||||
| 69 | # print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; | ||||
| 70 | |||||
| 71 | my $bs = $file; | ||||
| 72 | $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library | ||||
| 73 | |||||
| 74 | if (-s $bs) { # only read file if it's not empty | ||||
| 75 | # print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug; | ||||
| 76 | eval { local @INC = ('.'); do $bs; }; | ||||
| 77 | warn "$bs: $@\n" if $@; | ||||
| 78 | goto \&XSLoader::bootstrap_inherit; | ||||
| 79 | } | ||||
| 80 | |||||
| 81 | goto \&XSLoader::bootstrap_inherit if not -f $file; | ||||
| 82 | |||||
| 83 | my $bootname = "boot_$module"; | ||||
| 84 | $bootname =~ s/\W/_/g; | ||||
| 85 | @DynaLoader::dl_require_symbols = ($bootname); | ||||
| 86 | |||||
| 87 | my $boot_symbol_ref; | ||||
| 88 | |||||
| 89 | # Many dynamic extension loading problems will appear to come from | ||||
| 90 | # this section of code: XYZ failed at line 123 of DynaLoader.pm. | ||||
| 91 | # Often these errors are actually occurring in the initialisation | ||||
| 92 | # C code of the extension XS file. Perl reports the error as being | ||||
| 93 | # in this perl code simply because this was the last perl code | ||||
| 94 | # it executed. | ||||
| 95 | |||||
| 96 | my $libref = dl_load_file($file, 0) or do { | ||||
| 97 | require Carp; | ||||
| 98 | Carp::croak("Can't load '$file' for module $module: " . dl_error()); | ||||
| 99 | }; | ||||
| 100 | push(@DynaLoader::dl_librefs,$libref); # record loaded object | ||||
| 101 | |||||
| 102 | $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { | ||||
| 103 | require Carp; | ||||
| 104 | Carp::croak("Can't find '$bootname' symbol in $file\n"); | ||||
| 105 | }; | ||||
| 106 | |||||
| 107 | push(@DynaLoader::dl_modules, $module); # record loaded module | ||||
| 108 | |||||
| 109 | boot: | ||||
| 110 | my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file); | ||||
| 111 | |||||
| 112 | # See comment block above | ||||
| 113 | push(@DynaLoader::dl_shared_objects, $file); # record files loaded | ||||
| 114 | return &$xs(@_); | ||||
| 115 | } | ||||
| 116 | |||||
| 117 | sub bootstrap_inherit { | ||||
| 118 | require DynaLoader; | ||||
| 119 | goto \&DynaLoader::bootstrap_inherit; | ||||
| 120 | } | ||||
| 121 | |||||
| 122 | 1; | ||||
| 123 | |||||
| 124 | __END__ | ||||
| 125 |