Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-PAR-Packer for openSUSE:Factory
checked in at 2021-01-15 19:46:10
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-PAR-Packer (Old)
and /work/SRC/openSUSE:Factory/.perl-PAR-Packer.new.28504 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-PAR-Packer"
Fri Jan 15 19:46:10 2021 rev:18 rq:863110 version:1.052
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-PAR-Packer/perl-PAR-Packer.changes
2020-12-01 14:24:01.945674182 +0100
+++
/work/SRC/openSUSE:Factory/.perl-PAR-Packer.new.28504/perl-PAR-Packer.changes
2021-01-15 19:46:11.982019269 +0100
@@ -1,0 +2,20 @@
+Thu Jan 14 03:10:18 UTC 2021 - Tina M??ller <timueller+p...@suse.de>
+
+- updated to 1.052
+ see /usr/share/doc/packages/perl-PAR-Packer/Changes
+
+ 1.052 2021-01-13
+ - add note that --filter and __DATA__ are incompatible (cf. #36, #39)
+ - change bugtracker to GitHub issues
+ - when embedding FILEs, normalize paths in @INC
+ - code cleanup:
+ - rename _tempfile() to _save_as()
+ - there is no $PAR::Heavy::ModuleCache, so make it a "my" variable
+ - consistent formatting in outs() calls
+ - demystify reading <$fh> with $/ = \$number: use "read $fh, $buf,
$number" instead
+ - use "open $fh, '<:raw', ..." instead of "open $fh, '<', ...;
binmode($fh);"
+ - make error messages more consistent
+ - make extract-embedded.pl more robust
+ - t/90-rt129312.t fails when Archive::Unzip::Burst is used
+
+-------------------------------------------------------------------
Old:
----
PAR-Packer-1.051.tar.gz
New:
----
PAR-Packer-1.052.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-PAR-Packer.spec ++++++
--- /var/tmp/diff_new_pack.Mk64Om/_old 2021-01-15 19:46:12.638020246 +0100
+++ /var/tmp/diff_new_pack.Mk64Om/_new 2021-01-15 19:46:12.642020251 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-PAR-Packer
#
-# Copyright (c) 2020 SUSE LLC
+# Copyright (c) 2021 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -16,17 +16,15 @@
#
+%define cpan_name PAR-Packer
Name: perl-PAR-Packer
-Version: 1.051
+Version: 1.052
Release: 0
-%define cpan_name PAR-Packer
Summary: PAR Packager
License: Artistic-1.0 OR GPL-1.0-or-later
-Group: Development/Libraries/Perl
URL: https://metacpan.org/release/%{cpan_name}
Source0:
https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/%{cpan_name}-%{version}.tar.gz
Source1: cpanspec.yml
-BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
BuildRequires: perl(Archive::Zip) >= 1.02
@@ -67,7 +65,7 @@
compiler.
%prep
-%setup -q -n %{cpan_name}-%{version}
+%autosetup -n %{cpan_name}-%{version}
find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path
"*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644
%build
@@ -84,7 +82,6 @@
%perl_gen_filelist
%files -f %{name}.files
-%defattr(-,root,root,755)
%doc AUTHORS Changes README
%license LICENSE
++++++ PAR-Packer-1.051.tar.gz -> PAR-Packer-1.052.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/Changes new/PAR-Packer-1.052/Changes
--- old/PAR-Packer-1.051/Changes 2020-11-29 23:04:15.000000000 +0100
+++ new/PAR-Packer-1.052/Changes 2021-01-13 16:09:20.000000000 +0100
@@ -1,3 +1,23 @@
+1.052 2021-01-13
+
+- add note that --filter and __DATA__ are incompatible (cf. #36, #39)
+
+- change bugtracker to GitHub issues
+
+- when embedding FILEs, normalize paths in @INC
+
+- code cleanup:
+ - rename _tempfile() to _save_as()
+ - there is no $PAR::Heavy::ModuleCache, so make it a "my" variable
+ - consistent formatting in outs() calls
+ - demystify reading <$fh> with $/ = \$number: use "read $fh, $buf,
$number" instead
+ - use "open $fh, '<:raw', ..." instead of "open $fh, '<', ...;
binmode($fh);"
+ - make error messages more consistent
+
+- make extract-embedded.pl more robust
+
+- t/90-rt129312.t fails when Archive::Unzip::Burst is used
+
1.051 2020-11-29
- Fix #27: "pp -u broken in perl 5.32"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/META.json
new/PAR-Packer-1.052/META.json
--- old/PAR-Packer-1.051/META.json 2020-11-29 23:22:00.000000000 +0100
+++ new/PAR-Packer-1.052/META.json 2021-01-13 16:42:10.000000000 +0100
@@ -69,7 +69,7 @@
"release_status" : "stable",
"resources" : {
"bugtracker" : {
- "web" : "https://rt.cpan.org/Dist/Display.html?Queue=PAR-Packer";
+ "web" : "https://github.com/rschupp/PAR-Packer/issues";
},
"repository" : {
"type" : "git",
@@ -78,6 +78,6 @@
},
"x_MailingList" : "mailto:p...@perl.org";
},
- "version" : "1.051",
+ "version" : "1.052",
"x_serialization_backend" : "JSON::PP version 4.05"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/META.yml
new/PAR-Packer-1.052/META.yml
--- old/PAR-Packer-1.051/META.yml 2020-11-29 23:22:00.000000000 +0100
+++ new/PAR-Packer-1.052/META.yml 2021-01-13 16:42:10.000000000 +0100
@@ -46,7 +46,7 @@
perl: '5.008009'
resources:
MailingList: mailto:p...@perl.org
- bugtracker: https://rt.cpan.org/Dist/Display.html?Queue=PAR-Packer
+ bugtracker: https://github.com/rschupp/PAR-Packer/issues
repository: git://github.com/rschupp/PAR-Packer.git
-version: '1.051'
+version: '1.052'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/Makefile.PL
new/PAR-Packer-1.052/Makefile.PL
--- old/PAR-Packer-1.051/Makefile.PL 2020-03-08 23:54:55.000000000 +0100
+++ new/PAR-Packer-1.052/Makefile.PL 2021-01-13 14:56:15.000000000 +0100
@@ -97,7 +97,7 @@
web => 'https://github.com/rschupp/PAR-Packer',
},
MailingList => 'mailto:p...@perl.org',
- bugtracker => { web =>
'https://rt.cpan.org/Dist/Display.html?Queue=PAR-Packer' },
+ bugtracker => { web => 'https://github.com/rschupp/PAR-Packer/issues'
},
},
no_index => {
directory => [ 'contrib' ],
@@ -108,8 +108,8 @@
# inhibit parallel make as modules must be installed into blib *before*
# recursing into myldr (i.e. target pm_to_blib must have finished
# before subdirs is started)
-sub MY::postamble
-{
+sub MY::postamble
+{
return <<'...'
# GNU make and others
.NOTPARALLEL:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PAR-Packer-1.051/contrib/extract_embedded/extract-embedded.pl
new/PAR-Packer-1.052/contrib/extract_embedded/extract-embedded.pl
--- old/PAR-Packer-1.051/contrib/extract_embedded/extract-embedded.pl
2020-03-08 23:54:55.000000000 +0100
+++ new/PAR-Packer-1.052/contrib/extract_embedded/extract-embedded.pl
2020-12-12 16:00:04.000000000 +0100
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl
# Script stolen from one of Roderich Schupp's mails to the PAR
# mailing list. He attributes this to:
@@ -21,8 +21,28 @@
my ($exe, $extract) = @ARGV;
-open my $fh, '<', $exe or die qq[failed to open "$exe": $!];
-binmode $fh;
+sub safe_read
+{
+ my ($fh, $n) = @_;
+ my $buf;
+ my $res = read $fh, $buf, $n;
+ die qq[read of $n bytes failed on "$exe": $!] unless defined $res;
+ die qq[read of $n bytes failed on "$exe": at EOF] unless $res > 0;
+ die qq[read of $n bytes failed on "$exe": only read $res bytes] unless
$res == $n;
+ return $buf;
+}
+
+sub safe_seek
+{
+ my ($fh, $offset, $whence) = @_;
+ unless (seek $fh, $offset, $whence)
+ {
+ my $what = $whence == 0 ? "SET" : $whence == 1 ? "CUR" : "END";
+ die qq[seek $what of $offset bytes failed on "$exe": $!];
+ }
+}
+
+open my $fh, '<:raw', $exe or die qq[failed to open "$exe": $!];
# search for the "\nPAR.pm\n" signature backward from the end of the file
my $buf;
@@ -32,34 +52,38 @@
while (1)
{
$offset = $size if $offset > $size;
- seek $fh, -$offset, 2 or die qq[seek failed on "$exe": $!];
- my $nread = read $fh, $buf, $offset;
- die qq[read failed on "$exe": $!] unless $nread == $offset;
- $idx = rindex($buf, "\nPAR.pm\n");
+ safe_seek($fh, -$offset, 2);
+ $buf = safe_read($fh, $offset);
+ $idx = rindex($buf, "\012PAR.pm\012");
last if $idx >= 0 || $offset == $size || $offset > 128 * 1024;
$offset *= 2;
}
+$offset -= $idx;
die qq[no PAR signature found in "$exe"] unless $idx >= 0;
-# seek 4 bytes backward from the signature to get the offset of the
+# seek 4 bytes backward from the signature to get the offset of the
# first embedded FILE, then seek to it
-$offset -= $idx - 4;
-seek $fh, -$offset, 2;
-read $fh, $buf, 4;
-seek $fh, -$offset - unpack("N", $buf), 2;
+$offset += 4;
+safe_seek($fh, -$offset, 2);
+$buf = safe_read($fh, 4);
+safe_seek($fh, -$offset - unpack("N", $buf), 2);
printf STDERR qq[embedded files in "%s" start at offset %d\n], $exe, tell($fh);
-read $fh, $buf, 4;
-while ($buf eq "FILE")
+my $nfiles = 0;
+$buf = safe_read($fh, 4);
+while ($buf eq "FILE")
{
- read $fh, $buf, 4;
- read $fh, $buf, unpack("N", $buf);
+ $nfiles++;
+
+ $buf = safe_read($fh, 4);
+ $buf = safe_read($fh, unpack("N", $buf));
- (my $fullname = $buf) =~ s|^([a-f\d]{8})/||; # strip CRC
- print $fullname, "\n";
+ my ($crc, $fullname) = $buf =~ m|^((?i)[a-f\d]{8})/(.*)$|
+ or die qq[unrecognized FILE spec: "$buf"];
+ print "$crc $fullname\n";
- read $fh, $buf, 4;
- read $fh, $buf, unpack("N", $buf);
+ $buf = safe_read($fh, 4);
+ $buf = safe_read($fh, unpack("N", $buf));
if ($extract)
{
@@ -73,8 +97,9 @@
print STDERR qq[... extracted to $file\n];
}
- read $fh, $buf, 4;
+ $buf = safe_read($fh, 4);
}
+printf STDERR qq[$nfiles embedded files found\n];
close $fh;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/lib/PAR/Packer.pm
new/PAR-Packer-1.052/lib/PAR/Packer.pm
--- old/PAR-Packer-1.051/lib/PAR/Packer.pm 2020-09-03 11:58:26.000000000
+0200
+++ new/PAR-Packer-1.052/lib/PAR/Packer.pm 2020-12-04 10:41:26.000000000
+0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.051';
+our $VERSION = '1.052';
=head1 NAME
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/lib/pp.pm
new/PAR-Packer-1.052/lib/pp.pm
--- old/PAR-Packer-1.051/lib/pp.pm 2020-09-03 13:12:33.000000000 +0200
+++ new/PAR-Packer-1.052/lib/pp.pm 2021-01-13 15:17:12.000000000 +0100
@@ -287,6 +287,11 @@
a look at Steve Hay's L<PAR::Filter::Crypto> module. Make sure you
understand the Filter::Crypto caveats!
+Note: Most filters are incompatible with C<__DATA__> sections in your source.
+The packed executable typically aborts with an error message like
+
+ readline() on unopened filehandle DATA at (eval 13) line 3.
+
=item B<-g>, B<--gui>
Build an executable that does not have a console window. This option is
@@ -331,6 +336,8 @@
as usual except for files ending in C<warnings.pm> which are filtered with
L<PAR::Filter::Bleach>.
+Note: The same restriction on C<__DATA__> sections holds as for B<--filter>.
+
=item B<-M>, B<--module>=I<MODULE>
Add the specified module into the package, along with its dependencies.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/myldr/Makefile.PL
new/PAR-Packer-1.052/myldr/Makefile.PL
--- old/PAR-Packer-1.051/myldr/Makefile.PL 2020-11-23 15:18:22.000000000
+0100
+++ new/PAR-Packer-1.052/myldr/Makefile.PL 2020-12-04 10:41:26.000000000
+0100
@@ -196,7 +196,7 @@
my $sha1_defines = qq[-DBYTEORDER=0x$Config{byteorder}];
$sha1_defines .= qq[ -DU64TYPE="$Config{u64type}"]
if defined($Config{u64type})
- && ($Config{use64bitint} eq "define" || length($Config{byteorder}) ==
8);
+ && ($Config{use64bitint} || length($Config{byteorder}) == 8);
# Determine whether we can find a config.h. If yes, include it in
# usernamefrompwuid.h. If not, set I_PWD to undefined in that header.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/script/par.pl
new/PAR-Packer-1.052/script/par.pl
--- old/PAR-Packer-1.051/script/par.pl 2020-08-27 11:03:28.000000000 +0200
+++ new/PAR-Packer-1.052/script/par.pl 2020-12-17 12:05:56.000000000 +0100
@@ -155,13 +155,13 @@
=cut
-my ($PAR_MAGIC, $par_temp, $progname, @tmpfile);
+my ($PAR_MAGIC, $par_temp, $progname, @tmpfile, %ModuleCache);
END { if ($ENV{PAR_CLEAN}) {
require File::Temp;
require File::Basename;
require File::Spec;
my $topdir = File::Basename::dirname($par_temp);
- outs(qq{Removing files in "$par_temp"});
+ outs(qq[Removing files in "$par_temp"]);
File::Find::finddepth(sub { ( -d ) ? rmdir : unlink }, $par_temp);
rmdir $par_temp;
# Don't remove topdir because this causes a race with other apps
@@ -181,8 +181,10 @@
SUFFIX => '.cmd',
UNLINK => 0,
);
+ my $filename = $tmp->filename;
- print $tmp "#!/bin/sh
+ print $tmp <<"...";
+#!/bin/sh
x=1; while [ \$x -lt 10 ]; do
rm -rf '$par_temp'
if [ \! -d '$par_temp' ]; then
@@ -191,14 +193,14 @@
sleep 1
x=`expr \$x + 1`
done
-rm '" . $tmp->filename . "'
-";
- chmod 0700,$tmp->filename;
- my $cmd = $tmp->filename . ' >/dev/null 2>&1 &';
+rm '$filename'
+...
close $tmp;
+
+ chmod 0700, $filename;
+ my $cmd = "$filename >/dev/null 2>&1 &";
system($cmd);
- outs(qq(Spawned background process to perform cleanup: )
- . $tmp->filename);
+ outs(qq[Spawned background process to perform cleanup: $filename]);
}
} }
@@ -228,8 +230,7 @@
local $SIG{__WARN__} = sub {};
# Check file type, get start of data section {{{
- open _FH, '<', $progname or last;
- binmode(_FH);
+ open _FH, '<:raw', $progname or last;
# Search for the "\nPAR.pm\n signature backward from the end of the file
my $buf;
@@ -247,8 +248,8 @@
# in any case, $magic_pos is a multiple of $chunk_size
while ($magic_pos >= 0) {
- seek(_FH, $magic_pos, 0);
- read(_FH, $buf, $chunk_size + length($PAR_MAGIC));
+ seek _FH, $magic_pos, 0;
+ read _FH, $buf, $chunk_size + length($PAR_MAGIC);
if ((my $i = rindex($buf, $PAR_MAGIC)) >= 0) {
$magic_pos += $i;
last;
@@ -274,7 +275,7 @@
read _FH, $buf, unpack("N", $buf);
my $fullname = $buf;
- outs(qq(Unpacking file "$fullname"...));
+ outs(qq[Unpacking FILE "$fullname"...]);
my $crc = ( $fullname =~ s|^([a-f\d]{8})/|| ) ? $1 : undef;
my ($basename, $ext) = ($buf =~ m|(?:.*/)?(.*)(\..*)|);
@@ -282,17 +283,17 @@
read _FH, $buf, unpack("N", $buf);
if (defined($ext) and $ext !~ /\.(?:pm|pl|ix|al)$/i) {
- my $filename = _tempfile("$crc$ext", $buf, 0755);
+ my $filename = _save_as("$crc$ext", $buf, 0755);
$PAR::Heavy::FullCache{$fullname} = $filename;
$PAR::Heavy::FullCache{$filename} = $fullname;
}
elsif ( $fullname =~ m|^/?shlib/| and defined $ENV{PAR_TEMP} ) {
- my $filename = _tempfile("$basename$ext", $buf, 0755);
+ my $filename = _save_as("$basename$ext", $buf, 0755);
outs("SHLIB: $filename\n");
}
else {
$require_list{$fullname} =
- $PAR::Heavy::ModuleCache{$fullname} = {
+ $ModuleCache{$fullname} = {
buf => $buf,
crc => $crc,
name => $fullname,
@@ -312,21 +313,20 @@
$INC{$module} = "/loader/$info/$module";
if ($ENV{PAR_CLEAN} and defined(&IO::File::new)) {
- my $fh = IO::File->new_tmpfile or die $!;
- binmode($fh);
- print $fh $info->{buf};
- seek($fh, 0, 0);
+ my $fh = IO::File->new_tmpfile or die "Can't create temp file: $!";
+ $fh->binmode();
+ $fh->print($info->{buf});
+ $fh->seek(0, 0);
return $fh;
}
else {
- my $filename = _tempfile("$info->{crc}.pm", $info->{buf});
+ my $filename = _save_as("$info->{crc}.pm", $info->{buf});
- open my $fh, '<', $filename or die "can't read $filename: $!";
- binmode($fh);
+ open my $fh, '<:raw', $filename or die qq[Can't read "$filename":
$!];
return $fh;
}
- die "Bootstrapping failed: cannot find $module!\n";
+ die "Bootstrapping failed: can't find module $module!";
}, @INC);
# Now load all bundled files {{{
@@ -416,7 +416,7 @@
$quiet = 1;
}
elsif ($1 eq 'L') {
- open $logfh, ">>", $2 or die "XXX: Cannot open log: $!";
+ open $logfh, ">>", $2 or die qq[Can't open log file "$2": $!];
}
elsif ($1 eq 'T') {
$cache_name = $2;
@@ -456,13 +456,12 @@
if (defined $par) {
- open my $fh, '<', $par or die "Cannot find '$par': $!";
- binmode($fh);
+ open my $fh, '<:raw', $par or die qq[Can't find par file "$par": $!];
bless($fh, 'IO::File');
$zip = Archive::Zip->new;
( $zip->readFromFileHandle($fh, $par) == Archive::Zip::AZ_OK() )
- or die "Read '$par' error: $!";
+ or die qq[Error reading zip archive "$par"];
}
@@ -475,12 +474,13 @@
};
# Open input and output files {{{
- local $/ = \4;
if (defined $par) {
- open PAR, '<', $par or die "$!: $par";
- binmode(PAR);
- die "$par is not a PAR file" unless <PAR> eq "PK\003\004";
+ open my $ph, '<:raw', $par or die qq[Can't read par file "$par": $!];
+ my $buf;
+ read $ph, $buf, 4;
+ die qq["$par" is not a par file] unless $buf eq "PK\003\004";
+ close $ph;
}
CreatePath($out) ;
@@ -489,12 +489,19 @@
$out,
IO::File::O_CREAT() | IO::File::O_WRONLY() | IO::File::O_TRUNC(),
0777,
- ) or die $!;
- binmode($fh);
+ ) or die qq[Can't create file "$out": $!];
+ $fh->binmode();
- $/ = (defined $data_pos) ? \$data_pos : undef;
seek _FH, 0, 0;
- my $loader = scalar <_FH>;
+
+ my $loader;
+ if (defined $data_pos) {
+ read _FH, $loader, $data_pos;
+ } else {
+ local $/ = undef;
+ $loader = <_FH>;
+ }
+
if (!$ENV{PAR_VERBATIM} and $loader =~ /^(?:#!|\@rem)/) {
require PAR::Filter::PodStrip;
PAR::Filter::PodStrip->apply(\$loader, $0);
@@ -509,7 +516,6 @@
}eg;
}
$fh->print($loader);
- $/ = undef;
# }}}
# Write bundled modules {{{
@@ -528,55 +534,60 @@
$_ ne $Config::Config{privlibexp});
} @INC;
+ # normalize paths (remove trailing or multiple consecutive slashes)
+ s|/+|/|g, s|/$|| foreach @inc;
+
# Now determine the files loaded above by require_modules():
# Perl source files are found in values %INC and DLLs are
# found in @DynaLoader::dl_shared_objects.
my %files;
$files{$_}++ for @DynaLoader::dl_shared_objects, values %INC;
- my $lib_ext = $Config::Config{lib_ext};
+ my $lib_ext = $Config::Config{lib_ext}; # XXX lib_ext vs dlext
?
my %written;
- foreach (sort keys %files) {
- my ($name, $file);
+ foreach my $key (sort keys %files) {
+ my ($file, $name);
- foreach my $dir (@inc) {
- if ($name = $PAR::Heavy::FullCache{$_}) {
- $file = $_;
- last;
- }
- elsif (/^(\Q$dir\E\/(.*[^Cc]))\Z/i) {
- ($file, $name) = ($1, $2);
- last;
- }
- elsif (m!^/loader/[^/]+/(.*[^Cc])\Z!) {
- if (my $ref = $PAR::Heavy::ModuleCache{$1}) {
- ($file, $name) = ($ref, $1);
+ if (defined(my $fc = $PAR::Heavy::FullCache{$key})) {
+ ($file, $name) = ($key, $fc);
+ }
+ else {
+ foreach my $dir (@inc) {
+ if ($key =~ m|^\Q$dir\E/(.*)$|i) {
+ ($file, $name) = ($key, $1);
last;
}
- elsif (-f "$dir/$1") {
- ($file, $name) = ("$dir/$1", $1);
- last;
+ if ($key =~ m|^/loader/[^/]+/(.*)$|) {
+ if (my $ref = $ModuleCache{$1}) {
+ ($file, $name) = ($ref, $1);
+ last;
+ }
+ if (-f "$dir/$1") {
+ ($file, $name) = ("$dir/$1", $1);
+ last;
+ }
}
}
}
+ # There are legitimate reasons why we couldn't find $name and
$file for a $key:
+ # - cperl has e.g. $INC{"XSLoader.pm"} = "XSLoader.c",
+ # $INC{"DynaLoader.pm"}' = "dlboot_c.PL"
+ next unless defined $name;
- next unless defined $name and not $written{$name}++;
- next if !ref($file) and $file =~ /\.\Q$lib_ext\E$/;
- outs( join "",
- qq(Packing "), ref $file ? $file->{name} : $file,
- qq("...)
- );
+ next if $written{$name}++;
+ next if !ref($file) and $file =~ /\.\Q$lib_ext\E$/i;
+ outs(sprintf(qq[Packing FILE "%s"...], ref $file ? $file->{name} :
$file));
my $content;
if (ref($file)) {
$content = $file->{buf};
}
else {
- open FILE, '<', $file or die "Can't open $file: $!";
- binmode(FILE);
- $content = <FILE>;
- close FILE;
+ local $/ = undef;
+ open my $fh, '<:raw', $file or die qq[Can't read "$file": $!];
+ $content = <$fh>;
+ close $fh;
PAR::Filter::PodStrip->apply(\$content, "<embedded>/$name")
if !$ENV{PAR_VERBATIM} and $name =~ /\.(?:pm|ix|al)$/i;
@@ -584,14 +595,12 @@
PAR::Filter::PatchContent->new->apply(\$content, $file, $name);
}
- outs(qq(Written as "$name"));
- $fh->print("FILE");
- $fh->print(pack('N', length($name) + 9));
- $fh->print(sprintf(
- "%08x/%s", Archive::Zip::computeCRC32($content), $name
- ));
- $fh->print(pack('N', length($content)));
- $fh->print($content);
+ $fh->print("FILE",
+ pack('N', length($name) + 9),
+ sprintf("%08x/%s",
Archive::Zip::computeCRC32($content), $name),
+ pack('N', length($content)),
+ $content);
+ outs(qq[Written as "$name"]);
}
}
# }}}
@@ -602,10 +611,9 @@
$cache_name = substr $cache_name, 0, 40;
if (!$cache_name and my $mtime = (stat($out))[9]) {
my $ctx = Digest::SHA->new(1);
- open(my $fh, "<", $out);
- binmode($fh);
+ open my $fh, "<:raw", $out;
$ctx->addfile($fh);
- close($fh);
+ close $fh;
$cache_name = $ctx->hexdigest;
}
@@ -640,20 +648,21 @@
}
my $fh = IO::File->new; # Archive::Zip
operates on an IO::Handle
- $fh->fdopen(fileno(_FH), 'r') or die "$!: $@";
+ $fh->fdopen(fileno(_FH), 'r') or die qq[fdopen() failed: $!];
# Temporarily increase the chunk size for Archive::Zip so that it will
find the EOCD
# even if lots of stuff has been appended to the pp'ed exe (e.g. by OSX
codesign).
Archive::Zip::setChunkSize(-s _FH);
my $zip = Archive::Zip->new;
- $zip->readFromFileHandle($fh, $progname) == Archive::Zip::AZ_OK() or die
"$!: $@";
+ ( $zip->readFromFileHandle($fh, $progname) == Archive::Zip::AZ_OK() )
+ or die qq[Error reading zip archive "$progname"];
Archive::Zip::setChunkSize(64 * 1024);
push @PAR::LibCache, $zip;
$PAR::LibCache{$progname} = $zip;
$quiet = !$ENV{PAR_DEBUG};
- outs(qq(\$ENV{PAR_TEMP} = "$ENV{PAR_TEMP}"));
+ outs(qq[\$ENV{PAR_TEMP} = "$ENV{PAR_TEMP}"]);
if (defined $ENV{PAR_TEMP}) { # should be set at this point!
foreach my $member ( $zip->members ) {
@@ -670,9 +679,9 @@
my $extract_name = $1;
my $dest_name = File::Spec->catfile($ENV{PAR_TEMP}, $extract_name);
if (-f $dest_name && -s _ == $member->uncompressedSize()) {
- outs(qq(Skipping "$member_name" since it already exists at
"$dest_name"));
+ outs(qq[Skipping "$member_name" since it already exists at
"$dest_name"]);
} else {
- outs(qq(Extracting "$member_name" to "$dest_name"));
+ outs(qq[Extracting "$member_name" to "$dest_name"]);
$member->extractToFileNamed($dest_name);
chmod(0555, $dest_name) if $^O eq "hpux";
}
@@ -694,17 +703,16 @@
sub CreatePath {
my ($name) = @_;
-
+
require File::Basename;
my ($basename, $path, $ext) = File::Basename::fileparse($name, ('\..*'));
-
+
require File::Path;
-
+
File::Path::mkpath($path) unless(-e $path); # mkpath dies with error
}
sub require_modules {
- #local $INC{'Cwd.pm'} = __FILE__ if $^O ne 'MSWin32';
require lib;
require DynaLoader;
@@ -774,28 +782,28 @@
my $stmpdir = "$path$Config{_delim}par-".unpack("H*", $username);
mkdir $stmpdir, 0755;
if (!$ENV{PAR_CLEAN} and my $mtime = (stat($progname))[9]) {
- open (my $fh, "<". $progname);
+ open my $fh, "<:raw", $progname or die qq[Can't read "$progname":
$!];
seek $fh, -18, 2;
- sysread $fh, my $buf, 6;
+ my $buf;
+ read $fh, $buf, 6;
if ($buf eq "\0CACHE") {
seek $fh, -58, 2;
- sysread $fh, $buf, 41;
+ read $fh, $buf, 41;
$buf =~ s/\0//g;
- $stmpdir .= "$Config{_delim}cache-" . $buf;
+ $stmpdir .= "$Config{_delim}cache-$buf";
}
else {
- my $digest = eval
+ my $digest = eval
{
- require Digest::SHA;
+ require Digest::SHA;
my $ctx = Digest::SHA->new(1);
- open(my $fh, "<", $progname);
- binmode($fh);
+ open my $fh, "<:raw", $progname or die qq[Can't read
"$progname": $!];
$ctx->addfile($fh);
close($fh);
$ctx->hexdigest;
} || $mtime;
- $stmpdir .= "$Config{_delim}cache-$digest";
+ $stmpdir .= "$Config{_delim}cache-$digest";
}
close($fh);
}
@@ -814,27 +822,26 @@
# check if $name (relative to $par_temp) already exists;
-# if not, create a file with a unique temporary name,
+# if not, create a file with a unique temporary name,
# fill it with $contents, set its file mode to $mode if present;
-# finaly rename it to $name;
+# finaly rename it to $name;
# in any case return the absolute filename
-sub _tempfile {
+sub _save_as {
my ($name, $contents, $mode) = @_;
my $fullname = "$par_temp/$name";
unless (-e $fullname) {
my $tempname = "$fullname.$$";
- open my $fh, '>', $tempname or die "can't write $tempname: $!";
- binmode $fh;
+ open my $fh, '>:raw', $tempname or die qq[Can't write "$tempname": $!];
print $fh $contents;
close $fh;
chmod $mode, $tempname if defined $mode;
rename($tempname, $fullname) or unlink($tempname);
- # NOTE: The rename() error presumably is something like ETXTBSY
+ # NOTE: The rename() error presumably is something like ETXTBSY
# (scenario: another process was faster at extraction $fullname
- # than us and is already using it in some way); anyway,
+ # than us and is already using it in some way); anyway,
# let's assume $fullname is "good" and clean up our copy.
}
@@ -940,7 +947,7 @@
unshift @INC, \&PAR::find_par;
PAR->import(@par_args);
-die qq(par.pl: Can't open perl script "$progname": No such file or directory\n)
+die qq[par.pl: Can't open perl script "$progname": No such file or directory\n]
unless -e $progname;
do $progname;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PAR-Packer-1.051/t/90-rt129312.t
new/PAR-Packer-1.052/t/90-rt129312.t
--- old/PAR-Packer-1.051/t/90-rt129312.t 2020-03-08 23:54:55.000000000
+0100
+++ new/PAR-Packer-1.052/t/90-rt129312.t 2020-12-04 10:41:26.000000000
+0100
@@ -7,14 +7,22 @@
use Test::More;
require "./t/utils.pl";
-plan tests => 4;
+if (eval { require Archive::Unzip::Burst; 1; })
+{
+ plan skip_all => "Archive::Unzip::Burst detected";
+ # Archive::Unzip::Burst can't handle the archive constructed below
+}
+else
+{
+ plan tests => 4;
+}
my $hello = "hello, garbage\n";
my $exe = pp_ok(-e => "print qq[$hello]");
my $exe_size = -s $exe;
open my $fh, ">>:raw", $exe or die "can't append to $exe: $!";
-my $garbage = "garbage\n" x 128;
+my $garbage = "garbage\n" x 128;
print $fh $garbage for 1..512;
close $fh;
