Archive::Zip: kein Fix für aktuelle Versionen mehr nötig
authorMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 20 Mar 2020 13:48:15 +0000 (14:48 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 20 Mar 2020 13:48:15 +0000 (14:48 +0100)
Der Fix ist bei 1.40 bereits in offiziellen Releases
enthalten. Deutlich neuere Versionen enthalten sogar Änderungen, bei
denen unser Fix das Modul kaputt macht.

Also… Archive::Zip ≥ 1.40 voraussetzen und unseren eigenen Fix wegwerfen.

SL/ArchiveZipFixes.pm [deleted file]
SL/Dispatcher.pm
SL/InstallationCheck.pm

diff --git a/SL/ArchiveZipFixes.pm b/SL/ArchiveZipFixes.pm
deleted file mode 100644 (file)
index ee50579..0000000
+++ /dev/null
@@ -1,72 +0,0 @@
-package SL::ArchiveZipFixes;
-
-use strict;
-
-use Archive::Zip;
-use Archive::Zip::Member;
-use version;
-
-# Archive::Zip contains a bug starting with 1.31_04 which prohibits
-# re-writing Zips produced by LibreOffice (.odt). See
-# https://rt.cpan.org/Public/Bug/Display.html?id=92205
-
-sub _member_writeToFileHandle {
-    my $self         = shift;
-    my $fh           = shift;
-    my $fhIsSeekable = shift;
-    my $offset       = shift;
-
-    return _error("no member name given for $self")
-      if $self->fileName() eq '';
-
-    $self->{'writeLocalHeaderRelativeOffset'} = $offset;
-    $self->{'wasWritten'}                     = 0;
-
-    # Determine if I need to write a data descriptor
-    # I need to do this if I can't refresh the header
-    # and I don't know compressed size or crc32 fields.
-    my $headerFieldsUnknown = (
-        ( $self->uncompressedSize() > 0 )
-          and ($self->compressionMethod() == Archive::Zip::COMPRESSION_STORED
-            or $self->desiredCompressionMethod() == Archive::Zip::COMPRESSION_DEFLATED )
-    );
-
-    my $shouldWriteDataDescriptor =
-      ( $headerFieldsUnknown and not $fhIsSeekable );
-
-    $self->hasDataDescriptor(1)
-      if ($shouldWriteDataDescriptor);
-
-    $self->{'writeOffset'} = 0;
-
-    my $status = $self->rewindData();
-    ( $status = $self->_writeLocalFileHeader($fh) )
-      if $status == Archive::Zip::AZ_OK;
-    ( $status = $self->_writeData($fh) )
-      if $status == Archive::Zip::AZ_OK;
-    if ( $status == Archive::Zip::AZ_OK ) {
-        $self->{'wasWritten'} = 1;
-        if ( $self->hasDataDescriptor() ) {
-            $status = $self->_writeDataDescriptor($fh);
-        }
-        elsif ($headerFieldsUnknown) {
-            $status = $self->_refreshLocalFileHeader($fh);
-        }
-    }
-
-    return $status;
-}
-
-sub fix_write_to_file_handle_1_30 {
-  return if version->new("$Archive::Zip::VERSION")->numify <= version->new("1.30")->numify;
-
-  no warnings 'redefine';
-
-  *Archive::Zip::Member::_writeToFileHandle = \&_member_writeToFileHandle;
-}
-
-sub apply_fixes {
-  fix_write_to_file_handle_1_30();
-}
-
-1;
index 3d3f64d..31c76a5 100644 (file)
@@ -19,7 +19,6 @@ use IO::File;
 use List::MoreUtils qw(all);
 use List::Util qw(first);
 use POSIX qw(setlocale);
-use SL::ArchiveZipFixes;
 use SL::Auth;
 use SL::Dispatcher::AuthHandler;
 use SL::LXDebug;
@@ -51,8 +50,6 @@ sub new {
   $self->{interface} = lc($interface || 'cgi');
   $self->{auth_handler} = SL::Dispatcher::AuthHandler->new;
 
-  SL::ArchiveZipFixes->apply_fixes;
-
   # Initialize character type locale to be UTF-8 instead of C:
   foreach my $locale (qw(de_DE.UTF-8 en_US.UTF-8)) {
     last if setlocale('LC_CTYPE', $locale);
index 9f85ff2..aeac4e5 100644 (file)
@@ -18,7 +18,7 @@ BEGIN {
 @required_modules = (
   { name => "parent",                              url => "http://search.cpan.org/~corion/",    debian => 'libparent-perl' },
   { name => "Algorithm::CheckDigits",              url => "http://search.cpan.org/~mamawe/",    debian => 'libalgorithm-checkdigits-perl' },
-  { name => "Archive::Zip",    version => '1.16',  url => "http://search.cpan.org/~phred/",     debian => 'libarchive-zip-perl' },
+  { name => "Archive::Zip",    version => '1.40',  url => "http://search.cpan.org/~phred/",     debian => 'libarchive-zip-perl' },
   { name => "CAM::PDF",                            url => "https://metacpan.org/pod/CAM::PDF",  debian => 'libcam-pdf-perl' },
   { name => "CGI",             version => '3.43',  url => "http://search.cpan.org/~leejo/",     debian => 'libcgi-pm-perl' }, # 4.09 is not core anymore (perl 5.20)
   { name => "Clone",                               url => "http://search.cpan.org/~rdf/",       debian => 'libclone-perl' },