X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2FXSLoader_pm.PL;h=a258f6ea51a2ca4a65d590a33b4d51f01c48ecee;hb=12c541f435c0fde6414e8942d051e05098e0253e;hp=9f3aaed83cc22833d2527e95c81d89ec413b38ec;hpb=d7f44de216e72597099819403690905e87b0a15f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL index 9f3aaed..a258f6e 100644 --- a/ext/DynaLoader/XSLoader_pm.PL +++ b/ext/DynaLoader/XSLoader_pm.PL @@ -1,3 +1,4 @@ +use strict; use Config; sub to_string { @@ -7,26 +8,16 @@ sub to_string { return "'$value'"; } -unlink "XSLoader.pm" if -f "XSLoader.pm"; +1 while unlink "XSLoader.pm"; open OUT, ">XSLoader.pm" or die $!; print OUT <<'EOT'; # Generated from XSLoader.pm.PL (resolved %Config::Config value) package XSLoader; -# And Gandalf said: 'Many folk like to know beforehand what is to -# be set on the table; but those who have laboured to prepare the -# feast like to keep their secret; for wonder makes the words of -# praise louder.' +$VERSION = "0.10"; -# (Quote from Tolkien sugested by Anno Siegel.) -# -# See pod text at end of file for documentation. -# See also ext/DynaLoader/README in source tree for other information. -# -# Tim.Bunce@ig.co.uk, August 1994 - -$VERSION = "0.01"; # avoid typo warning +#use strict; # enable debug/trace messages from DynaLoader perl code # $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; @@ -45,19 +36,16 @@ boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && !defined(&dl_error); package XSLoader; -1; # End of main code - -# The bootstrap function cannot be autoloaded (without complications) -# so we define it here: - sub load { package DynaLoader; + die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_; + my($module) = $_[0]; # work with static linking too - my $b = "$module\::bootstrap"; - goto &$b if defined &$b; + my $boots = "$module\::bootstrap"; + goto &$boots if defined &$boots; goto retry unless $module and defined &dl_load_file; @@ -74,6 +62,13 @@ print OUT <<'EOT' if defined &DynaLoader::mod2fname; EOT +print OUT <<'EOT' if $^O eq 'os2'; + + # os2 static build can dynaload, but cannot dynaload Perl modules... + die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static; + +EOT + print OUT <<'EOT'; my $modpname = join('/',@modparts); my $modlibname = (caller())[1]; @@ -86,20 +81,31 @@ print OUT <<'EOT'; my $bs = $file; $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library + if (-s $bs) { # only read file if it's not empty +# print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug; + eval { do $bs; }; + warn "$bs: $@\n" if $@; + } + goto retry if not -f $file or -s $bs; my $bootname = "boot_$module"; $bootname =~ s/\W/_/g; - @dl_require_symbols = ($bootname); + @DynaLoader::dl_require_symbols = ($bootname); my $boot_symbol_ref; +EOT + if ($^O eq 'darwin') { +print OUT <<'EOT'; if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) { goto boot; #extension library has already been loaded, e.g. darwin } +EOT } +print OUT <<'EOT'; # Many dynamic extension loading problems will appear to come from # this section of code: XYZ failed at line 123 of DynaLoader.pm. # Often these errors are actually occurring in the initialisation @@ -108,47 +114,68 @@ print OUT <<'EOT'; # it executed. my $libref = dl_load_file($file, 0) or do { - require Carp; - Carp::croak("Can't load '$file' for module $module: " . dl_error()); + require Carp; + Carp::croak("Can't load '$file' for module $module: " . dl_error()); }; - push(@dl_librefs,$libref); # record loaded object + push(@DynaLoader::dl_librefs,$libref); # record loaded object my @unresolved = dl_undef_symbols(); if (@unresolved) { - require Carp; - Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); + require Carp; + Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); } $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { - require Carp; - Carp::croak("Can't find '$bootname' symbol in $file\n"); + require Carp; + Carp::croak("Can't find '$bootname' symbol in $file\n"); }; - push(@dl_modules, $module); # record loaded module + push(@DynaLoader::dl_modules, $module); # record loaded module boot: - my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + my $xs = dl_install_xsub($boots, $boot_symbol_ref, $file); # See comment block above + push(@DynaLoader::dl_shared_objects, $file); # record files loaded return &$xs(@_); retry: + my $bootstrap_inherit = DynaLoader->can('bootstrap_inherit') || + XSLoader->can('bootstrap_inherit'); + goto &$bootstrap_inherit; +} + +# Versions of DynaLoader prior to 5.6.0 don't have this function. +sub bootstrap_inherit { + package DynaLoader; + + my $module = $_[0]; + local *DynaLoader::isa = *{"$module\::ISA"}; + local @DynaLoader::isa = (@DynaLoader::isa, 'DynaLoader'); + # Cannot goto due to delocalization. Will report errors on a wrong line? require DynaLoader; - goto &DynaLoader::bootstrap_inherit; + DynaLoader::bootstrap(@_); } +1; + + __END__ =head1 NAME XSLoader - Dynamically load C libraries into Perl code +=head1 VERSION + +Version 0.10 + =head1 SYNOPSIS package YourPackage; use XSLoader; - XSLoader::load 'YourPackage', @args; + XSLoader::load 'YourPackage', $YourPackage::VERSION; =head1 DESCRIPTION @@ -156,9 +183,9 @@ This module defines a standard I interface to the dynamic linking mechanisms available on many platforms. Its primary purpose is to implement cheap automatic dynamic loading of Perl modules. -For more complicated interface see L. Many (most) -features of DynaLoader are not implemented in XSLoader, like for -example the dl_load_flags is not honored by XSLoader. +For a more complicated interface, see L. Many (most) +features of C are not implemented in C, like for +example the C, not honored by C. =head2 Migration from C @@ -181,19 +208,19 @@ Change this to XSLoader::load 'YourPackage', $VERSION; In other words: replace C by C, remove -C from @ISA, change C by C. Do not +C from C<@ISA>, change C by C. Do not forget to quote the name of your package on the C line, -and add comma (C<,>) before the arguments ($VERSION above). +and add comma (C<,>) before the arguments (C<$VERSION> above). -Of course, if @ISA contained only C, there is no need to have the -@ISA assignment at all; moreover, if instead of C one uses -backward-compatible +Of course, if C<@ISA> contained only C, there is no need to have +the C<@ISA> assignment at all; moreover, if instead of C one uses the +more backward-compatible use vars qw($VERSION @ISA); -one can remove this reference to @ISA together with the @ISA assignment +one can remove this reference to C<@ISA> together with the C<@ISA> assignment. -If no $VERSION was specified on the C line, the last line becomes +If no C<$VERSION> was specified on the C line, the last line becomes XSLoader::load 'YourPackage'; @@ -217,9 +244,9 @@ boilerplate. bootstrap YourPackage $VERSION; }; -The parentheses about XSLoader::load() arguments are needed since we replaced +The parentheses about C arguments are needed since we replaced C by C, so the compiler does not know that a function -XSLoader::load() is present. +C is present. This boilerplate uses the low-overhead C if present; if used with an antic Perl which has no C, it falls back to using C. @@ -229,7 +256,7 @@ an antic Perl which has no C, it falls back to using C. I section in your XS file (see L). -What is described here is equally applicable to L +What is described here is equally applicable to the L interface.> A sufficiently complicated module using XS would have both Perl code (defined @@ -237,31 +264,31 @@ in F) and XS code (defined in F). If this Perl code makes calls into this XS code, and/or this XS code makes calls to the Perl code, one should be careful with the order of initialization. -The call to XSLoader::load() (or bootstrap()) has three side effects: +The call to C (or C) has three side effects: =over =item * -if $VERSION was specified, a sanity check is done to insure that the versions -of the F<.pm> and the (compiled) F<.xs> parts are compatible; +if C<$VERSION> was specified, a sanity check is done to ensure that the +versions of the F<.pm> and the (compiled) F<.xs> parts are compatible; =item * -The XSUBs are made accessible from Perl; +the XSUBs are made accessible from Perl; =item * -If the C section was present in F<.xs> file, the code there is called. +if a C section was present in the F<.xs> file, the code there is called. =back -Consequently, if the code in F<.pm> file makes calls to these XSUBs, it is +Consequently, if the code in the F<.pm> file makes calls to these XSUBs, it is convenient to have XSUBs installed before the Perl code is defined; for example, this makes prototypes for XSUBs visible to this Perl code. Alternatively, if the C section makes calls to Perl functions (or -uses Perl variables) defined in F<.pm> file, they must be defined prior to -the call to XSLoader::load() (or bootstrap()). +uses Perl variables) defined in the F<.pm> file, they must be defined prior to +the call to C (or C). The first situation being much more frequent, it makes sense to rewrite the boilerplate as @@ -286,7 +313,7 @@ boilerplate as If the interdependence of your C section and Perl code is more complicated than this (e.g., the C section makes calls to Perl functions which make calls to XSUBs with prototypes), get rid of the C -section altogether. Replace it with a function onBOOT(), and call it like +section altogether. Replace it with a function C, and call it like this: package YourPackage; @@ -306,24 +333,75 @@ this: # Put Perl initialization code assuming that XS is initialized here + +=head1 DIAGNOSTICS + +=over + +=item C + +B<(F)> The bootstrap symbol could not be found in the extension module. + +=item C + +B<(F)> The loading or initialisation of the extension module failed. +The detailed error follows. + +=item C + +B<(W)> As the message says, some symbols stay undefined although the +extension module was correctly loaded and initialised. The list of undefined +symbols follows. + +=item C + +B<(F)> You tried to invoke C without any argument. You must supply +a module name, and optionally its version. + +=back + + =head1 LIMITATIONS To reduce the overhead as much as possible, only one possible location is checked to find the extension DLL (this location is where C would put the DLL). If not found, the search for the DLL is transparently -delegated to C, which looks for the DLL along the @INC list. +delegated to C, which looks for the DLL along the C<@INC> list. -In particular, this is applicable to the structure of @INC used for testing -not-yet-installed extensions. This means that the overhead of running -uninstalled extension may be much more than running the same extension after +In particular, this is applicable to the structure of C<@INC> used for testing +not-yet-installed extensions. This means that running uninstalled extensions +may have much more overhead than running the same extensions after C. -=head1 AUTHOR -Ilya Zakharevich: extraction from DynaLoader. +=head1 BUGS + +Please report any bugs or feature requests via the perlbug(1) utility. + + +=head1 SEE ALSO + +L + + +=head1 AUTHORS + +Ilya Zakharevich originally extracted C from C. + +CPAN version is currently maintained by SEbastien Aperghis-Tramoni +Esebastien@aperghis.netE. + +Previous maintainer was Michael G Schwern . + + +=head1 COPYRIGHT & LICENSE + +Copyright (C) 1990-2007 by Larry Wall and others. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. =cut EOT close OUT or die $!; -