IO-Compress

 view release on metacpan or  search on metacpan

lib/IO/Compress/Zip.pm  view on Meta::CPAN

            $extra .= mkExtendedTime($param->getValue('mtime'),
                                    $param->getValue('atime'),
                                    $param->getValue('ctime'));

            $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
        }

        if ( $osCode == ZIP_OS_CODE_UNIX )
        {
            if ( $param->getValue('want_exunixn') )
            {
                    my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') });
                    $extra    .= $ux3;
                    $ctlExtra .= $ux3;
            }

            if ( $param->getValue('exunix2') )
            {
                    $extra    .= mkUnix2Extra( @{ $param->getValue('exunix2') });
                    $ctlExtra .= mkUnix2Extra();
            }
        }

        $extFileAttr = $param->getValue('extattr')
            if defined $param->getValue('extattr') ;

        $extra .= $param->getValue('extrafieldlocal')
            if defined $param->getValue('extrafieldlocal');

        $ctlExtra .= $param->getValue('extrafieldcentral')
            if defined $param->getValue('extrafieldcentral');
    }

    my $method = *$self->{ZipData}{Method} ;
    my $gpFlag = 0 ;
    $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
        if *$self->{ZipData}{Stream} ;

    $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT
        if $method == ZIP_CM_LZMA ;

    $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING
        if  $param->getValue('efs') && (length($filename) || length($comment));

    my $version = $ZIP_CM_MIN_VERSIONS{$method};
    $version = ZIP64_MIN_VERSION
        if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64};

    my $madeBy = ($param->getValue('os_code') << 8) + $version;
    my $extract = $version;

    *$self->{ZipData}{Version} = $version;
    *$self->{ZipData}{MadeBy} = $madeBy;

    my $ifa = 0;
    $ifa |= ZIP_IFA_TEXT_MASK
        if $param->getValue('textflag');

    $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
    $hdr .= pack 'v', $extract   ; # extract Version & OS
    $hdr .= pack 'v', $gpFlag    ; # general purpose flag (set streaming mode)
    $hdr .= pack 'v', $method    ; # compression method (deflate)
    $hdr .= pack 'V', $time      ; # last mod date/time
    $hdr .= pack 'V', 0          ; # crc32               - 0 when streaming
    $hdr .= pack 'V', $empty     ; # compressed length   - 0 when streaming
    $hdr .= pack 'V', $empty     ; # uncompressed length - 0 when streaming
    $hdr .= pack 'v', length $filename ; # filename length
    $hdr .= pack 'v', length $extra ; # extra length

    $hdr .= $filename ;

    # Remember the offset for the compressed & uncompressed lengths in the
    # local header.
    if (*$self->{ZipData}{Zip64}) {
        *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
            + length($hdr) + 4 ;
    }
    else {
        *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
                                            + 18;
    }

    $hdr .= $extra ;


    my $ctl = '';

    $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
    $ctl .= pack 'v', $madeBy    ; # version made by
    $ctl .= pack 'v', $extract   ; # extract Version
    $ctl .= pack 'v', $gpFlag    ; # general purpose flag (streaming mode)
    $ctl .= pack 'v', $method    ; # compression method (deflate)
    $ctl .= pack 'V', $time      ; # last mod date/time
    $ctl .= pack 'V', 0          ; # crc32
    $ctl .= pack 'V', $empty     ; # compressed length
    $ctl .= pack 'V', $empty     ; # uncompressed length
    $ctl .= pack 'v', length $filename ; # filename length

    *$self->{ZipData}{ExtraOffset} = length $ctl;
    *$self->{ZipData}{ExtraSize} = length $ctlExtra ;

    $ctl .= pack 'v', length $ctlExtra ; # extra length
    $ctl .= pack 'v', length $comment ;  # file comment length
    $ctl .= pack 'v', 0          ; # disk number start
    $ctl .= pack 'v', $ifa       ; # internal file attributes
    $ctl .= pack 'V', $extFileAttr   ; # external file attributes

    # offset to local hdr
    if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) {
        $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
    }
    else {
        $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ;
    }

    $ctl .= $filename ;

    *$self->{ZipData}{Offset}->add32(length $hdr) ;

    *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment];

    return $hdr;
}

