Commit | Line | Data |
1a6a8453 |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { |
3 | chdir 't' if -d 't'; |
4 | @INC = ("../lib", "lib/compress"); |
5 | } |
6 | } |
7 | |
8 | use lib 't'; |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use ZlibTestUtils; |
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 | |
26 | plan tests => 95 + $extra ; |
27 | |
28 | use_ok('IO::Compress::Zip', qw(zip $ZipError)) ; |
29 | use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; |
30 | |
31 | |
32 | } |
33 | |
34 | |
35 | sub 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); |
204a02c3 |
73 | $mtime = (stat($file1))[9]; |
1a6a8453 |
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); |
204a02c3 |
85 | $mtime = (stat($file1))[9]; |
1a6a8453 |
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 | for my $stream (0, 1) |
136 | { |
137 | for my $store (0, 8) |
138 | { |
139 | title "Stream $stream, Store $store"; |
140 | |
141 | my $lex = new LexFile my $file1; |
142 | |
143 | my $content = "hello "; |
144 | writeFile($file1, $content); |
145 | |
146 | ok zip(\$content => $file1 , Store => !$store, Stream => $stream), " zip ok" |
147 | or diag $ZipError ; |
148 | |
149 | my $got ; |
150 | if ($stream && ! $store) { |
151 | #eval ' unzip($file1 => \$got) '; |
152 | ok ! unzip($file1 => \$got), " unzip fails"; |
153 | like $UnzipError, "/Streamed Stored content not supported/", |
154 | " Streamed Stored content not supported"; |
155 | next ; |
156 | } |
157 | |
158 | ok unzip($file1 => \$got), " unzip ok" |
159 | or diag $UnzipError ; |
160 | |
161 | is $got, $content, " content ok"; |
162 | |
163 | my $u = new IO::Uncompress::Unzip $file1 |
164 | or diag $ZipError ; |
165 | |
166 | my $hdr = $u->getHeaderInfo(); |
167 | ok $hdr, " got header"; |
168 | |
169 | is $hdr->{Stream}, $stream, " stream is $stream" ; |
170 | is $hdr->{MethodID}, $store, " MethodID is $store" ; |
171 | } |
172 | } |
173 | |
174 | # TODO add more error cases |
175 | |