X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/16b7cb9b3cc58b852adbd09e628b96b47062b5b1..fab47672ea774d7218190a2a536876727be5a5de:/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;