dist/XSLoader/XSLoader_pm.PL

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