head

Image

code

root

para

L<Examples| file:../examples/index.podlite>


L<Download |file:../download/index.podlite>


React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


HEADER

FOOTER

README

unit module ZipTest ;


use File::Temp;
use Test ;

my $HERE = $*CWD;
my $UTIL = $HERE ~ '/t/util/' ;
my $ZIPDETAILS = $UTIL ~ 'zipdetails';

sub run-zipdetails(Str:D $zipfile) is export
{
    diag run('perl', $ZIPDETAILS, "-v", $zipfile, :out).out.slurp;
    diag "\n";
    diag run('unzip', '-l', $zipfile, :out).out.slurp ;
}

# Check external zip & unzip are available

my $base_dir = tempdir(:unlink(True));
sub t-file
{
    my ($filename,$filehandle) = tempfile(:tempdir($base_dir));
    close $filehandle;
    return $filename ;
}

my $exe = $*DISTRO.is-win ?? '.exe' !! '';
my $ZIP   = 'zip' ~ $exe ;
my $UNZIP = 'unzip' ~ $exe ;

sub clean-filename(Str:D $filename --> Str:D) 
{
    return $filename
            .chomp
            .subst(/^ <[A..Za..z]> ":" /, '') # remove drive
            .subst(/ '\\' + /, '/', :g) ;     # "\" => "/"
}

sub external-zip-works(--> Bool:D) is export
{
    # my $outfile = t-file() ~ ".zip" ;
    my $outfile = $HERE ~ '/t/test.zip';
    my $content = q:to/EOM/;
        Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id
        dolor. Camelus perlus.  Larrius in lumen numen.  Dolor en quiquum filia
        est.  Quintus cenum parat.
        EOM

    # my $filename = write-file-with-zip($outfile, $content)
    #     or return False;
    my $filename = 'test.txt';

    my $got = pipe-in-from-unzip($outfile)
        or return False;

    if $got ne $content
    {
        diag "Uncompressed content is wrong, got[$got], expected[$content]";
        return False ;
    }

    # Test zipinfo mode
    $got = pipe-in-from-unzip($outfile, :options('-Z1'))
        or return False;

    $filename = clean-filename($filename);

    return True
        if $got.chomp eq $filename ;

    diag "Filenames are wrong, got[$got], expected[$filename]";

    return False ;
}

sub explain-failure($subname, @cmd, Proc $proc)
{
    # caller not supported yet, so pass in the subname
    #diag caller.subname ~ " [@cmd] failed: $!, exitcode { $proc.exitcode }";
    diag $subname ~ " [{@cmd}] failed, exitcode { $proc.exitcode }";
    diag "    out [{ $proc.out.slurp }]" if $proc.out ;
    diag "    err [{ $proc.err.slurp }]" if $proc.err;
}

sub write-file-with-zip($file, $content, $options='-v')
{
    my $infile = t-file ;

    spurt($infile, $content);

    unlink $file ;
    # fz -- force zip64
    # fd -- force descriptors

    my @comp = $ZIP, '-q', $options, $file, $infile ;
    my $proc = run |@comp, :out, :err;

    return $infile but True
        if $proc.exitcode == 0 ;

    explain-failure "write-file-with-zip", @comp, $proc ;

    return False ;
}

sub pipe-in-from-unzip($file, $name='', :$options='', Bool :$binary

False


    my $proc;

    if $binary
        { $proc = run |@comp, :out :err :bin }
    else
        { $proc = run |@comp, :out :err }

    if $proc.exitcode == 0
    {
        return $proc.out.slurp but True
            if ! $binary;

        return $proc.out.read ;

    }

    explain-failure "pipe-in-from-unzip", @comp, $proc ;
    return False ;
}

sub comment-from-unzip($filename) is export
{
    my $data = pipe-in-from-unzip($filename, '', :options('-qz'))
        or return '';

    return $data.chomp;
}

sub test-with-unzip($file) is export
{
    my @comp = $UNZIP, '-t', $file;
    # say "Running [{ @comp }]";
    my $proc = run |@comp, :out, :err ;

    return True
        if $proc.exitcode == 0 ;

    explain-failure "test-with-unzip", @comp, $proc ;
    return False ;
}

