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