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