view release on metacpan or  search on metacpan

t/010main-unzip.t  view on Meta::CPAN

    my $hour = ( ( $dt >> 11 ) & 0x1f );
    my $min  = ( ( $dt >> 5 ) & 0x3f );
    my $sec  = ( ( $dt << 1 ) & 0x3e );


    use POSIX 'mktime';

    my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 );
    return 0 if ! defined $time_t;
    return $time_t;
}

sub roundTripUnixTime
{
    my $t = shift;
    return unixToDosTime(dosToUnixTime($t));
}

if(1)
{
    title "errors";

    {
        title "no zip filname";
        my $z = Archive::Zip::SimpleUnzip->new() ;

        is $z, undef ;
        is $SimpleUnzipError, "Missing Filename",
            "  missing filename";
    }

    if (1)
    {
        title "directory";
        my $lex = LexDir->new(my $dir);
        my $z = Archive::Zip::SimpleUnzip->new($dir) ;

        is $z, undef ;
        is $SimpleUnzipError, "Illegal Filename",
            "  missing filename";
    }

    {
        title "zip file in directory that doesn't exist";
        my $lex = LexDir->new(my $dir);
        my $zipfile = File::Spec->catfile($dir, "not", "exist", "x.zip");

        my $z = Archive::Zip::SimpleUnzip->new($zipfile) ;

        is $z, undef ;
        like $SimpleUnzipError, qr/cannot open file/,
            "  missing filename";
    }

#    SKIP:
#    {
#        title "file not readable";
#        my $lex = LexFile->new(my $zipfile);

#        chmod 0444, $zipfile
#            or skip "Cannot create non-readable file", 3 ;

#        skip "Cannot create non-readable file", 3
#            if -r $zipfile ;

#        ok ! -r $zipfile, "  zip file not readable";

#        my $z = Archive::Zip::SimpleUnzip->new($zipfile) ;

#        is $z, undef ;
#        is $SimpleUnzipError, "Illegal Filename",
#            "  Illegal Filename";

#        chmod 0777, $zipfile ;
#    }


    {
        title "filename undef";
        my $z = Archive::Zip::SimpleUnzip->new(undef);

        is $z, undef ;
        is $SimpleUnzipError, "Illegal Filename",
            "  missing filename";
    }

    if (0) # TODO
    {
        title "Bad parameter in new";
        my $lex = LexFile->new(my $zipfile);
        eval { my $z = Archive::Zip::SimpleUnzip->new($zipfile, fred => 1) ; };

        like $@,  qr/Archive::Zip::SimpleUnzip: unknown key value(s) fred at/,
            "  value  is bad";

        like $SimpleUnzipError, qr/Archive::Zip::SimpleUnzip: unknown key value(s) fred at/,
            "  missing filename";
    }


}

use Fcntl ':mode';

sub testType
{
    my $object = shift;
    my $expectedType = shift ;

    return $object->isFile()       if $expectedType eq 'file';
    return $object->isDirectory()  if $expectedType eq 'dir';

    die "Bad test '$expectedType'";
}

if (1)
{
    for my $method ( ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_STORE, ZIP_CM_LZMA, ZIP_CM_XZ, ZIP_CM_ZSTD)
    {
        for my $comment ('', "abcde")
        {
            for my $streamed (0, 1)
            {
                for my $to ( qw(filehandle filename buffer))
                {
                    SKIP:
                    for my $zip64 (0, 1)
                    {
                        my $methodName = $methodsAvailable{$method} || '';

                        title "** TO $to, Method $method, Comment '$comment', Streamed $streamed. Zip64 $zip64";

                        skip "Skipping method $methodNames{$method} ($method): No uncompressor installed", 213
                            if ! $methodName ;

t/010main-unzip.t  view on Meta::CPAN

        expectedType($name, $create{$name});

        if ($member->isDirectory())
        {
            ok -d $canonical, "directory $canonical ok" ;
        }
        else
        {
            is readFile($canonical), $create{$name}[0], "$name - payload ok"
        }
        # diag `ls -l ; find . `;

    }

    # Extract by name

    is $unzip->content("fred1"), "abcd1";
    ok $unzip->extract("fred1", "abcd"), "extract to named file";
    # diag `ls -l ; find . -ls`;

    is readFile("abcd"), "abcd1", "abcd - payload ok";

    my $m = $unzip->member("d1/fred2");
    $m->extract("joe");
    is readFile("joe"), "abcd2", "abcd - payload ok";
    exit;
}

{
    title "Extract errors";

    use Cwd;

    my $lex = PushDir->new();

    my $output;
    my $buffer;
    my $zipfile = \$buffer;

    createZipByName($zipfile,
            {
                # name                    payload   type   opts
                "f1"                 => [ "abcd1", 'file', [] ],
                "d1/f2"              => [ "abcd2", 'file', [] ],
                "d2/d3/f2"           => [ "abcd3", 'file', [] ],
                "d3/f3"              => [ "",      'dir',  [] ],
            } ) ;

    my $unzip = Archive::Zip::SimpleUnzip->new($zipfile) ;


    title "output file already exists & is writable, so overwrite";
    my $out = "f1" ;
    writeFile($out, "text");
    ok -e $out ;
    ok $unzip->extract("f1");
    is readFile($out), "abcd1" ;

    title "output file already exists & not-writable";
    writeFile($out, "text");
    chmod 0444, $out ;
    ok ! $unzip->extract("f1");
    # if $SimpleUnzipError, //;
    chmod 0777, $out ;
    is readFile($out), "text" ;

    title "part of output path exists, but is already a file";
    writeFile("d3", "text");
    ok -e $out ;
    ok ! $unzip->extract("d3/f3");
    like $SimpleUnzipError, "/Path is not a directory 'd3'/";
    ok ! -e "d3/f3";
}

sub expectedType
{
    my $name = shift ;
    my $data = shift ;

    ok -f $name, "$name is a file" if $data->[1] eq 'file';
    ok -d $name, "$name is a dir"  if $data->[1] eq 'dir';
}

my $TestZipsDir = "./t/test-zips/";


if (1)
{
    title "jar file with deflated directory";

    # Create Jar as follow
    #   echo test > file && jar c file > jar.zip

    # Note the deflated directory META-INF with length 0 & size 2
    #
    # $ unzip -vl t/files/jar.zip
    # Archive:  t/files/jar.zip
    #  Length   Method    Size  Cmpr    Date    Time   CRC-32   Name
    # --------  ------  ------- ---- ---------- ----- --------  ----
    #        0  Defl:N        2   0% 2019-09-07 22:35 00000000  META-INF/
    #       54  Defl:N       53   2% 2019-09-07 22:35 934e49ff  META-INF/MANIFEST.MF
    #        5  Defl:N        7 -40% 2019-09-07 22:35 3bb935c6  file
    # --------          -------  ---                            -------
    #       59               62  -5%                            3 files

    my $zipfile = "./t/files/jar.zip" ;
    my $z = Archive::Zip::SimpleUnzip->new($zipfile)
        or diag $SimpleUnzipError ;
    isa_ok $z, "Archive::Zip::SimpleUnzip";

    my $lex = PushDir->new();

    ok ! -d "META-INF" ;

    ok $z->extract("META-INF/")
        or diag $SimpleUnzipError ;

    ok -d "META-INF" ;

    my $member = $z->member("META-INF/");
    isa_ok $member, "Archive::Zip::SimpleUnzip::Member";

    ok $member->isDirectory();
}