Archive::Zip::Member::_writeToFileHandle fixen

Archive::Zip v1.31_04 und neuer enthält einen Bug, durch den von
LibreOffice erzeugte ODTs beim Schreiben der neuen Datei zu einer
Fehlermeldung, damit dem Abbruch der Schreiboperation und letztlich zu
defekten Ausgabedateien führt. Der Bug existiert auch in der aktuellen
Version 1.37.

Daher die Funktion, in der die betroffene Änderung vorgenommen wurde,
Monkeypatchen, bis der Bug behoben ist.

Siehe https://rt.cpan.org/Public/Bug/Display.html?id=92205

diff --git a/SL/ArchiveZipFixes.pm b/SL/ArchiveZipFixes.pm
new file mode 100644 (file)
index 0000000..ee50579
--- /dev/null
+++ b/SL/ArchiveZipFixes.pm
@@ -0,0 +1,72 @@
+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;

diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index fe992ed..f9ad09a 100644 (file)
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -26,6 +26,7 @@ use File::Basename;
 use List::MoreUtils qw(all);
 use List::Util qw(first);
 use POSIX;
+use SL::ArchiveZipFixes;
 use SL::Auth;
 use SL::Dispatcher::AuthHandler;
 use SL::LXDebug;
@@ -51,6 +52,8 @@ sub new {
   $self->{interface} = lc($interface || 'cgi');
   $self->{auth_handler} = SL::Dispatcher::AuthHandler->new;
 
+  SL::ArchiveZipFixes->apply_fixes;
+
   return $self;
 }