sub get-filenames-in-zip($filename --> Seq) is export
{
    my @comp = $UNZIP, '-Z1', $filename ;

    # Get the filenames in Latin1 as a convenient way to get the them as a stream of 8-bit values
    # Means we can handle any badly-formed UTF8 encodngs, either from the zip file itself
    # or from running unzip on it.
    my $proc = run |@comp, :out, :err, :enc('latin1') ;

    if $proc.exitcode
    {
        # special case is empty zip file
        # return code is 1
        if $proc.exitcode == 1 && $proc.out.lines(:chomp) eq 'Empty zipfile.'
        {
            # return empty sequence
            return ().Seq
        }
        else
        {
            explain-failure "test-with-unzip", @comp, $proc ;
            return False ;
        }
    }

    return $proc.out.lines(:chomp) ;
}

sub string-to-binary(Str:D $string --> Buf) is export
{
    # Convert a string into a sequence of bytes
    return Buf[uint8]($string.encode('utf8'));
}

sub unzipToTempDir($file)
{
    my $dir = tempdir(:unlink(True));

    my @comp = $UNZIP, '-d', $dir,  $file;
    say "Running [{ @comp }]";
    my $proc = run |@comp ;

    return $dir
        if $proc.exitcode == 0 ;

    diag "'{ @comp }' failed: $!";
    return False ;
}


#sub testWithFUnzip($file)
#{
#    my $outfile = t-file;
#
#    my $comp = "$UNZIP" ;
#
#    if ( system("$comp -p $file >$outfile") == 0 )
#    {
#        $_[0] = slurp($outfile, :b);
#        return 1
#    }
#
#    diag "'$comp' failed: $?";
#    return False ;
#}
#

#sub unzip64Available returns Bool
#{
#   #my $stuff = `$STRINGS $UNZIP`;
#   my $stuff = `$UNZIP -v`;
#   return $stuff =~ /ZIP64_SUPPORT/;
#}
#
#sub zip64Available returns Bool
#{
#    # return grep { /ZIP64_SUPPORT/ }
#    #       `$STRINGS $UNZIP`;
#   my $stuff = `$ZIP -v`;
#   return $stuff =~ /ZIP64_SUPPORT/;
#}

#sub testWithZip($file)
#{
#    my $outfile = t-file;
#
#    my $status = ( system("$ZIP -T $file >$outfile") == 0 ) ;
#
#    $_[0] = slurp($outfile, :b);
#
#    return $status ;
#}


ZipTest


unit module Archive::SimpleZip:ver<0.6.0>:auth<zef:pmqs>;

need Compress::Zlib;
# need Compress::Bzip2;

use IO::Glob;

use Archive::SimpleZip::Utils ;
use Archive::SimpleZip::Headers ;#:ALL :DEFAULT<Zip-CM>;

# Use CompUnit::Util for now to re-export the Zip-CM enum
# from Archive::SimpleZip::Headers.
# rakudo issue seems to be this ticket: https://github.com/perl6/roast/issues/45
use CompUnit::Util :re-export;
BEGIN re-export('Archive::SimpleZip::Headers');


class SimpleZip does Callable is export
{
    has IO::Handle               $!zip-filehandle ;
    has IO::Path                 $.filename ;
    has Str                      $.comment ;
    has Instant                  $!now = DateTime.now.Instant;
    has Zip-CM                   $!default-method ;
    has Bool                     $!any-zip64 = False;

    # Defaults
    has Bool                     $!zip64 = False ;
    has Bool                     $.default-stream ;
    has Bool                     $.default-canonical ;

    has Central-Header-Directory $!cd .= new() ;

    has Bool                     $!opened = True;

    multi method new(IO:D() $filename, |c)
    {
        my $zip-filehandle = open $filename, :w, :bin ;
        self.bless(:$zip-filehandle, filename => $filename.IO, |c);
    }

