view release on metacpan or  search on metacpan

lib/Archive/Zip/Archive.pm  view on Meta::CPAN

    }

    foreach my $member ($self->members()) {

        # (Re-)set object member zip64 flag.  Here is what
        # happens next to that flag:
        #
        #   $member->_writeToFileHandle
        #       Determines a local flag value depending on
        #       necessity and user desire and ors it to
        #       the object member
        #     $member->_writeLocalFileHeader
        #         Queries the object member to write appropriate
        #         local header
        #     $member->_writeDataDescriptor
        #         Queries the object member to write appropriate
        #         data descriptor
        #   $member->_writeCentralDirectoryFileHeader
        #       Determines a local flag value depending on
        #       necessity and user desire.  Writes a central
        #       directory header appropriate to the local flag.
        #       Ors the local flag to the object member.
        $member->{'zip64'} = 0;

        my ($status, $memberSize) =
          $member->_writeToFileHandle($fh, $fhIsSeekable, $offset,
                                      $self->desiredZip64Mode());
        $member->endRead();
        return $status if $status != AZ_OK;

        $offset += $memberSize;

        # Change this so it reflects write status and last
        # successful position
        $member->{'wasWritten'} = 1;
        $self->{'writeCentralDirectoryOffset'} = $offset;
    }

    return $self->writeCentralDirectory($fh);
}

# Write zip back to the original file,
# as safely as possible.
# Returns AZ_OK if successful.
sub overwrite {
    my $self = shift;
    return $self->overwriteAs($self->{'fileName'});
}

# Write zip to the specified file,
# as safely as possible.
# Returns AZ_OK if successful.
sub overwriteAs {
    my $self = shift;
    my $zipName = (ref($_[0]) eq 'HASH') ? $_[0]->{filename} : shift;
    return _error("no filename in overwriteAs()") unless defined($zipName);

    my ($fh, $tempName) = Archive::Zip::tempFile();
    return _error("Can't open temp file", $!) unless $fh;

    (my $backupName = $zipName) =~ s{(\.[^.]*)?$}{.zbk};

    my $status = $self->writeToFileHandle($fh);
    $fh->close();
    $fh = undef;

    if ($status != AZ_OK) {
        unlink($tempName);
        _printError("Can't write to $tempName");
        return $status;
    }

    my $err;

    # rename the zip
    if (-f $zipName && !rename($zipName, $backupName)) {
        $err = $!;
        unlink($tempName);
        return _error("Can't rename $zipName as $backupName", $err);
    }

    # move the temp to the original name (possibly copying)
    unless (File::Copy::move($tempName, $zipName)
        || File::Copy::copy($tempName, $zipName)) {
        $err = $!;
        rename($backupName, $zipName);
        unlink($tempName);
        return _error("Can't move $tempName to $zipName", $err);
    }

    # unlink the backup
    if (-f $backupName && !unlink($backupName)) {
        $err = $!;
        return _error("Can't unlink $backupName", $err);
    }

    return AZ_OK;
}

# Used only during writing
sub _writeCentralDirectoryOffset {
    shift->{'writeCentralDirectoryOffset'};
}

sub _writeEOCDOffset {
    shift->{'writeEOCDOffset'};
}

# Expects to have _writeEOCDOffset() set
sub _writeEndOfCentralDirectory {
    my ($self, $fh, $membersZip64) = @_;

    my $zip64                                 = 0;
    my $versionMadeBy                         = $self->versionMadeBy();
    my $versionNeededToExtract                = $self->versionNeededToExtract();
    my $diskNumber                            = 0;
    my $diskNumberWithStartOfCentralDirectory = 0;
    my $numberOfCentralDirectoriesOnThisDisk  = $self->numberOfMembers();
    my $numberOfCentralDirectories            = $self->numberOfMembers();
    my $centralDirectorySize =
      $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset();
    my $centralDirectoryOffsetWRTStartingDiskNumber =
      $self->_writeCentralDirectoryOffset();
    my $zipfileCommentLength                  = length($self->zipfileComment());

    my $eocdDataZip64 = 0;
    $eocdDataZip64 ||= $numberOfCentralDirectoriesOnThisDisk > 0xffff;
    $eocdDataZip64 ||= $numberOfCentralDirectories > 0xffff;
    $eocdDataZip64 ||= $centralDirectorySize > 0xffffffff;
    $eocdDataZip64 ||= $centralDirectoryOffsetWRTStartingDiskNumber > 0xffffffff;

    if (   $membersZip64
        || $eocdDataZip64
        || $self->desiredZip64Mode() == ZIP64_EOCD) {
        return _zip64NotSupported() unless ZIP64_SUPPORTED;

        $zip64                  = 1;
        $versionMadeBy          = 45 if ($versionMadeBy == 0);
        $versionNeededToExtract = 45 if ($versionNeededToExtract < 45);

        $self->_print($fh, ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE_STRING)
          or return _ioError('writing zip64 EOCD record signature');

        my $record = pack(
            ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_FORMAT,
            ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH +
            SIGNATURE_LENGTH - 12,
            $versionMadeBy,
            $versionNeededToExtract,
            $diskNumber,
            $diskNumberWithStartOfCentralDirectory,
            $numberOfCentralDirectoriesOnThisDisk,
            $numberOfCentralDirectories,
            $centralDirectorySize,