Skip to content

Commit

Permalink
restructure _extract_inc(): always add XS DLLs in PAR_TEMP/inc to PAR…
Browse files Browse the repository at this point in the history 
…::Heavy::FullCache

ie. even if PAR_TEMP/inc already exists (hence we don't need to
extract the zip)
  • Loading branch information
@rschupp
rschupp committed Feb 11, 2024
1 parent e99bc92 commit df69850
Showing 1 changed file with 51 additions and 59 deletions.
110 changes: 51 additions & 59 deletions lib/PAR.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -328,7 +328,6 @@ use vars qw(@UpgradeRepositoryObjects); # If we have PAR::Repository::Client's
use vars qw(%FileCache); # The Zip-file file-name-cache
# Layout:
# $FileCache{$ZipObj}{$FileName} = $Member
use vars qw(%ArchivesExtracted); # Associates archive-zip-object => full extraction path

my $ver = $Config{version};
my $arch = $Config{archname};
Expand Down Expand Up @@ -391,11 +390,6 @@ sub import {
push @PAR_INC, unpar($progname, undef, undef, 1);

_extract_inc($progname);
if ($LibCache{$progname}) {
# XXX bad: this us just a good guess
require File::Spec;
$ArchivesExtracted{$progname} = File::Spec->catdir($ENV{PAR_TEMP}, 'inc');
}

my $zip = $LibCache{$progname};
my $member = _first_member( $zip,
Expand Down Expand Up @@ -678,53 +672,49 @@ sub _run_external_file {
# Archive::Zip handle to the PAR_TEMP/inc directory.
# returns that directory.
sub _extract_inc {
my $file_or_azip_handle = shift;
my $dlext = defined($Config{dlext}) ? $Config{dlext} : '';
my $is_handle = ref($file_or_azip_handle) && $file_or_azip_handle->isa('Archive::Zip::Archive');
my ($file_or_azip_handle) = @_;

require File::Spec;
my ($file, $zip);
if (ref($file_or_azip_handle) && $file_or_azip_handle->isa('Archive::Zip::Archive')) {
$file = $file_or_azip_handle->fileName();
$zip = $file_or_azip_handle;
}
else {
$file = $file_or_azip_handle;

# Temporarily increase Archive::Zip::ChunkSize so that we may find
# the EOCD even if stuff has been appended (e.g.by OSX codesign)
# to the zip/executable.
my $chunksize = Archive::Zip::chunkSize();
Archive::Zip::setChunkSize(-s $file);
$zip = Archive::Zip->new();
$zip->read($file) == AZ_OK or die qq[can't read zip file "$file"];
Archive::Zip::setChunkSize($chunksize);
}

require File::Spec;
my $dlext = defined($Config{dlext}) ? $Config{dlext} : '';
my $inc = File::Spec->catdir($PAR::SetupTemp::PARTemp, "inc");
my $inc_lock = "$inc.lock";

my $canary = File::Spec->catfile($PAR::SetupTemp::PARTemp, $PAR::SetupTemp::Canary);

# acquire the "wanna extract inc" lock
open my $lock, ">", $inc_lock or die qq[can't open "$inc_lock": $!];
flock($lock, LOCK_EX);

unless (-d $inc && -e $canary)
{
# acquire the "wanna extract inc" lock
my $inc_lock = "$inc.lock";
open my $lock, ">", $inc_lock or die qq[can't open "$inc_lock": $!];
flock($lock, LOCK_EX);

mkdir($inc, 0755);

EXTRACT: {
my $zip;
if ($is_handle) {
$zip = $file_or_azip_handle;
} else {
# First try to unzip the *fast* way.
eval {
require Archive::Unzip::Burst;
Archive::Unzip::Burst::unzip($file_or_azip_handle, $inc) == AZ_OK;
} and last EXTRACT;

# Either failed to load Archive::Unzip::Burst or
# Archive::Unzip::Burst::unzip failed: fallback to slow way.
open my $fh, '<', $file_or_azip_handle
or die "Cannot find '$file_or_azip_handle': $!";
binmode($fh);
bless($fh, 'IO::File');

# Temporarily increase Archive::Zip::ChunkSize so that we may find
# the EOCD even if stuff has been appended (e.g.by OSX codesign)
# to the zip/executable.
Archive::Zip::setChunkSize(-s $fh);
$zip = Archive::Zip->new;
$zip->readFromFileHandle($fh, $file_or_azip_handle) == AZ_OK
or die "Read '$file_or_azip_handle' error: $!";
Archive::Zip::setChunkSize(64 * 1024);
}

# First try to unzip the *fast* way.
eval {
require Archive::Unzip::Burst;
Archive::Unzip::Burst::unzip($file_or_azip_handle, $inc) == AZ_OK;
} and last EXTRACT;

# Either failed to load Archive::Unzip::Burst or
# Archive::Unzip::Burst::unzip failed: fallback to slow way.
foreach my $name ($zip->memberNames()) {
$name =~ s{^/}{};
my $outfile = File::Spec->catfile($inc, $name);
Expand All @@ -735,15 +725,9 @@ sub _extract_inc {
# it to "now" (making it younger than the canary file).
utime(undef, undef, $outfile);

if (my ($xs_dll) = $name =~ m{^lib/(auto/.*\.\Q$dlext\E)$}) {
$PAR::Heavy::FullCache{$outfile} = $xs_dll;
$PAR::Heavy::FullCache{$xs_dll} = $outfile;
}
}
}

$ArchivesExtracted{$is_handle ? $file_or_azip_handle->fileName() : $file_or_azip_handle} = $inc;

# touch (and back-date) canary file
open my $fh, ">", $canary;
print $fh <<'...';
Expand All @@ -754,20 +738,28 @@ mechanism (probably based on file modification times).
close $fh;
my $dateback = time() - $PAR::SetupTemp::CanaryDateBack;
utime($dateback, $dateback, $canary);
}

# release the "wanna extract inc" lock
flock($lock, LOCK_UN);
close $lock;
# release the "wanna extract inc" lock
flock($lock, LOCK_UN);
close $lock;
}

# add the freshly extracted directories to @INC,
# Add the existing perl module directories to @INC,
# but make sure there's no duplicates
my %inc_exists = map { ($_, 1) } @INC;
unshift @INC, grep !exists($inc_exists{$_}),
grep -d,
map File::Spec->catdir($inc, @$_),
[ 'lib' ], [ 'arch' ], [ $arch ],
[ $ver ], [ $ver, $arch ], [];
unshift @INC, grep { !exists($inc_exists{$_}) && -d $_ }
map { File::Spec->catdir($inc, @$_) }
[ 'lib' ], [ 'arch' ], [ $arch ], [ $ver ], [ $ver, $arch ], [];

# Add all XS DLLs to $PAR::Heavy::FullCache
foreach my $name ($zip->memberNames()) {
$name =~ s{^/}{};
if (my ($xs_dll) = $name =~ m{/(auto/.*\.\Q$dlext\E)$}) {
my $outfile = File::Spec->catfile($inc, $name);
$PAR::Heavy::FullCache{$outfile} = $xs_dll;
$PAR::Heavy::FullCache{$xs_dll} = $outfile;
}
}

return $inc;
}
Expand Down

0 comments on commit df69850

Please sign in to comment.