    multi submethod BUILD(IO::Handle:D :$!zip-filehandle?,
                          IO::Path:D   :$!filename?,
                          Str:D        :$!comment = "",
                          Bool:D       :stream($!default-stream) = False,
                          Bool:D       :canonical-name($!default-canonical) = True,
                          Zip-CM:D     :method($!default-method) = Zip-CM-Deflate,
                         #Bool:D       :$!zip64   = False,
                         )
    {
        $!any-zip64 = True
            if $!zip64 ;
    }

    # CALL-ME
    multi method CALL-ME(IO() $path, |c --> IO)
    {
        # say "CM [$path] " ~ $path.^name;
        return $path
            unless $path ;

        self.add($path, |c);

        $path;
    }

    multi method CALL-ME(Iterable:D $i, |c --> Seq:D)
    {
        # say "In CALL-ME Iterable ";
        gather {
            $i.map: { self.add($^a, |c) ; take $^a } ;
        }

    }

    # multi method AT-KEY (::?CLASS:D: $key) is rw
    # {

    #     my $self = self;

    #     Proxy.new(
    #         FETCH => method () { $key },

    #         STORE => method ($value) {
    #             $self.create($key, $value);
    #         }
    #     );
    # }

    multi method ASSIGN-KEY (::?CLASS:D: $key, $value)
    {
        self.create($key, $value);
    }

    # method EXISTS-KEY ($key)       {  }
    # method DELETE-KEY ($key)       { }

    # add method deals with file(s) from the filesystem

    multi method add(IO:D() $path, |c --> Int:D)
    {
        if $path.d
        {
            self.mkdir($path, |c)
        }
        else
        {
            # Fail immediately if file doesn't exist or isn't readable
            my $fh = open($path, :r, :bin)
                or fail $fh ;

            self!creater(Str($path), $fh, ! $path.s.Bool, :time($path.modified), |c);
        }
    }

    multi method add(Iterable:D $s, |c --> Int:D)
    {
        my $count = 0;
        $s.map: { samewith($^a, |c) ; ++ $count} ;

        return $count;
    }

    multi method mkdir(Str:D() $name, |c --> Int:D)
    {
        my $p  = -> $compress-chunk {
                       "";
                    } ;

        self!create-zip-entry($p, :name($name), :empty, :is-directory, |c);
    }

    multi method mkdir(Iterable:D $d, |c --> Int:D)
    {
        my $count = 0;
        $d.map: { samewith($^a, |c) ; ++ $count } ;

        return $count;
    }

    method !creater(Str:D() $name, IO::Handle:D  $handle, Bool:D $empty, |c --> Int:D)
    {
        my $p  = -> $compress-chunk {
                        while $handle.read(1024 * 4) -> $chunk
                        {
                            $compress-chunk($chunk);
                        }
                    } ;

        self!create-zip-entry($p, :name($name), :empty($empty), |c);
    }

    multi method create(Str:D() $name, IO::Handle:D  $handle, |c --> Int:D)
    {
        my $p  = -> $compress-chunk {
                        while $handle.read(1024 * 4) -> $chunk
                        {
                            $compress-chunk($chunk);
                        }
                    } ;

        self!create-zip-entry($p, :name($name), |c);
    }

    multi method create(Str:D() $name, IO:D() $path, |c --> Int:D)
    {
        # Fail immediately if file doesn't exist or isn't readable
        my $fh = open($path, :r, :bin)
            or fail $fh ;

        samewith($name, $fh, :time($path.modified), |c);
    }

    multi method create(Str:D() $name, Str:D() $str, |c --> Int:D)
    {
        my $p  = -> $compress-chunk {
                       $compress-chunk($str.encode);
                    } ;
        self!create-zip-entry($p, :name($name), :empty(! $str.elems.Bool), |c);
    }

    multi method create(Str:D() $name, Blob:D() $blob, |c --> Int:D)
    {
        my $p  = -> $compress-chunk {
                        $compress-chunk($blob);
                    } ;
        self!create-zip-entry($p, :name($name), :empty(! $blob.elems.Bool), |c);
    }



