SL/ArchiveZipFixes.pm

   1 package SL::ArchiveZipFixes;
   2
   3 use strict;
   4
   5 use Archive::Zip;
   6 use Archive::Zip::Member;
   7 use version;
   8
   9 # Archive::Zip contains a bug starting with 1.31_04 which prohibits
  10 # re-writing Zips produced by LibreOffice (.odt). See
  11 # https://rt.cpan.org/Public/Bug/Display.html?id=92205
  12
  13 sub _member_writeToFileHandle {
  14     my $self         = shift;
  15     my $fh           = shift;
  16     my $fhIsSeekable = shift;
  17     my $offset       = shift;
  18
  19     return _error("no member name given for $self")
  20       if $self->fileName() eq '';
  21
  22     $self->{'writeLocalHeaderRelativeOffset'} = $offset;
  23     $self->{'wasWritten'}                     = 0;
  24
  25     # Determine if I need to write a data descriptor
  26     # I need to do this if I can't refresh the header
  27     # and I don't know compressed size or crc32 fields.
  28     my $headerFieldsUnknown = (
  29         ( $self->uncompressedSize() > 0 )
  30           and ($self->compressionMethod() == Archive::Zip::COMPRESSION_STORED
  31             or $self->desiredCompressionMethod() == Archive::Zip::COMPRESSION_DEFLATED )
  32     );
  33
  34     my $shouldWriteDataDescriptor =
  35       ( $headerFieldsUnknown and not $fhIsSeekable );
  36
  37     $self->hasDataDescriptor(1)
  38       if ($shouldWriteDataDescriptor);
  39
  40     $self->{'writeOffset'} = 0;
  41
  42     my $status = $self->rewindData();
  43     ( $status = $self->_writeLocalFileHeader($fh) )
  44       if $status == Archive::Zip::AZ_OK;
  45     ( $status = $self->_writeData($fh) )
  46       if $status == Archive::Zip::AZ_OK;
  47     if ( $status == Archive::Zip::AZ_OK ) {
  48         $self->{'wasWritten'} = 1;
  49         if ( $self->hasDataDescriptor() ) {
  50             $status = $self->_writeDataDescriptor($fh);
  51         }
  52         elsif ($headerFieldsUnknown) {
  53             $status = $self->_refreshLocalFileHeader($fh);
  54         }
  55     }
  56
  57     return $status;
  58 }
  59
  60 sub fix_write_to_file_handle_1_30 {
  61   return if version->new("$Archive::Zip::VERSION")->numify <= version->new("1.30")->numify;
  62
  63   no warnings 'redefine';
  64
  65   *Archive::Zip::Member::_writeToFileHandle = \&_member_writeToFileHandle;
  66 }
  67
  68 sub apply_fixes {
  69   fix_write_to_file_handle_1_30();
  70 }
  71
  72 1;