sub mkTrailer
{
    my $self = shift ;

    my $crc32 ;
    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
        $crc32 = pack "V", *$self->{Compress}->crc32();
    }
    else {
        $crc32 = pack "V", *$self->{ZipData}{CRC32};
    }

    my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} };

    my $sizes ;
    if (! *$self->{ZipData}{Zip64}) {
        $sizes .= *$self->{CompSize}->getPacked_V32() ;   # Compressed size
        $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size
    }
    else {
        $sizes .= *$self->{CompSize}->getPacked_V64() ;   # Compressed size
        $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
    }

    my $data = $crc32 . $sizes ;

    my $xtrasize  = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size

lib/IO/Compress/Zip.pm  view on Meta::CPAN

	$dt += ( ( $mon + 1 ) << 21 );
	$dt += ( ( $year - 80 ) << 25 );
	return $dt;
}

1;

__END__

=head1 NAME

IO::Compress::Zip - Write zip files/buffers

=head1 SYNOPSIS

    use IO::Compress::Zip qw(zip $ZipError) ;

    my $status = zip $input => $output [,OPTS]
        or die "zip failed: $ZipError\n";

    my $z = IO::Compress::Zip->new( $output [,OPTS] )
        or die "zip failed: $ZipError\n";

    $z->print($string);
    $z->printf($format, $string);
    $z->write($string);
    $z->syswrite($string [, $length, $offset]);
    $z->flush();
    $z->tell();
    $z->eof();
    $z->seek($position, $whence);
    $z->binmode();
    $z->fileno();
    $z->opened();
    $z->autoflush();
    $z->input_line_number();
    $z->newStream( [OPTS] );

    $z->deflateParams();

    $z->close() ;

    $ZipError ;

    # IO::File mode

    print $z $string;
    printf $z $format, $string;
    tell $z
    eof $z
    seek $z, $position, $whence
    binmode $z
    fileno $z
    close $z ;

=head1 DESCRIPTION

This module provides a Perl interface that allows writing zip
compressed data to files or buffer.

The primary purpose of this module is to provide streaming write access to
zip files and buffers.

At present the following compression methods are supported by IO::Compress::Zip

=over 5

=item Store (0)

=item Deflate (8)

=item Bzip2 (12)

To write Bzip2 content, the module C<IO::Uncompress::Bunzip2> must
be installed.

=item Lzma (14)

To write LZMA content, the module C<IO::Uncompress::UnLzma> must
be installed.

=item Zstandard (93)

To write Zstandard content, the module C<IO::Compress::Zstd> must
be installed.

=item Xz (95)

To write Xz content, the module C<IO::Uncompress::UnXz> must
be installed.

=back

For reading zip files/buffers, see the companion module
L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>.

=head1 Functional Interface

A top-level function, C<zip>, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L</"OO Interface">
section.

    use IO::Compress::Zip qw(zip $ZipError) ;

    zip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
        or die "zip failed: $ZipError\n";

The functional interface needs Perl5.005 or better.

=head2 zip $input_filename_or_reference => $output_filename_or_reference [, OPTS]

C<zip> expects at least two parameters,
C<$input_filename_or_reference> and C<$output_filename_or_reference>
and zero or more optional parameters (see L</Optional Parameters>)

=head3 The C<$input_filename_or_reference> parameter

The parameter, C<$input_filename_or_reference>, is used to define the
source of the uncompressed data.

lib/IO/Compress/Zip.pm  view on Meta::CPAN


This parameter defaults to 0.

=item C<< BinModeIn => 0|1 >>

This option is now a no-op. All files will be read in binmode.

=item C<< Append => 0|1 >>

The behaviour of this option is dependent on the type of output data
stream.

=over 5

=item * A Buffer

If C<Append> is enabled, all compressed data will be append to the end of
the output buffer. Otherwise the output buffer will be cleared before any
compressed data is written to it.

=item * A Filename

If C<Append> is enabled, the file will be opened in append mode. Otherwise
the contents of the file, if any, will be truncated before any compressed
data is written to it.

=item * A Filehandle

If C<Append> is enabled, the filehandle will be positioned to the end of
the file via a call to C<seek> before any compressed data is
written to it.  Otherwise the file pointer will not be moved.

=back

When C<Append> is specified, and set to true, it will I<append> all compressed
data to the output data stream.