    method !create-zip-entry(Code:D        $process-input,
                             Str:D        :$name           = '',
                             Str:D        :$comment        = '',
                             Instant:D    :$time           = $!now,
                             Bool:D       :$stream         = $!default-stream,
                             Bool:D       :$canonical-name = $!default-canonical,
                             Zip-CM:D     :$method         = $!default-method,
                             Bool:D       :$empty          = False,
                             Bool:D       :$is-directory   = False
                             --> Int:D)
    {
        my $compressed-size = 0;
        my $uncompressed-size = 0;
        my $crc32 = 0;
        my $hdr = Local-File-Header.new();

        $hdr.last-mod-file-time = get-DOS-time($time);
        $hdr.compression-method =  $empty ?? Zip-CM-Store !! $method ;

        my Str $filename = $name ;
        $filename = make-canonical-name($filename, $is-directory)
            if $canonical-name ;

        # Check that the filename or comment are 7-bit ASCII.
        # If either is not, set the Language encoding bit
        # in general purpose flags.
        my Bool $high-bit-set = ( ? $filename.ords.first: * > 127 ) ||
                                ( ? $comment.ords.first:  * > 127 );

        $hdr.file-name    = $filename.encode ;
        $hdr.file-comment = $comment.encode;

        $hdr.general-purpose-bit-flag +|= Zip-GP-Streaming-Mask
            if $stream && !$empty ;

        $hdr.general-purpose-bit-flag +|= Zip-GP-Language-Encoding
            if $high-bit-set ;

        my $start-local-hdr-offset = $!zip-filehandle.tell();
        my $local-hdr = $hdr.get();
        $!zip-filehandle.write($local-hdr) ;

        if ! $empty
        {
            # Only jump through copmpression hoops when there
            # is a payload to compress.

            my $compress-action;
            my $flush-action;

            given $method
            {
                when Zip-CM-Deflate
                {
                    my $zlib = Compress::Zlib::Stream.new(:deflate);
                    $compress-action  = -> $in { $zlib.deflate($in) } ;
                    $flush-action     = ->     { $zlib.finish()     } ;
                }

                # when Zip-CM-Bzip2
                # {
                #     my $bzip2 = Compress::Bzip2::Stream.new(:deflate);
                #     $compress-action  = -> $in { $bzip2.compress($in) } ;
                #     $flush-action     = ->     { $bzip2.finish()      } ;
                # }

                when Zip-CM-Store
                {
                    $compress-action  = -> $in { $in         } ;
                    $flush-action     = ->     { Blob.new()  } ;
                }
            }


            # These are done for all compression formats
            my $compress-chunk  = -> $chunk { $uncompressed-size += $chunk.elems;
                                            $crc32 = crc32($crc32, $chunk);
                                            my $out = $compress-action($chunk);
                                            $compressed-size += $out.elems;
                                            $!zip-filehandle.write($out)
                                            } ;

            my $flusher = ->  { my $out = $flush-action();
                                $compressed-size += $out.elems;
                                $!zip-filehandle.write($out)
                            } ;

            $process-input($compress-chunk);
            $flusher();
        }

        $hdr.compressed-size = $compressed-size ;
        $hdr.uncompressed-size = $uncompressed-size;
        $hdr.crc32 = $crc32;

        if ! $empty
        {
            if $stream
            {
                $!zip-filehandle.write($hdr.data-descriptor()) ;
            }
            else
            {
                my $here = $!zip-filehandle.tell();
                $!zip-filehandle.seek($start-local-hdr-offset + 14, SeekFromBeginning);
                $!zip-filehandle.write($hdr.crc-and-sizes());
                $!zip-filehandle.seek($here, SeekFromBeginning);
            }
        }

        $!cd.save-hdr($hdr, $start-local-hdr-offset);

        return 1;
    }

    method close()
    {
        return True
            if ! $!opened;

        $!opened = False;

        my $start-cd = $!zip-filehandle.tell();

        for $!cd.get-hdrs() -> $ch
        {
            $!zip-filehandle.write($ch) ;
        }

        $!zip-filehandle.write($!cd.end-central-directory($start-cd, $.comment.encode));

        $!zip-filehandle.close();

        return True;
    }

