head

code

item

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

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

usage

new tar

crusty tar

limitations

Archive::Tar::PP vv0.0.1

Authors

License

Dependencies

Test Dependencies

Provides

Documentation