So when the output is a filehandle it will carry out a seek to the eof
before writing any compressed data. If the output is a filename, it will be opened for
appending. If the output is a buffer, all compressed data will be
appended to the existing buffer.

Conversely when C<Append> is not specified, or it is present and is set to
false, it will operate as follows.

When the output is a filename, it will truncate the contents of the file
before writing any compressed data. If the output is a filehandle
its position will not be changed. If the output is a buffer, it will be
wiped before any compressed data is output.

Defaults to 0.

=back

=head2 Oneshot Examples

Here are a few example that show the capabilities of the module.

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities of the module.
The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT.

    $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip \*STDIN => \*STDOUT' >output.zip

The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>,
so the above can be rewritten as

    $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-"' >output.zip

One problem with creating a zip archive directly from STDIN can be demonstrated by looking at
the contents of the zip file, output.zip, that we have just created.

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:21
    ---------                     -------
        12                     1 file

The archive member (filename) used is the empty string.

If that doesn't suit your needs, you can explicitly set the filename used
in the zip archive by specifying the L<Name|"File Naming Options"> option, like so

    echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-", Name => "hello.txt"' >output.zip

Now the contents of the zip file looks like this

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:22   hello.txt
    ---------                     -------
        12                     1 file

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.zip>.

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    my $input = "file1.txt";
    zip $input => "$input.zip"
        or die "zip failed: $ZipError\n";

=head3 Reading from a Filehandle and writing to an in-memory buffer

To read from an existing Perl filehandle, C<$input>, and write the
compressed data to a buffer, C<$buffer>.

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;
    use IO::File ;

lib/IO/Compress/Zip.pm  view on Meta::CPAN

This option allow the I<archive member> name to be modified
before it is written to the zip file.

This option takes a parameter that must be a reference to a sub.  On entry
to the sub the C<$_> variable will contain the name to be filtered. If no
filename is available C<$_> will contain an empty string.

The value of C<$_> when the sub returns will be  used as the I<archive member name>.

Note that if C<CanonicalName> is enabled, a
normalized filename will be passed to the sub.

If you use C<FilterName> to modify the filename, it is your responsibility
to keep the filename in Unix format.

