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
CommitLineData
11fd7d05 1use strict;
9cf41c4d 2use Config;
adedc077
BF
3# We require DynaLoader to make sure that mod2fname is loaded
4eval { require DynaLoader };
9cf41c4d 5
11fd7d05 61 while unlink "XSLoader.pm";
1ae6ead9 7open OUT, '>', 'XSLoader.pm' or die $!;
9cf41c4d 8print OUT <<'EOT';
35e4400b 9# Generated from XSLoader_pm.PL (resolved %Config::Config value)
f24427cc 10# This file is unique for every OS
9cf41c4d
GS
11
12package XSLoader;
13
fc9d6b91 14$VERSION = "0.28";
11fd7d05
RGS
15
16#use strict;
9cf41c4d 17
daef35db
NC
18package DynaLoader;
19
20EOT
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
35print OUT <<'EOT' if $] < 5.006;
36
9cf41c4d 37# enable debug/trace messages from DynaLoader perl code
daef35db 38$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
9cf41c4d 39
daef35db 40EOT
b4cea227 41
daef35db 42print OUT <<'EOT';
b4cea227
GS
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
9cf41c4d 45boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
b4cea227 46 !defined(&dl_error);
9cf41c4d
GS
47package XSLoader;
48
9cf41c4d
GS
49sub load {
50 package DynaLoader;
51
30837b2a
GK
52 my ($caller, $modlibname) = caller();
53 my $module = $caller;
9e8c31cc 54
1d2b7ec5 55 if (@_) {
e6ea8c3b 56 $module = $_[0];
1d2b7ec5 57 } else {
e6ea8c3b 58 $_[0] = $module;
1d2b7ec5 59 }
9cf41c4d
GS
60
61 # work with static linking too
73bf7552
AT
62 my $boots = "$module\::bootstrap";
63 goto &$boots if defined &$boots;
9cf41c4d 64
6e0eede9 65 goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file;
9cf41c4d
GS
66
67 my @modparts = split(/::/,$module);
68 my $modfname = $modparts[-1];
69
70EOT
71
4821216b
BF
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.
75print OUT <<'EOT' if defined &DynaLoader::mod2fname || $Config{d_libname_unique};
9cf41c4d
GS
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.
4821216b 79 $modfname = &DynaLoader::mod2fname(\@modparts) if defined &DynaLoader::mod2fname;
9cf41c4d
GS
80
81EOT
82
9d419b5f
IZ
83print 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
88EOT
b0d07b4e 89
9cf41c4d
GS
90print OUT <<'EOT';
91 my $modpname = join('/',@modparts);
30837b2a 92 my $c = () = split(/::/,$caller,-1);
e6ea8c3b 93 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
a651dcdf
FC
94EOT
95
96my $to_print = <<'EOT';
08e3451d 97 # Does this look like a relative path?
a651dcdf
FC
98 if ($modlibname !~ m{regexp}) {
99EOT
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
107print OUT $to_print, <<'EOT';
08e3451d
FC
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 }
f4b4ed7b
NC
131EOT
132
133my $dl_dlext = quotemeta($Config::Config{'dlext'});
134
135print OUT <<"EOT";
136 my \$file = "\$modlibname/auto/\$modpname/\$modfname.$dl_dlext";
137EOT
138
139print OUT <<'EOT';
9cf41c4d
GS
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
a17768d7
DIM
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;
9cf41c4d
GS
148
149 my $bootname = "boot_$module";
150 $bootname =~ s/\W/_/g;
11fd7d05 151 @DynaLoader::dl_require_symbols = ($bootname);
9cf41c4d 152
588cafc8
DM
153 my $boot_symbol_ref;
154
68d3ba50
VK
155EOT
156
588cafc8 157 if ($^O eq 'darwin') {
c35721ed
RU
158 my $extra_arg = ', 1 ' if $DynaLoader::VERSION ge '1.37';
159print 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 }
68d3ba50 163EOT
588cafc8
DM
164 }
165
68d3ba50 166print OUT <<'EOT';
9cf41c4d
GS
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 {
11fd7d05
RGS
175 require Carp;
176 Carp::croak("Can't load '$file' for module $module: " . dl_error());
9cf41c4d 177 };
11fd7d05 178 push(@DynaLoader::dl_librefs,$libref); # record loaded object
9cf41c4d 179
f24427cc
DD
180EOT
181my $dlsrc = $Config{dlsrc};
182if ($dlsrc eq 'dl_freemint.xs' || $dlsrc eq 'dl_dld.xs') {
183 print OUT <<'EOT';
9cf41c4d
GS
184 my @unresolved = dl_undef_symbols();
185 if (@unresolved) {
11fd7d05
RGS
186 require Carp;
187 Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
9cf41c4d
GS
188 }
189
f24427cc
DD
190EOT
191}
192
193print OUT <<'EOT';
588cafc8 194 $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
11fd7d05
RGS
195 require Carp;
196 Carp::croak("Can't find '$bootname' symbol in $file\n");
9cf41c4d
GS
197 };
198
11fd7d05 199 push(@DynaLoader::dl_modules, $module); # record loaded module
9cf41c4d 200
588cafc8 201 boot:
73bf7552 202 my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file);
588cafc8 203
9cf41c4d 204 # See comment block above
89166d32 205 push(@DynaLoader::dl_shared_objects, $file); # record files loaded
9cf41c4d 206 return &$xs(@_);
6e0eede9
NC
207}
208EOT
209
e6ea8c3b 210# Can't test with DynaLoader->can('bootstrap_inherit') when building in the
6e0eede9 211# core, as XSLoader gets built before DynaLoader.
9cf41c4d 212
6e0eede9
NC
213if ($] >= 5.006) {
214 print OUT <<'EOT';
215
216sub bootstrap_inherit {
217 require DynaLoader;
218 goto \&DynaLoader::bootstrap_inherit;
11fd7d05
RGS
219}
220
6e0eede9
NC
221EOT
222} else {
223 print OUT <<'EOT';
224
11fd7d05 225sub bootstrap_inherit {
6e0eede9 226 # Versions of DynaLoader prior to 5.6.0 don't have bootstrap_inherit.
11fd7d05
RGS
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?
9cf41c4d 233 require DynaLoader;
11fd7d05 234 DynaLoader::bootstrap(@_);
9cf41c4d
GS
235}
236
6e0eede9
NC
237EOT
238}
239
240print OUT <<'EOT';
9e8c31cc
MS
2411;
242
11fd7d05 243
9cf41c4d
GS
244__END__
245
246=head1 NAME
247
248XSLoader - Dynamically load C libraries into Perl code
249
11fd7d05
RGS
250=head1 VERSION
251
6f2c9cc3 252Version 0.24
11fd7d05 253
9cf41c4d
GS
254=head1 SYNOPSIS
255
256 package YourPackage;
1d2b7ec5 257 require XSLoader;
9cf41c4d 258
1d2b7ec5 259 XSLoader::load();
9cf41c4d
GS
260
261=head1 DESCRIPTION
262
263This module defines a standard I<simplified> interface to the dynamic
264linking mechanisms available on many platforms. Its primary purpose is
265to implement cheap automatic dynamic loading of Perl modules.
266
4406dda9 267For a more complicated interface, see L<DynaLoader>. Many (most)
11fd7d05
RGS
268features of C<DynaLoader> are not implemented in C<XSLoader>, like for
269example the C<dl_load_flags>, not honored by C<XSLoader>.
9cf41c4d 270
d7f44de2
IZ
271=head2 Migration from C<DynaLoader>
272
273A 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
282Change 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
291In other words: replace C<require DynaLoader> by C<use XSLoader>, remove
11fd7d05 292C<DynaLoader> from C<@ISA>, change C<bootstrap> by C<XSLoader::load>. Do not
d7f44de2 293forget to quote the name of your package on the C<XSLoader::load> line,
9c6b46e2 294and add comma (C<,>) before the arguments (C<$VERSION> above).
d7f44de2 295
11fd7d05
RGS
296Of course, if C<@ISA> contained only C<DynaLoader>, there is no need to have
297the C<@ISA> assignment at all; moreover, if instead of C<our> one uses the
298more backward-compatible
d7f44de2
IZ
299
300 use vars qw($VERSION @ISA);
301
11fd7d05 302one can remove this reference to C<@ISA> together with the C<@ISA> assignment.
d7f44de2 303
11fd7d05 304If no C<$VERSION> was specified on the C<bootstrap> line, the last line becomes
d7f44de2
IZ
305
306 XSLoader::load 'YourPackage';
307
681a49bf 308If the call to C<load> is from C<YourPackage>, then that can be further
1d2b7ec5
NC
309simplified to
310
311 XSLoader::load();
312
313as C<load> will use C<caller> to determine the package.
314
d7f44de2
IZ
315=head2 Backward compatible boilerplate
316
317If you want to have your cake and eat it too, you need a more complicated
318boilerplate.
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
11fd7d05 335The parentheses about C<XSLoader::load()> arguments are needed since we replaced
d7f44de2 336C<use XSLoader> by C<require>, so the compiler does not know that a function
11fd7d05 337C<XSLoader::load()> is present.
d7f44de2
IZ
338
339This boilerplate uses the low-overhead C<XSLoader> if present; if used with
681a49bf 340an antique Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
d7f44de2
IZ
341
342=head1 Order of initialization: early load()
343
344I<Skip this section if the XSUB functions are supposed to be called from other
345modules only; read it only if you call your XSUBs from the code in your module,
346or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
4406dda9 347What is described here is equally applicable to the L<DynaLoader|DynaLoader>
d7f44de2
IZ
348interface.>
349
350A sufficiently complicated module using XS would have both Perl code (defined
351in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). If this
352Perl code makes calls into this XS code, and/or this XS code makes calls to
353the Perl code, one should be careful with the order of initialization.
354
3a1b0858
NC
355The call to C<XSLoader::load()> (or C<bootstrap()>) calls the module's
356bootstrap code. For modules build by F<xsubpp> (nearly all modules) this
357has three side effects:
d7f44de2
IZ
358
359=over
360
361=item *
362
3a1b0858
NC
363A 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
365is used for the check. If not specified, it defaults to
366C<$XS_VERSION // $VERSION> (in the module's namespace)
d7f44de2
IZ
367
368=item *
369
3a1b0858 370the XSUBs are made accessible from Perl
d7f44de2
IZ
371
372=item *
373
4406dda9 374if a C<BOOT:> section was present in the F<.xs> file, the code there is called.
d7f44de2
IZ
375
376=back
377
4406dda9 378Consequently, if the code in the F<.pm> file makes calls to these XSUBs, it is
d7f44de2
IZ
379convenient to have XSUBs installed before the Perl code is defined; for
380example, this makes prototypes for XSUBs visible to this Perl code.
381Alternatively, if the C<BOOT:> section makes calls to Perl functions (or
4406dda9 382uses Perl variables) defined in the F<.pm> file, they must be defined prior to
11fd7d05 383the call to C<XSLoader::load()> (or C<bootstrap()>).
d7f44de2
IZ
384
385The first situation being much more frequent, it makes sense to rewrite the
386boilerplate 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
405If the interdependence of your C<BOOT:> section and Perl code is
406more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
407functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
11fd7d05 408section altogether. Replace it with a function C<onBOOT()>, and call it like
d7f44de2
IZ
409this:
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
11fd7d05
RGS
428
429=head1 DIAGNOSTICS
430
150e77ce 431=over
11fd7d05 432
150e77ce 433=item C<Can't find '%s' symbol in %s>
11fd7d05
RGS
434
435B<(F)> The bootstrap symbol could not be found in the extension module.
436
150e77ce 437=item C<Can't load '%s' for module %s: %s>
11fd7d05
RGS
438
439B<(F)> The loading or initialisation of the extension module failed.
440The detailed error follows.
441
150e77ce 442=item C<Undefined symbols present after loading %s: %s>
11fd7d05
RGS
443
444B<(W)> As the message says, some symbols stay undefined although the
445extension module was correctly loaded and initialised. The list of undefined
446symbols follows.
447
11fd7d05
RGS
448=back
449
d7f44de2
IZ
450=head1 LIMITATIONS
451
452To reduce the overhead as much as possible, only one possible location
453is checked to find the extension DLL (this location is where C<make install>
454would put the DLL). If not found, the search for the DLL is transparently
11fd7d05 455delegated to C<DynaLoader>, which looks for the DLL along the C<@INC> list.
d7f44de2 456
11fd7d05 457In particular, this is applicable to the structure of C<@INC> used for testing
4406dda9
RGS
458not-yet-installed extensions. This means that running uninstalled extensions
459may have much more overhead than running the same extensions after
d7f44de2
IZ
460C<make install>.
461
11fd7d05 462
e6ea8c3b
CBW
463=head1 KNOWN BUGS
464
465The new simpler way to call C<XSLoader::load()> with no arguments at all
466does not work on Perl 5.8.4 and 5.8.5.
467
468
11fd7d05
RGS
469=head1 BUGS
470
9c6b46e2 471Please report any bugs or feature requests via the perlbug(1) utility.
11fd7d05
RGS
472
473
474=head1 SEE ALSO
475
476L<DynaLoader>
477
478
9c6b46e2 479=head1 AUTHORS
9cf41c4d 480
11fd7d05
RGS
481Ilya Zakharevich originally extracted C<XSLoader> from C<DynaLoader>.
482
483CPAN version is currently maintained by SE<eacute>bastien Aperghis-Tramoni
150e77ce 484E<lt>sebastien@aperghis.netE<gt>.
11fd7d05 485
150e77ce 486Previous maintainer was Michael G Schwern <schwern@pobox.com>.
11fd7d05
RGS
487
488
73bf7552
AT
489=head1 COPYRIGHT & LICENSE
490
e6ea8c3b 491Copyright (C) 1990-2011 by Larry Wall and others.
11fd7d05
RGS
492
493This program is free software; you can redistribute it and/or modify
494it under the same terms as Perl itself.
9cf41c4d
GS
495
496=cut
497EOT
498
499close OUT or die $!;