1BEGIN {
2    if ($ENV{PERL_CORE}) {
3        chdir 't' if -d 't';
4        @INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use File::Spec ;
15use CompTestUtils;
16
17BEGIN {
18    plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
19        if $] < 5.005 ;
20
21
22    # use Test::NoWarnings, if available
23    my $extra = 0 ;
24    $extra = 1
25        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
26
27    plan tests => 219 + $extra ;
28
29    #use_ok('IO::Compress::Zip', qw(zip $ZipError :zip_method)) ;
30    use_ok('IO::Compress::Zip', qw(:all)) ;
31    use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
32}
33
34
35sub zipGetHeader
36{
37    my $in = shift;
38    my $content = shift ;
39    my %opts = @_ ;
40
41    my $out ;
42    my $got ;
43
44    ok zip($in, \$out, %opts), "  zip ok" ;
45    ok unzip(\$out, \$got), "  unzip ok"
46        or diag $UnzipError ;
47    is $got, $content, "  got expected content" ;
48
49    my $gunz = new IO::Uncompress::Unzip \$out, Strict => 0
50        or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ;
51    ok $gunz, "  Created IO::Uncompress::Unzip object";
52    my $hdr = $gunz->getHeaderInfo();
53    ok $hdr, "  got Header info";
54    my $uncomp ;
55    ok $gunz->read($uncomp), " read ok" ;
56    is $uncomp, $content, "  got expected content";
57    ok $gunz->close, "  closed ok" ;
58
59    return $hdr ;
60
61}
62
63{
64    title "Check zip header default NAME & MTIME settings" ;
65
66    my $lex = new LexFile my $file1;
67
68    my $content = "hello ";
69    my $hdr ;
70    my $mtime ;
71
72    writeFile($file1, $content);
73    $mtime = (stat($file1))[9];
74    # make sure that the zip file isn't created in the same
75    # second as the input file
76    sleep 3 ;
77    $hdr = zipGetHeader($file1, $content);
78
79    is $hdr->{Name}, $file1, "  Name is '$file1'";
80    is $hdr->{Time}>>1, $mtime>>1, "  Time is ok";
81
82    title "Override Name" ;
83
84    writeFile($file1, $content);
85    $mtime = (stat($file1))[9];
86    sleep 3 ;
87    $hdr = zipGetHeader($file1, $content, Name => "abcde");
88
89    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
90    is $hdr->{Time} >> 1, $mtime >> 1, "  Time is ok";
91
92    title "Override Time" ;
93
94    writeFile($file1, $content);
95    my $useTime = time + 2000 ;
96    $hdr = zipGetHeader($file1, $content, Time => $useTime);
97
98    is $hdr->{Name}, $file1, "  Name is '$file1'" ;
99    is $hdr->{Time} >> 1 , $useTime >> 1 ,  "  Time is $useTime";
100
101    title "Override Name and Time" ;
102
103    $useTime = time + 5000 ;
104    writeFile($file1, $content);
105    $hdr = zipGetHeader($file1, $content, Time => $useTime, Name => "abcde");
106
107    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
108    is $hdr->{Time} >> 1 , $useTime >> 1 , "  Time is $useTime";
109
110    title "Filehandle doesn't have default Name or Time" ;
111    my $fh = new IO::File "< $file1"
112        or diag "Cannot open '$file1': $!\n" ;
113    sleep 3 ;
114    my $before = time ;
115    $hdr = zipGetHeader($fh, $content);
116    my $after = time ;
117
118    ok ! defined $hdr->{Name}, "  Name is undef";
119    cmp_ok $hdr->{Time} >> 1, '>=', $before >> 1, "  Time is ok";
120    cmp_ok $hdr->{Time} >> 1, '<=', $after >> 1, "  Time is ok";
121
122    $fh->close;
123
124    title "Buffer doesn't have default Name or Time" ;
125    my $buffer = $content;
126    $before = time ;
127    $hdr = zipGetHeader(\$buffer, $content);
128    $after = time ;
129
130    ok ! defined $hdr->{Name}, "  Name is undef";
131    cmp_ok $hdr->{Time} >> 1, '>=', $before >> 1, "  Time is ok";
132    cmp_ok $hdr->{Time} >> 1, '<=', $after >> 1, "  Time is ok";
133}
134
135{
136    title "Check CanonicalName & FilterName";
137
138    my $lex = new LexFile my $file1;
139
140    my $content = "hello" ;
141    writeFile($file1, $content);
142    my $hdr;
143
144    my $abs = File::Spec->catfile("", "fred", "joe");
145    $hdr = zipGetHeader($file1, $content, Name => $abs, CanonicalName => 1) ;
146    is $hdr->{Name}, "fred/joe", "  Name is 'fred/joe'" ;
147
148    $hdr = zipGetHeader($file1, $content, Name => $abs, CanonicalName => 0) ;
149    is $hdr->{Name}, File::Spec->catfile("", "fred", "joe"), "  Name is '/fred/joe'" ;
150
151    $hdr = zipGetHeader($file1, $content, FilterName => sub {$_ = "abcde"});
152    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
153
154    $hdr = zipGetHeader($file1, $content, Name => $abs,
155         CanonicalName => 1,
156         FilterName => sub { s/joe/jim/ });
157    is $hdr->{Name}, "fred/jim", "  Name is 'fred/jim'" ;
158
159    $hdr = zipGetHeader($file1, $content, Name => $abs,
160         CanonicalName => 0,
161         FilterName => sub { s/joe/jim/ });
162    is $hdr->{Name}, File::Spec->catfile("", "fred", "jim"), "  Name is '/fred/jim'" ;
163}
164
165for my $stream (0, 1)
166{
167    for my $zip64 (0, 1)
168    {
169        #next if $zip64 && ! $stream;
170
171        for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
172        {
173
174            title "Stream $stream, Zip64 $zip64, Method $method";
175
176            my $lex = new LexFile my $file1;
177
178            my $content = "hello ";
179            #writeFile($file1, $content);
180
181            my $status = zip(\$content => $file1 ,
182                               Method => $method,
183                               Stream => $stream,
184                               Zip64  => $zip64);
185
186             ok $status, "  zip ok"
187                or diag $ZipError ;
188
189            my $got ;
190            ok unzip($file1 => \$got), "  unzip ok"
191                or diag $UnzipError ;
192
193            is $got, $content, "  content ok";
194
195            my $u = new IO::Uncompress::Unzip $file1
196                or diag $ZipError ;
197
198            my $hdr = $u->getHeaderInfo();
199            ok $hdr, "  got header";
200
201            is $hdr->{Stream}, $stream, "  stream is $stream" ;
202            is $hdr->{MethodID}, $method, "  MethodID is $method" ;
203            is $hdr->{Zip64}, $zip64, "  Zip64 is $zip64" ;
204        }
205    }
206}
207
208for my $stream (0, 1)
209{
210    for my $zip64 (0, 1)
211    {
212        next if $zip64 && ! $stream;
213        for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
214        {
215            title "Stream $stream, Zip64 $zip64, Method $method";
216
217            my $file1;
218            my $file2;
219            my $zipfile;
220            my $lex = new LexFile $file1, $file2, $zipfile;
221
222            my $content1 = "hello ";
223            writeFile($file1, $content1);
224
225            my $content2 = "goodbye ";
226            writeFile($file2, $content2);
227
228            my %content = ( $file1 => $content1,
229                            $file2 => $content2,
230                          );
231
232            ok zip([$file1, $file2] => $zipfile , Method => $method,
233                                                  Zip64  => $zip64,
234                                                  Stream => $stream), " zip ok"
235                or diag $ZipError ;
236
237            for my $file ($file1, $file2)
238            {
239                my $got ;
240                ok unzip($zipfile => \$got, Name => $file), "  unzip $file ok"
241                    or diag $UnzipError ;
242
243                is $got, $content{$file}, "  content ok";
244            }
245        }
246    }
247}
248
249{
250    title "Regression: ods streaming issue";
251
252    # The file before meta.xml in test.ods is content.xml.
253    # Issue was triggered because content.xml was stored
254    # as streamed and the code to walk the compressed streaming
255    # content assumed that all of the input buffer was consumed
256    # in a single call to "uncompr".
257
258    my $files = "./t/" ;
259    $files = "./" if $ENV{PERL_CORE} ;
260    $files .= "files/";
261
262    my $zipfile = "$files/test.ods" ;
263    my $file = "meta.xml";
264
265    my $got;
266
267    ok unzip($zipfile => \$got, Name => $file), "  unzip $file ok"
268        or diag $UnzipError ;
269
270    my $meta = readFile("$files/$file");
271    is $got, $meta, "  content ok";
272}
273
274# TODO add more error cases
275
276