Although this option can be used with the OO interface, it is of most use
with the one-shot interface. For example, the code below shows how
C<FilterName> can be used to remove the path component from a series of
filenames before they are stored in C<$zipfile>.

    sub compressTxtFiles
    {
        my $zipfile = shift ;
        my $dir     = shift ;

        zip [ <$dir/*.txt> ] => $zipfile,
            FilterName => sub { s[^$dir/][] } ;
    }

=item C<< Efs => 0|1 >>

This option controls setting of the "Language Encoding Flag" (EFS) in the zip
archive. When set, the filename and comment fields for the zip archive MUST
be valid UTF-8.

If the string used for the filename and/or comment is not valid UTF-8 when this option
is true, the script will die with a "wide character" error.

Note that this option only works with Perl 5.8.4 or better.

This option defaults to B<false>.

=back

=head3 Overall Zip Archive Structure

=over 5

=item C<< Minimal => 1|0 >>

If specified, this option will disable the creation of all extra fields
in the zip local and central headers. So the C<exTime>, C<exUnix2>,
C<exUnixN>, C<ExtraFieldLocal> and C<ExtraFieldCentral> options will
be ignored.

This parameter defaults to 0.

=item C<< Stream => 0|1 >>

This option controls whether the zip file/buffer output is created in
streaming mode.

Note that when outputting to a file with streaming mode disabled (C<Stream>
is 0), the output file must be seekable.

The default is 1.

=item C<< Zip64 => 0|1 >>

Create a Zip64 zip file/buffer. This option is used if you want
to store files larger than 4 Gig or store more than 64K files in a single
zip archive.

C<Zip64> will be automatically set, as needed, if working with the one-shot
interface when the input is either a filename or a scalar reference.

If you intend to manipulate the Zip64 zip files created with this module
using an external zip/unzip, make sure that it supports Zip64.

In particular, if you are using Info-Zip you need to have zip version 3.x
or better to update a Zip64 archive and unzip version 6.x to read a zip64
archive.

The default is 0.

=back

=head3 Deflate Compression Options

=over 5

=item -Level

Defines the compression level used by zlib. The value should either be
a number between 0 and 9 (0 means no compression and 9 is maximum
compression), or one of the symbolic constants defined below.

   Z_NO_COMPRESSION
   Z_BEST_SPEED
   Z_BEST_COMPRESSION
   Z_DEFAULT_COMPRESSION

The default is Z_DEFAULT_COMPRESSION.

Note, these constants are not imported by C<IO::Compress::Zip> by default.

    use IO::Compress::Zip qw(:strategy);
    use IO::Compress::Zip qw(:constants);
    use IO::Compress::Zip qw(:all);

=item -Strategy

Defines the strategy used to tune the compression. Use one of the symbolic
constants defined below.

   Z_FILTERED
   Z_HUFFMAN_ONLY
   Z_RLE
   Z_FIXED
   Z_DEFAULT_STRATEGY

The default is Z_DEFAULT_STRATEGY.

lib/IO/Compress/Zip.pm  view on Meta::CPAN


=item C<< ExtraFieldLocal => $data >>

=item C<< ExtraFieldCentral => $data >>

The C<ExtraFieldLocal> option is used to store additional metadata in the
local header for the zip file/buffer. The C<ExtraFieldCentral> does the
same for the matching central header.

An extra field consists of zero or more subfields. Each subfield consists
of a two byte header followed by the subfield data.

The list of subfields can be supplied in any of the following formats

    ExtraFieldLocal => [$id1, $data1,
                        $id2, $data2,
                         ...
                       ]

    ExtraFieldLocal => [ [$id1 => $data1],
                         [$id2 => $data2],
                         ...
                       ]

    ExtraFieldLocal => { $id1 => $data1,
                         $id2 => $data2,
                         ...
                       }

Where C<$id1>, C<$id2> are two byte subfield ID's.

If you use the hash syntax, you have no control over the order in which
the ExtraSubFields are stored, plus you cannot have SubFields with
duplicate ID.

Alternatively the list of subfields can by supplied as a scalar, thus

    ExtraField => $rawdata

In this case C<IO::Compress::Zip> will check that C<$rawdata> consists of
zero or more conformant sub-fields.

The Extended Time field (ID "UT"), set using the C<exTime> option, and the
Unix2 extra field (ID "Ux), set using the C<exUnix2> option, are examples
of extra fields.

If the C<Minimal> option is set to true, this option will be ignored.

The maximum size of an extra field 65535 bytes.

=item C<< Strict => 0|1 >>

This is a placeholder option.

=back

=head2 Examples

=head3 Streaming

This very simple command line example demonstrates the streaming capabilities
of the module. The code reads data from STDIN or all the files given on the
commandline, compresses it, and writes the compressed data to STDOUT.

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    my $z = IO::Compress::Zip->new("-", Stream => 1)
        or die "IO::Compress::Zip failed: $ZipError\n";

    while (<>) {
        $z->print("abcde");
    }
    $z->close();

Note the use of C<"-"> to means C<STDOUT>. Alternatively you can use C<\*STDOUT>.

One problem with creating a zip archive directly from STDIN can be demonstrated by looking at
the contents of the zip file, output.zip, that we have just created
(assumg you have redirected it to a file called C<output.zip>).

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:21
    ---------                     -------
        12                     1 file

The archive member (filename) used is the empty string.

If that doesn't suit your needs, you can explicitly set the filename used
in the zip archive by specifying the L<Name|"File Naming Options"> option, like so

    my $z = IO::Compress::Zip->new("-", Name => "hello.txt", Stream => 1)

Now the contents of the zip file looks like this

    $ unzip -l output.zip
    Archive:  output.zip
    Length      Date    Time    Name
    ---------  ---------- -----   ----
        12  2019-08-16 22:22   hello.txt
    ---------                     -------
        12                     1 file

=head3 Compressing a file from the filesystem

To read the contents of the file C<file1.txt> and write the compressed
data to the file C<file1.txt.zip> there are a few options

Start by creating the compression object and opening the input file

    use strict ;
    use warnings ;
    use IO::Compress::Zip qw(zip $ZipError) ;

    my $input = "file1.txt";
    my $z = IO::Compress::Zip->new("file1.txt.zip")
        or die "IO::Compress::Zip failed: $ZipError\n";



( run in 0.785 second using v1.01-cache-2.11-cpan-39bf76dae61 )