Commit | Line | Data |
---|---|---|
25f0751f PM |
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 PM |
28 | #use_ok('IO::Compress::Zip', qw(zip $ZipError :zip_method)) ; |
29 | use_ok('IO::Compress::Zip', qw(:all)) ; | |
25f0751f PM |
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 PM |
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 PM |
149 | my $content = "hello "; |
150 | #writeFile($file1, $content); | |
25f0751f | 151 | |
e7d45986 PM |
152 | my $status = zip(\$content => $file1 , |
153 | Method => $method, | |
154 | Stream => $stream, | |
155 | Zip64 => $zip64); | |
25f0751f | 156 | |
e7d45986 PM |
157 | ok $status, " zip ok" |
158 | or diag $ZipError ; | |
25f0751f | 159 | |
e7d45986 PM |
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 PM |
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 PM |
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 PM |
184 | } |
185 | } | |
186 | ||
4d91e282 PM |
187 | for my $stream (0, 1) |
188 | { | |
e7d45986 | 189 | for my $zip64 (0, 1) |
4d91e282 | 190 | { |
e7d45986 PM |
191 | next if $zip64 && ! $stream; |
192 | for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE) | |
4d91e282 | 193 | { |
e7d45986 PM |
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 PM |
232 | } |
233 | } | |
234 | } | |
235 | ||
25f0751f PM |
236 | # TODO add more error cases |
237 |