dist/XSLoader/XSLoader_pm.PL

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