1use strict; 2use warnings; 3 4use Config; 5# We require DynaLoader to make sure that mod2fname is loaded 6eval { require DynaLoader }; 7 81 while unlink "XSLoader.pm"; 9open OUT, '>', 'XSLoader.pm' or die $!; 10print OUT <<'EOT'; 11# Generated from XSLoader_pm.PL (resolved %Config::Config value) 12# This file is unique for every OS 13 14use strict; 15no strict 'refs'; 16 17package XSLoader; 18 19our $VERSION = "0.32"; # remember to update version in POD! 20 21package DynaLoader; 22 23# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. 24# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB 25boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && 26 !defined(&dl_error); 27package XSLoader; 28 29sub load { 30 package DynaLoader; 31 32 my ($caller, $modlibname) = caller(); 33 my $module = $caller; 34 35 if (@_) { 36 $module = $_[0]; 37 } else { 38 $_[0] = $module; 39 } 40 41 # work with static linking too 42 my $boots = "$module\::bootstrap"; 43 goto &$boots if defined &$boots; 44 45 goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file; 46 47 my @modparts = split(/::/,$module); 48 my $modfname = $modparts[-1]; 49 my $modfname_orig = $modfname; # For .bs file search 50 51EOT 52 53# defined &DynaLoader::mod2fname catches most cases, except when 54# cross-compiling to a system that defines mod2fname. Using 55# $Config{d_libname_unique} is a best attempt at catching those cases. 56print OUT <<'EOT' if defined &DynaLoader::mod2fname || $Config{d_libname_unique}; 57 # Some systems have restrictions on files names for DLL's etc. 58 # mod2fname returns appropriate file base name (typically truncated) 59 # It may also edit @modparts if required. 60 $modfname = &DynaLoader::mod2fname(\@modparts) if defined &DynaLoader::mod2fname; 61 62EOT 63 64print OUT <<'EOT' if $^O eq 'os2'; 65 66 # os2 static build can dynaload, but cannot dynaload Perl modules... 67 die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static; 68 69EOT 70 71print OUT <<'EOT'; 72 my $modpname = join('/',@modparts); 73 my $c = () = split(/::/,$caller,-1); 74 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename 75EOT 76 77my $to_print = <<'EOT'; 78 # Does this look like a relative path? 79 if ($modlibname !~ m{regexp}) { 80EOT 81 82$to_print =~ s~regexp~ 83 $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'amigaos' 84 ? '^(?:[A-Za-z]:)?[\\\/]' # Optional drive letter 85 : '^/' 86~e; 87 88print OUT $to_print, <<'EOT'; 89 # Someone may have a #line directive that changes the file name, or 90 # may be calling XSLoader::load from inside a string eval. We cer- 91 # tainly do not want to go loading some code that is not in @INC, 92 # as it could be untrusted. 93 # 94 # We could just fall back to DynaLoader here, but then the rest of 95 # this function would go untested in the perl core, since all @INC 96 # paths are relative during testing. That would be a time bomb 97 # waiting to happen, since bugs could be introduced into the code. 98 # 99 # So look through @INC to see if $modlibname is in it. A rela- 100 # tive $modlibname is not a common occurrence, so this block is 101 # not hot code. 102 FOUND: { 103 for (@INC) { 104 if ($_ eq $modlibname) { 105 last FOUND; 106 } 107 } 108 # Not found. Fall back to DynaLoader. 109 goto \&XSLoader::bootstrap_inherit; 110 } 111 } 112EOT 113 114my $dl_dlext = quotemeta($Config::Config{'dlext'}); 115 116print OUT <<"EOT"; 117 my \$file = "\$modlibname/auto/\$modpname/\$modfname.$dl_dlext"; 118EOT 119 120print OUT <<'EOT'; 121 122# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; 123 124 # N.B. The .bs file does not following the naming convention used 125 # by mod2fname, so use the unedited version of the name. 126 127 my $bs = "$modlibname/auto/$modpname/$modfname_orig.bs"; 128 129 # This calls DynaLoader::bootstrap, which will load the .bs file if present 130 goto \&XSLoader::bootstrap_inherit if not -f $file or -s $bs; 131 132 my $bootname = "boot_$module"; 133 $bootname =~ s/\W/_/g; 134 @DynaLoader::dl_require_symbols = ($bootname); 135 136 my $boot_symbol_ref; 137 138EOT 139 140 if ($^O eq 'darwin') { 141 my $extra_arg = ', 1 ' if $DynaLoader::VERSION ge '1.37'; 142print OUT <<"EOT"; 143 if (\$boot_symbol_ref = dl_find_symbol( 0, \$bootname $extra_arg)) { 144 goto boot; #extension library has already been loaded, e.g. darwin 145 } 146EOT 147 } 148 149print OUT <<'EOT'; 150 # Many dynamic extension loading problems will appear to come from 151 # this section of code: XYZ failed at line 123 of DynaLoader.pm. 152 # Often these errors are actually occurring in the initialisation 153 # C code of the extension XS file. Perl reports the error as being 154 # in this perl code simply because this was the last perl code 155 # it executed. 156 157 my $libref = dl_load_file($file, 0) or do { 158 require Carp; 159 Carp::croak("Can't load '$file' for module $module: " . dl_error()); 160 }; 161 push(@DynaLoader::dl_librefs,$libref); # record loaded object 162 163EOT 164my $dlsrc = $Config{dlsrc}; 165if ($dlsrc eq 'dl_freemint.xs' || $dlsrc eq 'dl_dld.xs') { 166 print OUT <<'EOT'; 167 my @unresolved = dl_undef_symbols(); 168 if (@unresolved) { 169 require Carp; 170 Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); 171 } 172 173EOT 174} 175 176print OUT <<'EOT'; 177 $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { 178 require Carp; 179 Carp::croak("Can't find '$bootname' symbol in $file\n"); 180 }; 181 182 push(@DynaLoader::dl_modules, $module); # record loaded module 183 184 boot: 185 my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file); 186 187 # See comment block above 188 push(@DynaLoader::dl_shared_objects, $file); # record files loaded 189 return &$xs(@_); 190} 191 192# Can't test with DynaLoader->can('bootstrap_inherit') when building in the 193# core, as XSLoader gets built before DynaLoader. 194 195sub bootstrap_inherit { 196 require DynaLoader; 197 goto \&DynaLoader::bootstrap_inherit; 198} 199 2001; 201 202__END__ 203 204=head1 NAME 205 206XSLoader - Dynamically load C libraries into Perl code 207 208=head1 VERSION 209 210Version 0.32 211 212=head1 SYNOPSIS 213 214 package YourPackage; 215 require XSLoader; 216 217 XSLoader::load(__PACKAGE__, $VERSION); 218 219=head1 DESCRIPTION 220 221This module defines a standard I<simplified> interface to the dynamic 222linking mechanisms available on many platforms. Its primary purpose is 223to implement cheap automatic dynamic loading of Perl modules. 224 225For a more complicated interface, see L<DynaLoader>. Many (most) 226features of C<DynaLoader> are not implemented in C<XSLoader>, like for 227example the C<dl_load_flags>, not honored by C<XSLoader>. 228 229=head2 Migration from C<DynaLoader> 230 231A typical module using L<DynaLoader|DynaLoader> starts like this: 232 233 package YourPackage; 234 require DynaLoader; 235 236 our @ISA = qw( OnePackage OtherPackage DynaLoader ); 237 our $VERSION = '0.01'; 238 __PACKAGE__->bootstrap($VERSION); 239 240Change this to 241 242 package YourPackage; 243 use XSLoader; 244 245 our @ISA = qw( OnePackage OtherPackage ); 246 our $VERSION = '0.01'; 247 XSLoader::load(__PACKAGE__, $VERSION); 248 249In other words: replace C<require DynaLoader> by C<use XSLoader>, remove 250C<DynaLoader> from C<@ISA>, change C<bootstrap> by C<XSLoader::load>. Do not 251forget to quote the name of your package on the C<XSLoader::load> line, 252and add comma (C<,>) before the arguments (C<$VERSION> above). 253 254Of course, if C<@ISA> contained only C<DynaLoader>, there is no need to have 255the C<@ISA> assignment at all; moreover, if instead of C<our> one uses the 256more backward-compatible 257 258 use vars qw($VERSION @ISA); 259 260one can remove this reference to C<@ISA> together with the C<@ISA> assignment. 261 262If no C<$VERSION> was specified on the C<bootstrap> line, the last line becomes 263 264 XSLoader::load(__PACKAGE__); 265 266in which case it can be further simplified to 267 268 XSLoader::load(); 269 270as C<load> will use C<caller> to determine the package. 271 272=head2 Backward compatible boilerplate 273 274If you want to have your cake and eat it too, you need a more complicated 275boilerplate. 276 277 package YourPackage; 278 279 our @ISA = qw( OnePackage OtherPackage ); 280 our $VERSION = '0.01'; 281 eval { 282 require XSLoader; 283 XSLoader::load(__PACKAGE__, $VERSION); 284 1; 285 } or do { 286 require DynaLoader; 287 push @ISA, 'DynaLoader'; 288 __PACKAGE__->bootstrap($VERSION); 289 }; 290 291The parentheses about C<XSLoader::load()> arguments are needed since we replaced 292C<use XSLoader> by C<require>, so the compiler does not know that a function 293C<XSLoader::load()> is present. 294 295This boilerplate uses the low-overhead C<XSLoader> if present; if used with 296an antique Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>. 297 298=head1 Order of initialization: early load() 299 300I<Skip this section if the XSUB functions are supposed to be called from other 301modules only; read it only if you call your XSUBs from the code in your module, 302or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">). 303What is described here is equally applicable to the L<DynaLoader|DynaLoader> 304interface.> 305 306A sufficiently complicated module using XS would have both Perl code (defined 307in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). If this 308Perl code makes calls into this XS code, and/or this XS code makes calls to 309the Perl code, one should be careful with the order of initialization. 310 311The call to C<XSLoader::load()> (or C<bootstrap()>) calls the module's 312bootstrap code. For modules build by F<xsubpp> (nearly all modules) this 313has three side effects: 314 315=over 316 317=item * 318 319A sanity check is done to ensure that the versions of the F<.pm> and the 320(compiled) F<.xs> parts are compatible. If C<$VERSION> was specified, this 321is used for the check. If not specified, it defaults to 322C<$XS_VERSION // $VERSION> (in the module's namespace) 323 324=item * 325 326the XSUBs are made accessible from Perl 327 328=item * 329 330if a C<BOOT:> section was present in the F<.xs> file, the code there is called. 331 332=back 333 334Consequently, if the code in the F<.pm> file makes calls to these XSUBs, it is 335convenient to have XSUBs installed before the Perl code is defined; for 336example, this makes prototypes for XSUBs visible to this Perl code. 337Alternatively, if the C<BOOT:> section makes calls to Perl functions (or 338uses Perl variables) defined in the F<.pm> file, they must be defined prior to 339the call to C<XSLoader::load()> (or C<bootstrap()>). 340 341The first situation being much more frequent, it makes sense to rewrite the 342boilerplate as 343 344 package YourPackage; 345 use XSLoader; 346 our ($VERSION, @ISA); 347 348 BEGIN { 349 @ISA = qw( OnePackage OtherPackage ); 350 $VERSION = '0.01'; 351 352 # Put Perl code used in the BOOT: section here 353 354 XSLoader::load(__PACKAGE__, $VERSION); 355 } 356 357 # Put Perl code making calls into XSUBs here 358 359=head2 The most hairy case 360 361If the interdependence of your C<BOOT:> section and Perl code is 362more complicated than this (e.g., the C<BOOT:> section makes calls to Perl 363functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:> 364section altogether. Replace it with a function C<onBOOT()>, and call it like 365this: 366 367 package YourPackage; 368 use XSLoader; 369 our ($VERSION, @ISA); 370 371 BEGIN { 372 @ISA = qw( OnePackage OtherPackage ); 373 $VERSION = '0.01'; 374 XSLoader::load(__PACKAGE__, $VERSION); 375 } 376 377 # Put Perl code used in onBOOT() function here; calls to XSUBs are 378 # prototype-checked. 379 380 onBOOT; 381 382 # Put Perl initialization code assuming that XS is initialized here 383 384 385=head1 DIAGNOSTICS 386 387=over 388 389=item C<Can't find '%s' symbol in %s> 390 391B<(F)> The bootstrap symbol could not be found in the extension module. 392 393=item C<Can't load '%s' for module %s: %s> 394 395B<(F)> The loading or initialisation of the extension module failed. 396The detailed error follows. 397 398=item C<Undefined symbols present after loading %s: %s> 399 400B<(W)> As the message says, some symbols stay undefined although the 401extension module was correctly loaded and initialised. The list of undefined 402symbols follows. 403 404=back 405 406=head1 LIMITATIONS 407 408To reduce the overhead as much as possible, only one possible location 409is checked to find the extension DLL (this location is where C<make install> 410would put the DLL). If not found, the search for the DLL is transparently 411delegated to C<DynaLoader>, which looks for the DLL along the C<@INC> list. 412 413In particular, this is applicable to the structure of C<@INC> used for testing 414not-yet-installed extensions. This means that running uninstalled extensions 415may have much more overhead than running the same extensions after 416C<make install>. 417 418 419=head1 KNOWN BUGS 420 421The new simpler way to call C<XSLoader::load()> with no arguments at all 422does not work on Perl 5.8.4 and 5.8.5. 423 424 425=head1 BUGS 426 427Please report any bugs or feature requests via the perlbug(1) utility. 428 429 430=head1 SEE ALSO 431 432L<DynaLoader> 433 434 435=head1 AUTHORS 436 437Ilya Zakharevich originally extracted C<XSLoader> from C<DynaLoader>. 438 439CPAN version is currently maintained by SE<eacute>bastien Aperghis-Tramoni 440E<lt>sebastien@aperghis.netE<gt>. 441 442Previous maintainer was Michael G Schwern <schwern@pobox.com>. 443 444 445=head1 COPYRIGHT & LICENSE 446 447Copyright (C) 1990-2011 by Larry Wall and others. 448 449This program is free software; you can redistribute it and/or modify 450it under the same terms as Perl itself. 451 452=cut 453EOT 454 455close OUT or die $!; 456