    method DESTROY()
    {
        self.close();
    }

}



NAME

SYNOPSIS

# Create a zip archive in the filesystem
my $zip = SimpleZip.new("mine.zip");


# Add a file to the zip archive
# Will read anything that coerced to an IO()
$zip.add("somefile.txt");
$zip.add("somefile.txt".IO);


# Add multiple files in one step
# It will consume anything that is an Iterable
$z.add(@list_of_files);


# Add a glob of files
use IO::Glob;
$zip.add(glob("*.c"));


# When used in a method chain it will accept an Iterable and output a Seq
# here is a somewhat contrived example
glob("*.c").map().sort.$zip.uc.say ;


$zip.create("file1", "payload data here");
$zip.create("file2", Blob.new([2,4,6]));


# Drop a filehandle into the zip archive
my $handle = "some file".IO.open;
$zip.create("file3", $handle);


# below is equivalent to $zip.add: "somefile", name:("file5");
$zip.create("file5"), "somefile".IO;


# but means you can add a file like this as long as the value is an IO
$zip<file6> = "/some/other/file".IO ;


DESCRIPTION

Simple write-only interface to allow creation of Zip files in the filesystem.


Please note - this is module is a prototype. The interface will change.


Takes one mandatoty parameter, namely the name of the zip file to create in the
filesystem, and zero or more optional parameters.


Most of these options control the setting of defaults that will be used in
subsequent calls to the C<add> or C<create> methods.


The default setting can be overridden for an individual member where the
constructor, C<new>, and the C<add>/C<create> methods have an identically named
options.


#  Set the default to make all members in the archive streamed.
my $zip = SimpleZip.new($archive, :stream);


# This uses the default, so is streamed
$zip.add: "file1" ;


# This changes the default, so is NOT streamed
$zip.add("file2".IO, :!stream)  ;


# This uses the default, so is streamed
$zip.add("file3".IO)  ;


Write the zip archive in I<streaming mode>. Default is C<False>.


my $zip = SimpleZip.new($archive, :stream);


Specify the C<stream> option on individual calls to C<add>/C<create> to override
this default.


Used to set the default compression algorithm used for all members of the
archive. If not specified then <Zip-CM-Deflate> is the default.


The exception is when the code is certain there is no payload data to be stored
in the zip archive, in which case C<Zip-CM-Store> will be used.
Examples are for empty files, or directories.


Specify the C<method> option on individual calls to C<add>/C<create> to override
this default.


item

my $zip = SimpleZip.new($archive, :comment<filefile comment>);


Used to set the default for I<normalizing> the I<name> field before it is
written to the zip archive. The normalization carried out involves
converting the name into a Unix-style relative path.


For example, the following shows how to disable the normalization of filenames:


my $zip = SimpleZip.new($archive, :!canonical-name);


Below is what L<APPNOTE.TXT|https://pkware.cachefly.net/webdocs/casestudies/APPNOTE.TXT>
(the specification for Zip archives)
has to say on what should be stored in the zip name header field.


The name of the file, with optional relative path.
The path stored MUST not contain a drive or
device letter, or a leading slash.  All slashes
MUST be forward slashes '/' as opposed to
backwards slashes '\' for compatibility with Amiga
and UNIX file systems etc.


Unless you have a use-case that needs non-standard Zip member names, you
should leave this option well alone.


Unsurprizingly then, the default for this option is C<True>.


Archive::SimpleZip


The Raku Knowledge Base


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


README

Archive::SimpleZip

image i_github_com_pmqs_archive_simplezip_actions_workflows_linux_yml_badge_svg not found

image i_github_com_pmqs_archive_simplezip_actions_workflows_macos_yml_badge_svg not found

image i_github_com_pmqs_archive_simplezip_actions_workflows_windows_yml_badge_svg not found

Synopsis

Description

Installation

Support

License

Archive::SimpleZip v0.6.0

Authors

License

Dependencies

Test Dependencies

Provides

Documentation