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 | |
4d91e282 |
26 | plan tests => 119 + $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 | { |
2b4e0969 |
138 | for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE) |
25f0751f |
139 | { |
2b4e0969 |
140 | title "Stream $stream, Method $method"; |
25f0751f |
141 | |
142 | my $lex = new LexFile my $file1; |
143 | |
144 | my $content = "hello "; |
4d91e282 |
145 | #writeFile($file1, $content); |
25f0751f |
146 | |
2b4e0969 |
147 | ok zip(\$content => $file1 , Method => $method, Stream => $stream), " zip ok" |
25f0751f |
148 | or diag $ZipError ; |
149 | |
150 | my $got ; |
2b4e0969 |
151 | if ($stream && $method == ZIP_CM_STORE ) { |
25f0751f |
152 | #eval ' unzip($file1 => \$got) '; |
153 | ok ! unzip($file1 => \$got), " unzip fails"; |
154 | like $UnzipError, "/Streamed Stored content not supported/", |
155 | " Streamed Stored content not supported"; |
156 | next ; |
157 | } |
158 | |
159 | ok unzip($file1 => \$got), " unzip ok" |
160 | or diag $UnzipError ; |
161 | |
162 | is $got, $content, " content ok"; |
163 | |
164 | my $u = new IO::Uncompress::Unzip $file1 |
165 | or diag $ZipError ; |
166 | |
167 | my $hdr = $u->getHeaderInfo(); |
168 | ok $hdr, " got header"; |
169 | |
170 | is $hdr->{Stream}, $stream, " stream is $stream" ; |
2b4e0969 |
171 | is $hdr->{MethodID}, $method, " MethodID is $method" ; |
25f0751f |
172 | } |
173 | } |
174 | |
4d91e282 |
175 | for my $stream (0, 1) |
176 | { |
2b4e0969 |
177 | for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE) |
4d91e282 |
178 | { |
2b4e0969 |
179 | title "Stream $stream, Method $method"; |
4d91e282 |
180 | |
181 | my $file1; |
182 | my $file2; |
183 | my $zipfile; |
184 | my $lex = new LexFile $file1, $file2, $zipfile; |
185 | |
186 | my $content1 = "hello "; |
187 | writeFile($file1, $content1); |
188 | |
189 | my $content2 = "goodbye "; |
190 | writeFile($file2, $content2); |
191 | |
192 | my %content = ( $file1 => $content1, |
193 | $file2 => $content2, |
194 | ); |
195 | |
2b4e0969 |
196 | ok zip([$file1, $file2] => $zipfile , Method => $method, Stream => $stream), " zip ok" |
4d91e282 |
197 | or diag $ZipError ; |
198 | |
199 | for my $file ($file1, $file2) |
200 | { |
201 | my $got ; |
2b4e0969 |
202 | if ($stream && $method == ZIP_CM_STORE ) { |
4d91e282 |
203 | #eval ' unzip($zipfile => \$got) '; |
204 | ok ! unzip($zipfile => \$got, Name => $file), " unzip fails"; |
205 | like $UnzipError, "/Streamed Stored content not supported/", |
206 | " Streamed Stored content not supported"; |
207 | next ; |
208 | } |
209 | |
210 | ok unzip($zipfile => \$got, Name => $file), " unzip $file ok" |
211 | or diag $UnzipError ; |
212 | |
213 | is $got, $content{$file}, " content ok"; |
214 | } |
215 | } |
216 | } |
217 | |
25f0751f |
218 | # TODO add more error cases |
219 | |