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