ext/DynaLoader/XSLoader_pm.PL

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