1use Config; 2 3sub to_string { 4 my ($value) = @_; 5 $value =~ s/\\/\\\\/g; 6 $value =~ s/'/\\'/g; 7 return "'$value'"; 8} 9 10unlink "XSLoader.pm" if -f "XSLoader.pm"; 11open OUT, ">XSLoader.pm" or die $!; 12print OUT <<'EOT'; 13# Generated from XSLoader.pm.PL (resolved %Config::Config value) 14 15package XSLoader; 16 17$VERSION = "0.02"; 18 19# enable debug/trace messages from DynaLoader perl code 20# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; 21 22EOT 23 24print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ; 25 26print OUT <<'EOT'; 27 28package DynaLoader; 29 30# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. 31# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB 32boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && 33 !defined(&dl_error); 34package XSLoader; 35 36sub load { 37 package DynaLoader; 38 39 die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_; 40 41 my($module) = $_[0]; 42 43 # work with static linking too 44 my $b = "$module\::bootstrap"; 45 goto &$b if defined &$b; 46 47 goto retry unless $module and defined &dl_load_file; 48 49 my @modparts = split(/::/,$module); 50 my $modfname = $modparts[-1]; 51 52EOT 53 54print OUT <<'EOT' if defined &DynaLoader::mod2fname; 55 # Some systems have restrictions on files names for DLL's etc. 56 # mod2fname returns appropriate file base name (typically truncated) 57 # It may also edit @modparts if required. 58 $modfname = &mod2fname(\@modparts) if defined &mod2fname; 59 60EOT 61 62print OUT <<'EOT'; 63 my $modpname = join('/',@modparts); 64 my $modlibname = (caller())[1]; 65 my $c = @modparts; 66 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename 67 my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext"; 68 69# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; 70 71 my $bs = $file; 72 $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library 73 74 goto retry if not -f $file or -s $bs; 75 76 my $bootname = "boot_$module"; 77 $bootname =~ s/\W/_/g; 78 @dl_require_symbols = ($bootname); 79 80 my $boot_symbol_ref; 81 82 if ($^O eq 'darwin') { 83 if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) { 84 goto boot; #extension library has already been loaded, e.g. darwin 85 } 86 } 87 88 # Many dynamic extension loading problems will appear to come from 89 # this section of code: XYZ failed at line 123 of DynaLoader.pm. 90 # Often these errors are actually occurring in the initialisation 91 # C code of the extension XS file. Perl reports the error as being 92 # in this perl code simply because this was the last perl code 93 # it executed. 94 95 my $libref = dl_load_file($file, 0) or do { 96 require Carp; 97 Carp::croak("Can't load '$file' for module $module: " . dl_error()); 98 }; 99 push(@dl_librefs,$libref); # record loaded object 100 101 my @unresolved = dl_undef_symbols(); 102 if (@unresolved) { 103 require Carp; 104 Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); 105 } 106 107 $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { 108 require Carp; 109 Carp::croak("Can't find '$bootname' symbol in $file\n"); 110 }; 111 112 push(@dl_modules, $module); # record loaded module 113 114 boot: 115 my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); 116 117 # See comment block above 118 return &$xs(@_); 119 120 retry: 121 require DynaLoader; 122 goto &DynaLoader::bootstrap_inherit; 123} 124 1251; 126 127__END__ 128 129=head1 NAME 130 131XSLoader - Dynamically load C libraries into Perl code 132 133=head1 SYNOPSIS 134 135 package YourPackage; 136 use XSLoader; 137 138 XSLoader::load 'YourPackage', $YourPackage::VERSION; 139 140=head1 DESCRIPTION 141 142This module defines a standard I<simplified> interface to the dynamic 143linking mechanisms available on many platforms. Its primary purpose is 144to implement cheap automatic dynamic loading of Perl modules. 145 146For more complicated interface see L<DynaLoader>. Many (most) 147features of DynaLoader are not implemented in XSLoader, like for 148example the dl_load_flags is not honored by XSLoader. 149 150=head2 Migration from C<DynaLoader> 151 152A typical module using L<DynaLoader|DynaLoader> starts like this: 153 154 package YourPackage; 155 require DynaLoader; 156 157 our @ISA = qw( OnePackage OtherPackage DynaLoader ); 158 our $VERSION = '0.01'; 159 bootstrap YourPackage $VERSION; 160 161Change this to 162 163 package YourPackage; 164 use XSLoader; 165 166 our @ISA = qw( OnePackage OtherPackage ); 167 our $VERSION = '0.01'; 168 XSLoader::load 'YourPackage', $VERSION; 169 170In other words: replace C<require DynaLoader> by C<use XSLoader>, remove 171C<DynaLoader> from @ISA, change C<bootstrap> by C<XSLoader::load>. Do not 172forget to quote the name of your package on the C<XSLoader::load> line, 173and add comma (C<,>) before the arguments ($VERSION above). 174 175Of course, if @ISA contained only C<DynaLoader>, there is no need to have the 176@ISA assignment at all; moreover, if instead of C<our> one uses 177backward-compatible 178 179 use vars qw($VERSION @ISA); 180 181one can remove this reference to @ISA together with the @ISA assignment 182 183If no $VERSION was specified on the C<bootstrap> line, the last line becomes 184 185 XSLoader::load 'YourPackage'; 186 187=head2 Backward compatible boilerplate 188 189If you want to have your cake and eat it too, you need a more complicated 190boilerplate. 191 192 package YourPackage; 193 use vars qw($VERSION @ISA); 194 195 @ISA = qw( OnePackage OtherPackage ); 196 $VERSION = '0.01'; 197 eval { 198 require XSLoader; 199 XSLoader::load('YourPackage', $VERSION); 200 1; 201 } or do { 202 require DynaLoader; 203 push @ISA, 'DynaLoader'; 204 bootstrap YourPackage $VERSION; 205 }; 206 207The parentheses about XSLoader::load() arguments are needed since we replaced 208C<use XSLoader> by C<require>, so the compiler does not know that a function 209XSLoader::load() is present. 210 211This boilerplate uses the low-overhead C<XSLoader> if present; if used with 212an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>. 213 214=head1 Order of initialization: early load() 215 216I<Skip this section if the XSUB functions are supposed to be called from other 217modules only; read it only if you call your XSUBs from the code in your module, 218or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">). 219What is described here is equally applicable to L<DynaLoader|DynaLoader> 220interface.> 221 222A sufficiently complicated module using XS would have both Perl code (defined 223in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). If this 224Perl code makes calls into this XS code, and/or this XS code makes calls to 225the Perl code, one should be careful with the order of initialization. 226 227The call to XSLoader::load() (or bootstrap()) has three side effects: 228 229=over 230 231=item * 232 233if $VERSION was specified, a sanity check is done to insure that the versions 234of the F<.pm> and the (compiled) F<.xs> parts are compatible; 235 236=item * 237 238The XSUBs are made accessible from Perl; 239 240=item * 241 242If the C<BOOT:> section was present in F<.xs> file, the code there is called. 243 244=back 245 246Consequently, if the code in F<.pm> file makes calls to these XSUBs, it is 247convenient to have XSUBs installed before the Perl code is defined; for 248example, this makes prototypes for XSUBs visible to this Perl code. 249Alternatively, if the C<BOOT:> section makes calls to Perl functions (or 250uses Perl variables) defined in F<.pm> file, they must be defined prior to 251the call to XSLoader::load() (or bootstrap()). 252 253The first situation being much more frequent, it makes sense to rewrite the 254boilerplate as 255 256 package YourPackage; 257 use XSLoader; 258 use vars qw($VERSION @ISA); 259 260 BEGIN { 261 @ISA = qw( OnePackage OtherPackage ); 262 $VERSION = '0.01'; 263 264 # Put Perl code used in the BOOT: section here 265 266 XSLoader::load 'YourPackage', $VERSION; 267 } 268 269 # Put Perl code making calls into XSUBs here 270 271=head2 The most hairy case 272 273If the interdependence of your C<BOOT:> section and Perl code is 274more complicated than this (e.g., the C<BOOT:> section makes calls to Perl 275functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:> 276section altogether. Replace it with a function onBOOT(), and call it like 277this: 278 279 package YourPackage; 280 use XSLoader; 281 use vars qw($VERSION @ISA); 282 283 BEGIN { 284 @ISA = qw( OnePackage OtherPackage ); 285 $VERSION = '0.01'; 286 XSLoader::load 'YourPackage', $VERSION; 287 } 288 289 # Put Perl code used in onBOOT() function here; calls to XSUBs are 290 # prototype-checked. 291 292 onBOOT; 293 294 # Put Perl initialization code assuming that XS is initialized here 295 296=head1 LIMITATIONS 297 298To reduce the overhead as much as possible, only one possible location 299is checked to find the extension DLL (this location is where C<make install> 300would put the DLL). If not found, the search for the DLL is transparently 301delegated to C<DynaLoader>, which looks for the DLL along the @INC list. 302 303In particular, this is applicable to the structure of @INC used for testing 304not-yet-installed extensions. This means that the overhead of running 305uninstalled extension may be much more than running the same extension after 306C<make install>. 307 308=head1 AUTHOR 309 310Ilya Zakharevich: extraction from DynaLoader. 311 312=cut 313EOT 314 315close OUT or die $!; 316 317