File: 107multi-zip-only.t

package info (click to toggle)
perl 5.32.1-4%2Bdeb11u3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 113,408 kB
  • sloc: ansic: 641,443; perl: 491,650; sh: 70,967; pascal: 8,354; cpp: 4,103; xml: 2,428; makefile: 2,237; yacc: 1,173; lisp: 1
file content (102 lines) | stat: -rw-r--r-- 1,903 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

use strict;
use warnings;

BEGIN {
    if ($ENV{PERL_CORE}) {
        chdir 't' if -d 't';
        @INC = ("../lib", "lib/compress");
    }
}

use lib qw(t t/compress);


use Test::More ;
use CompTestUtils;

BEGIN {
    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };

    plan tests => 21 + $extra ;

    use_ok('IO::Compress::Zip', qw(zip $ZipError)) ;

    use_ok('IO::Uncompress::Unzip', qw($UnzipError)) ;
    use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ;

}

    my @buffers ;
    push @buffers, <<EOM ;
hello world
this is a test
some more stuff on this line
ad finally...
EOM

    push @buffers, <<EOM ;
some more stuff
line 2
EOM

    push @buffers, <<EOM ;
even more stuff
EOM


my $name = "n1";
my $lex = new LexFile my $zipfile ;

my $x = new IO::Compress::Zip($zipfile, Name => $name++, AutoClose => 1);
isa_ok $x, 'IO::Compress::Zip', '  $x' ;


foreach my $buffer (@buffers) {
    ok $x->write($buffer), "    Write OK" ;
    # this will add an extra "empty" stream
    ok $x->newStream(Name => $name ++), "    newStream OK" ;
}
ok $x->close, "  Close ok" ;

push @buffers, undef;

{
    open F, ">>$zipfile";
    print F "trailing";
    close F;                    
}

my $u = new IO::Uncompress::Unzip $zipfile, Transparent => 1, MultiStream => 0
    or die "Cannot open $zipfile: $UnzipError";

my @names ;
my $status;
my $expname = "n1";
my $ix = 0;

for my $ix (1 .. 4)
{
    local $/ ;

    my $n = $u->getHeaderInfo()->{Name};
    is $n, $expname , "name is $expname";
    is <$u>, $buffers[$ix-1], "payload ok";
    ++ $expname;

    $status = $u->nextStream()
}

{
    local $/ ;

    my $n = $u->getHeaderInfo()->{Name};
    is $n, undef , "name is undef";
    is <$u>, "trailing", "payload ok";
}

die "Error processing $zipfile: $!\n"
    if $status < 0 ;