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