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