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