Sat Feb 13 03:37:38 2010: Request 42986 was acted upon.
Transaction: Correspondence added by TJC
Queue: PAR
Subject: PAR-based modules use system XS modules over included modules
Broken in: 0.984
Severity: Important
Owner: Nobody
Requestors: t...@cpan.org
Status: open
Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=42986 >
On Fri Feb 12 05:41:41 2010, RSCHUPP wrote:
> On Thu Feb 11 21:28:56 2010, TJC wrote:
> > I tried 'strace'ing the executable, and noticed:
>
> Yeah, the strace shows that .so's (but not corresponding .pm's)
> are still searched using the built-in @INC.
> This rings a bell, but I can't pin it yet.
>
> This is Perl 5.10.0, right?
Correct.
> After using extract-embedded.pl on your executable
> please post the extracted XSLoader.pm and PAR/Heavy.pm
Attached.
#line 1 "/home/tobyc/perl/lib/i486-linux-gnu-thread-multi/XSLoader.pm"
# Generated from XSLoader.pm.PL (resolved %Config::Config value)
package XSLoader;
$VERSION = "0.10";
#use strict;
# enable debug/trace messages from DynaLoader perl code
# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
my $dl_dlext = 'so';
package DynaLoader;
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
!defined(&dl_error);
package XSLoader;
sub load {
package DynaLoader;
die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_;
my($module) = $_[0];
# work with static linking too
my $boots = "$module\::bootstrap";
goto &$boots if defined &$boots;
goto retry;
my @modparts = split(/::/,$module);
my $modfname = $modparts[-1];
my $modpname = join('/',@modparts);
my $modlibname = (caller())[1];
my $c = @modparts;
$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
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;
@DynaLoader::dl_require_symbols = ($bootname);
my $boot_symbol_ref;
# 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
# C code of the extension XS file. Perl reports the error as being
# in this perl code simply because this was the last perl code
# it executed.
my $libref = dl_load_file($file, 0) or do {
require Carp;
Carp::croak("Can't load '$file' for module $module: " . dl_error());
};
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");
}
$boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
require Carp;
Carp::croak("Can't find '$bootname' symbol in $file\n");
};
push(@DynaLoader::dl_modules, $module); # record loaded module
boot:
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;
DynaLoader::bootstrap(@_);
}
1;
__END__
#line 359
#line 1 "/home/tobyc/perl/lib/PAR/Heavy.pm"
package PAR::Heavy;
$PAR::Heavy::VERSION = '0.11';
#line 17
########################################################################
# Dynamic inclusion of XS modules
my ($bootstrap, $dl_findfile); # Caches for code references
my ($dlext); # Cache for $Config{dlext}
my ($cache_key); # The current file to find
my $is_insensitive_fs = (
-s $0
and (-s lc($0) || -1) == (-s uc($0) || -1)
and (-s lc($0) || -1) == -s $0
);
# Adds pre-hooks to Dynaloader's key methods
sub _init_dynaloader {
return if $bootstrap;
return unless eval { require DynaLoader; DynaLoader::dl_findfile(); 1 };
$bootstrap = \&DynaLoader::bootstrap;
$dl_findfile = \&DynaLoader::dl_findfile;
local $^W;
*{'DynaLoader::dl_expandspec'} = sub { return };
*{'DynaLoader::bootstrap'} = \&_bootstrap;
*{'DynaLoader::dl_findfile'} = \&_dl_findfile;
}
# Return the cached location of .dll inside PAR first, if possible.
sub _dl_findfile {
return $FullCache{$cache_key} if exists $FullCache{$cache_key};
if ($is_insensitive_fs) {
# We have a case-insensitive filesystem...
my ($key) = grep { lc($_) eq lc($cache_key) } keys %FullCache;
return $FullCache{$key} if defined $key;
}
return $dl_findfile->(@_);
}
# Find and extract .dll from PAR files for a given dynamic module.
sub _bootstrap {
my (@args) = @_;
my ($module) = $args[0] or return;
my @modparts = split(/::/, $module);
my $modfname = $modparts[-1];
$modfname = &DynaLoader::mod2fname(\...@modparts)
if defined &DynaLoader::mod2fname;
if (($^O eq 'NetWare') && (length($modfname) > 8)) {
$modfname = substr($modfname, 0, 8);
}
# XXX: Multi-platform .dll support in PARs needs better than $Config.
# FIXME: Config is always loaded by PAR.pm!
$dlext ||= do {
require Config;
(defined %Config::Config) ? $Config::Config{dlext} : '';
};
my $modpname = join((($^O eq 'MacOS') ? ':' : '/'), @modparts);
my $file = $cache_key = "auto/$modpname/$modfname.$dlext";
if ($FullCache{$file}) {
# TODO: understand
local $DynaLoader::do_expand = 1;
return $bootstrap->(@args);
}
my $member;
# First, try to find things in the peferentially loaded PARs:
$member = PAR::_find_par_internals([...@par::PAR_INC], undef, $file, 1)
if defined &PAR::_find_par_internals;
# If that failed to find the dll, let DynaLoader (try or) throw an error
unless ($member) {
my $filename = eval { $bootstrap->(@args) };
return $filename if not $@ and defined $filename;
# Now try the fallback pars
$member = PAR::_find_par_internals([...@par::PAR_INC_LAST], undef, $file, 1)
if defined &PAR::_find_par_internals;
# If that fails, let dynaloader have another go JUST to throw an error
# While this may seem wasteful, nothing really matters once we fail to
# load shared libraries!
unless ($member) {
return $bootstrap->(@args);
}
}
$FullCache{$file} = _dl_extract($member, $file);
# Now extract all associated shared objs in the same auto/ dir
# XXX: shouldn't this also set $FullCache{...} for those files?
my $first = $member->fileName;
my $path_pattern = $first;
$path_pattern =~ s{[^/]*$}{};
if ($PAR::LastAccessedPAR) {
foreach my $member ( $PAR::LastAccessedPAR->members ) {
next if $member->isDirectory;
my $name = $member->fileName;
next if $name eq $first;
next unless $name =~ m{^/?\Q$path_pattern\E\/[^/]*\.\Q$dlext\E[^/]*$};
$name =~ s{.*/}{};
_dl_extract($member, $file, $name);
}
}
local $DynaLoader::do_expand = 1;
return $bootstrap->(@args);
}
sub _dl_extract {
my ($member, $file, $name) = @_;
require File::Spec;
require File::Temp;
my ($fh, $filename);
# fix borked tempdir from earlier versions
if ($ENV{PAR_TEMP} and -e $ENV{PAR_TEMP} and !-d $ENV{PAR_TEMP}) {
unlink($ENV{PAR_TEMP});
mkdir($ENV{PAR_TEMP}, 0755);
}
if ($ENV{PAR_CLEAN} and !$name) {
($fh, $filename) = File::Temp::tempfile(
DIR => ($ENV{PAR_TEMP} || File::Spec->tmpdir),
SUFFIX => ".$dlext",
UNLINK => ($^O ne 'MSWin32' and $^O !~ /hpux/),
);
($filename) = $filename =~ /^([\x20-\xff]+)$/;
}
else {
$filename = File::Spec->catfile(
($ENV{PAR_TEMP} || File::Spec->tmpdir),
($name || ($member->crc32String . ".$dlext"))
);
($filename) = $filename =~ /^([\x20-\xff]+)$/;
open $fh, '>', $filename or die $!
unless -r $filename and -e _
and -s _ == $member->uncompressedSize;
}
if ($fh) {
binmode($fh);
$member->extractToFileHandle($fh);
close $fh;
chmod 0755, $filename;
}
return $filename;
}
1;
#line 205
