From fab47672ea774d7218190a2a536876727be5a5de Mon Sep 17 00:00:00 2001
From: Moritz Bunkus <m.bunkus@linet-services.de>
Date: Thu, 16 Jan 2014 15:37:48 +0100
Subject: [PATCH] Archive::Zip::Member::_writeToFileHandle fixen
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

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
---
 SL/ArchiveZipFixes.pm | 72 +++++++++++++++++++++++++++++++++++++++++++
 SL/Dispatcher.pm      |  3 ++
 2 files changed, 75 insertions(+)
 create mode 100644 SL/ArchiveZipFixes.pm

diff --git a/SL/ArchiveZipFixes.pm b/SL/ArchiveZipFixes.pm
new file mode 100644
index 000000000..ee5057965
--- /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 fe992ed2a..f9ad09a87 100644
--- 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;
 }
 
-- 
2.20.1