line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Archive::Zip::SimpleUnzip; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require 5.006; |
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
1817
|
use strict ; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
63
|
|
6
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
49
|
|
7
|
2
|
|
|
2
|
|
10
|
use bytes; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
9
|
|
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
45
|
use IO::File; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
366
|
|
10
|
2
|
|
|
2
|
|
16
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
116
|
|
11
|
2
|
|
|
2
|
|
13
|
use Scalar::Util (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
71
|
|
12
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
12
|
use IO::Compress::Base::Common 2.096 qw(:Status); |
|
2
|
|
|
|
|
52
|
|
|
2
|
|
|
|
|
275
|
|
14
|
2
|
|
|
2
|
|
15
|
use IO::Compress::Zip::Constants 2.096 ; |
|
2
|
|
|
|
|
37
|
|
|
2
|
|
|
|
|
551
|
|
15
|
2
|
|
|
2
|
|
16
|
use IO::Uncompress::Unzip 2.096 ; |
|
2
|
|
|
|
|
43
|
|
|
2
|
|
|
|
|
756
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
require Exporter ; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $SimpleUnzipError); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$VERSION = '0.040'; |
23
|
|
|
|
|
|
|
$SimpleUnzipError = ''; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
@ISA = qw(IO::Uncompress::Unzip Exporter); |
26
|
|
|
|
|
|
|
@EXPORT_OK = qw( $SimpleUnzipError unzip ); |
27
|
|
|
|
|
|
|
%EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ; |
28
|
|
|
|
|
|
|
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; |
29
|
|
|
|
|
|
|
Exporter::export_ok_tags('all'); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
our %PARAMS = ( |
32
|
|
|
|
|
|
|
'filesonly' => [IO::Compress::Base::Common::Parse_boolean, 0], |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub _ckParams |
36
|
|
|
|
|
|
|
{ |
37
|
169
|
|
|
169
|
|
683
|
my $got = IO::Compress::Base::Parameters::new(); |
38
|
|
|
|
|
|
|
|
39
|
169
|
50
|
|
|
|
3403
|
$got->parse(\%PARAMS, @_) |
40
|
|
|
|
|
|
|
or _myDie("Parameter Error: " . $got->getError()) ; |
41
|
|
|
|
|
|
|
|
42
|
169
|
|
|
|
|
14064
|
return $got; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub _setError |
46
|
|
|
|
|
|
|
{ |
47
|
256
|
|
|
256
|
|
798
|
$SimpleUnzipError = $_[2] ; |
48
|
256
|
50
|
|
|
|
838
|
$_[0]->{Error} = $_[2] |
49
|
|
|
|
|
|
|
if defined $_[0] ; |
50
|
|
|
|
|
|
|
|
51
|
256
|
|
|
|
|
1152
|
return $_[1]; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub _myDie |
55
|
|
|
|
|
|
|
{ |
56
|
0
|
|
|
0
|
|
0
|
$SimpleUnzipError = $_[0]; |
57
|
0
|
|
|
|
|
0
|
Carp::croak $_[0]; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _illegalFilename |
61
|
|
|
|
|
|
|
{ |
62
|
2
|
|
|
2
|
|
5
|
return _setError(undef, undef, "Illegal Filename") ; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub is64BitPerl |
66
|
|
|
|
|
|
|
{ |
67
|
2
|
|
|
2
|
|
16
|
use Config; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
4721
|
|
68
|
|
|
|
|
|
|
# possibly use presence of pack/unpack "Q" for int size test? |
69
|
0
|
0
|
|
0
|
0
|
0
|
$Config{lseeksize} >= 8 and $Config{uvsize} >= 8; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub new |
73
|
|
|
|
|
|
|
{ |
74
|
173
|
|
|
173
|
1
|
5689
|
my $class = shift ; |
75
|
|
|
|
|
|
|
|
76
|
173
|
100
|
|
|
|
675
|
return _setError(undef, undef, "Missing Filename") |
77
|
|
|
|
|
|
|
unless @_ ; |
78
|
|
|
|
|
|
|
|
79
|
172
|
|
|
|
|
447
|
my $inValue = shift ; |
80
|
172
|
|
|
|
|
276
|
my $fh; |
81
|
|
|
|
|
|
|
|
82
|
172
|
100
|
|
|
|
536
|
if (!defined $inValue) |
83
|
|
|
|
|
|
|
{ |
84
|
1
|
|
|
|
|
3
|
return _illegalFilename |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
171
|
|
|
|
|
677
|
my $isSTDOUT = ($inValue eq '-') ; |
88
|
171
|
|
|
|
|
1078
|
my $inType = IO::Compress::Base::Common::whatIsOutput($inValue); |
89
|
|
|
|
|
|
|
|
90
|
171
|
100
|
33
|
|
|
8306
|
if ($inType eq 'filename') |
|
|
50
|
|
|
|
|
|
91
|
|
|
|
|
|
|
{ |
92
|
114
|
100
|
66
|
|
|
5234
|
if (-e $inValue && ( ! -f _ || ! -r _)) |
|
|
|
100
|
|
|
|
|
93
|
|
|
|
|
|
|
{ |
94
|
1
|
|
|
|
|
5
|
return _illegalFilename |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
113
|
100
|
|
|
|
1565
|
$fh = new IO::File "<$inValue" |
98
|
|
|
|
|
|
|
or return _setError(undef, undef, "cannot open file '$inValue': $!"); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
elsif( $inType eq 'buffer' || $inType eq 'handle') |
101
|
|
|
|
|
|
|
{ |
102
|
57
|
|
|
|
|
197
|
$fh = $inValue; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
else |
105
|
|
|
|
|
|
|
{ |
106
|
0
|
|
|
|
|
0
|
return _illegalFilename |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
169
|
|
|
|
|
12666
|
my %obj ; |
110
|
|
|
|
|
|
|
|
111
|
169
|
|
|
|
|
756
|
my $got = _ckParams(@_); |
112
|
169
|
|
|
|
|
775
|
my $filesOnly = $got->getValue('filesonly'); |
113
|
|
|
|
|
|
|
|
114
|
169
|
|
|
|
|
1308
|
my $inner = IO::Compress::Base::Common::createSelfTiedObject($class, \$SimpleUnzipError); |
115
|
|
|
|
|
|
|
|
116
|
169
|
|
|
|
|
8899
|
*$inner->{Pause} = 1; |
117
|
169
|
50
|
|
|
|
911
|
$inner->_create(undef, 0, $fh) |
118
|
|
|
|
|
|
|
or return undef; |
119
|
|
|
|
|
|
|
|
120
|
169
|
|
|
|
|
2249
|
my ($CD, $Members, $comment) = $inner->scanCentralDirectory($filesOnly); |
121
|
169
|
|
|
|
|
530
|
$obj{CD} = $CD; |
122
|
169
|
|
|
|
|
394
|
$obj{Members} = $Members ; |
123
|
169
|
|
|
|
|
490
|
$obj{Comment} = $comment; |
124
|
169
|
|
|
|
|
299
|
$obj{Cursor} = 0; |
125
|
169
|
|
|
|
|
305
|
$obj{Inner} = $inner; |
126
|
169
|
|
|
|
|
295
|
$obj{Open} = 1 ; |
127
|
|
|
|
|
|
|
|
128
|
169
|
|
|
|
|
1623
|
bless \%obj, $class; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub close |
132
|
|
|
|
|
|
|
{ |
133
|
84
|
|
|
84
|
1
|
54886
|
my $self = shift; |
134
|
|
|
|
|
|
|
# TODO - fix me |
135
|
|
|
|
|
|
|
# $self->{Inner}->close(); |
136
|
84
|
|
|
|
|
328
|
return 1; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub DESTROY |
140
|
|
|
|
|
|
|
{ |
141
|
338
|
|
|
338
|
|
29063
|
my $self = shift; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub resetter |
145
|
|
|
|
|
|
|
{ |
146
|
1864
|
|
|
1864
|
0
|
2643
|
my $inner = shift; |
147
|
1864
|
|
|
|
|
2057
|
my $member = shift; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
1864
|
|
|
|
|
3357
|
*$inner->{NewStream} = 0 ; |
151
|
1864
|
|
|
|
|
2495
|
*$inner->{EndStream} = 0 ; |
152
|
1864
|
|
|
|
|
3061
|
*$inner->{TotalInflatedBytesRead} = 0; |
153
|
1864
|
|
|
|
|
3249
|
*$inner->{Info}{TrailerLength} = 0; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# disable streaming if present & set sizes from central dir |
156
|
|
|
|
|
|
|
# TODO - this will only allow a single file to be read at a time. |
157
|
|
|
|
|
|
|
# police it or fix it. |
158
|
1864
|
|
|
|
|
2941
|
*$inner->{ZipData}{Streaming} = 0; |
159
|
1864
|
|
|
|
|
3336
|
*$inner->{ZipData}{Crc32} = $member->{CRC32}; |
160
|
1864
|
|
|
|
|
3650
|
*$inner->{ZipData}{CompressedLen} = $member->{CompressedLength}; |
161
|
1864
|
|
|
|
|
2983
|
*$inner->{ZipData}{UnCompressedLen} = $member->{UncompressedLength}; |
162
|
|
|
|
|
|
|
*$inner->{CompressedInputLengthRemaining} = |
163
|
1864
|
|
|
|
|
3710
|
*$inner->{CompressedInputLength} = $member->{CompressedLength}; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub _readLocalHeader |
167
|
|
|
|
|
|
|
{ |
168
|
765
|
|
|
765
|
|
1375
|
my $self = shift; |
169
|
765
|
|
|
|
|
1028
|
my $member = shift; |
170
|
|
|
|
|
|
|
|
171
|
765
|
|
|
|
|
1434
|
my $inner = $self->{Inner}; |
172
|
|
|
|
|
|
|
|
173
|
765
|
|
|
|
|
1978
|
resetter($inner, $member); |
174
|
|
|
|
|
|
|
|
175
|
765
|
|
|
|
|
3271
|
my $status = $inner->smartSeek($member->{LocalHeaderOffset}, 0, SEEK_SET); |
176
|
765
|
|
|
|
|
22672
|
$inner->_readFullZipHeader() ; |
177
|
765
|
|
|
|
|
468007
|
$member->{DataOffset} = $inner->smartTell(); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub comment |
181
|
|
|
|
|
|
|
{ |
182
|
168
|
|
|
168
|
1
|
163117
|
my $self = shift; |
183
|
|
|
|
|
|
|
|
184
|
168
|
|
|
|
|
1150
|
return $self->{Comment} ; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub _mkMember |
188
|
|
|
|
|
|
|
{ |
189
|
765
|
|
|
765
|
|
1230
|
my $self = shift; |
190
|
765
|
|
|
|
|
1088
|
my $member = shift; |
191
|
|
|
|
|
|
|
|
192
|
765
|
|
|
|
|
2385
|
$self->_readLocalHeader($member); |
193
|
|
|
|
|
|
|
|
194
|
765
|
|
|
|
|
10901
|
my %member ; |
195
|
765
|
|
|
|
|
1959
|
$member{Inner} = $self->{Inner}; |
196
|
765
|
|
|
|
|
1423
|
$member{Info} = $member; |
197
|
|
|
|
|
|
|
#Scalar::Util::weaken $member{Inner}; # for 5.8 |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
|
200
|
765
|
|
|
|
|
4946
|
return bless \%member, 'Archive::Zip::SimpleUnzip::Member'; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub member |
204
|
|
|
|
|
|
|
{ |
205
|
591
|
|
|
591
|
1
|
20160
|
my $self = shift; |
206
|
591
|
|
|
|
|
862
|
my $name = shift; |
207
|
|
|
|
|
|
|
|
208
|
591
|
50
|
|
|
|
1600
|
return _setError(undef, undef, "Member '$name' not in zip") |
209
|
|
|
|
|
|
|
if ! defined $name ; |
210
|
|
|
|
|
|
|
|
211
|
591
|
|
|
|
|
1368
|
my $member = $self->{Members}{$name}; |
212
|
|
|
|
|
|
|
|
213
|
591
|
100
|
|
|
|
2161
|
return _setError(undef, undef, "Member '$name' not in zip") |
214
|
|
|
|
|
|
|
if ! defined $member ; |
215
|
|
|
|
|
|
|
|
216
|
339
|
|
|
|
|
824
|
return $self->_mkMember($member) ; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub open |
220
|
|
|
|
|
|
|
{ |
221
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
222
|
0
|
|
|
|
|
0
|
my $name = shift; |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
my $member = $self->{Members}{$name}; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# TODO - get to return unef |
227
|
0
|
0
|
|
|
|
0
|
die "Member '$name' not in zip file\n" |
228
|
|
|
|
|
|
|
if ! defined $member ; |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
0
|
$self->_readLocalHeader($member); |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# return $self->{Inner}; |
233
|
0
|
|
|
|
|
0
|
my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::SimpleUnzip::Handle", \$SimpleUnzipError) ; |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
0
|
*$z->{Open} = 1 ; |
236
|
0
|
|
|
|
|
0
|
*$z->{SZ} = $self->{Inner}; |
237
|
0
|
|
|
|
|
0
|
Scalar::Util::weaken *$z->{SZ}; # for 5.8 |
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
0
|
$z; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub extract # to file - return actual path or pass/fail? |
243
|
|
|
|
|
|
|
{ |
244
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
245
|
1
|
|
|
|
|
8
|
my $name = shift; |
246
|
1
|
|
|
|
|
4
|
my $out = shift; |
247
|
|
|
|
|
|
|
|
248
|
1
|
50
|
|
|
|
6
|
my $member = $self->member($name) |
249
|
|
|
|
|
|
|
or return undef ; |
250
|
|
|
|
|
|
|
|
251
|
1
|
50
|
|
|
|
7
|
return $member->extract(defined $out ? $out : $name); |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub getCanonicalPath |
255
|
|
|
|
|
|
|
{ |
256
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
257
|
0
|
|
|
|
|
0
|
my $name = shift; |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
0
|
return _canonicalPath($name); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub _isDirectory |
265
|
|
|
|
|
|
|
{ |
266
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
267
|
0
|
|
|
|
|
0
|
my $name = shift ; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
return substr($name, -1, 1) eq '/' && |
270
|
0
|
|
0
|
|
|
0
|
$self->{Info}{UncompressedLength} == 0 ; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub content |
274
|
|
|
|
|
|
|
{ |
275
|
421
|
|
|
421
|
1
|
35971
|
my $self = shift; |
276
|
421
|
|
|
|
|
790
|
my $name = shift; |
277
|
|
|
|
|
|
|
|
278
|
421
|
100
|
|
|
|
1166
|
my $member = $self->member($name) |
279
|
|
|
|
|
|
|
or return undef ; |
280
|
|
|
|
|
|
|
|
281
|
253
|
|
|
|
|
824
|
return $member->content(); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
sub exists |
285
|
|
|
|
|
|
|
{ |
286
|
336
|
|
|
336
|
1
|
83472
|
my $self = shift; |
287
|
336
|
|
|
|
|
642
|
my $name = shift; |
288
|
|
|
|
|
|
|
|
289
|
336
|
|
|
|
|
1843
|
return exists $self->{Members}{$name}; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub names |
293
|
|
|
|
|
|
|
{ |
294
|
337
|
|
|
337
|
1
|
87027
|
my $self = shift ; |
295
|
337
|
100
|
|
|
|
958
|
return wantarray ? map { $_->{Name} } @{ $self->{CD} } : scalar @{ $self->{CD} } ; |
|
756
|
|
|
|
|
2447
|
|
|
168
|
|
|
|
|
559
|
|
|
169
|
|
|
|
|
903
|
|
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub next |
299
|
|
|
|
|
|
|
{ |
300
|
511
|
|
|
511
|
1
|
87788
|
my $self = shift; |
301
|
511
|
100
|
|
|
|
1166
|
return undef if $self->{Cursor} >= @{ $self->{CD} } ; |
|
511
|
|
|
|
|
2360
|
|
302
|
426
|
|
|
|
|
1962
|
return $self->_mkMember($self->{CD}[ $self->{Cursor} ++]) ; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# sub rewind |
306
|
|
|
|
|
|
|
# { |
307
|
|
|
|
|
|
|
# my $self = shift; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# $self->{Cursor} = 0; |
310
|
|
|
|
|
|
|
# } |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# sub unzip |
313
|
|
|
|
|
|
|
# { |
314
|
|
|
|
|
|
|
# my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$SimpleUnzipError); |
315
|
|
|
|
|
|
|
# return $obj->_inf(@_) ; |
316
|
|
|
|
|
|
|
# } |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub getExtraParams |
319
|
|
|
|
|
|
|
{ |
320
|
169
|
|
|
169
|
0
|
8704
|
return (); |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub ckParams |
324
|
|
|
|
|
|
|
{ |
325
|
169
|
|
|
169
|
0
|
26023
|
my $self = shift ; |
326
|
169
|
|
|
|
|
316
|
my $got = shift ; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# unzip always needs crc32 |
329
|
169
|
|
|
|
|
703
|
$got->setValue('crc32' => 1); |
330
|
|
|
|
|
|
|
|
331
|
169
|
|
|
|
|
1674
|
return 1; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub mkUncomp |
335
|
|
|
|
|
|
|
{ |
336
|
169
|
|
|
169
|
0
|
23105
|
my $self = shift ; |
337
|
169
|
|
|
|
|
304
|
my $got = shift ; |
338
|
|
|
|
|
|
|
|
339
|
169
|
50
|
|
|
|
1011
|
my $magic = $self->ckMagic() |
340
|
|
|
|
|
|
|
or return 0; |
341
|
|
|
|
|
|
|
|
342
|
169
|
|
|
|
|
17684
|
return 1; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub chkTrailer |
346
|
|
|
|
|
|
|
{ |
347
|
703
|
|
|
703
|
0
|
215228
|
my $self = shift; |
348
|
703
|
|
|
|
|
1246
|
my $trailer = shift; |
349
|
703
|
|
|
|
|
1719
|
return STATUS_OK ; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub seekOrDie |
354
|
|
|
|
|
|
|
{ |
355
|
|
|
|
|
|
|
# temp method to die if bad seek |
356
|
|
|
|
|
|
|
# TODO - revisist |
357
|
843
|
|
|
843
|
0
|
1062
|
my $self = shift ; |
358
|
843
|
|
|
|
|
1022
|
my $offset = shift ; |
359
|
843
|
|
|
|
|
1008
|
my $truncate = shift; |
360
|
843
|
|
100
|
|
|
2233
|
my $position = shift || SEEK_SET; |
361
|
843
|
|
50
|
|
|
2405
|
my $message = shift || "Error Seeking in CentralDirectory" ; |
362
|
|
|
|
|
|
|
|
363
|
843
|
|
|
|
|
2043
|
my $got = $self->smartSeek($offset, $truncate, $position); |
364
|
|
|
|
|
|
|
|
365
|
843
|
|
|
|
|
20717
|
return $got ; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub readOrDie |
369
|
|
|
|
|
|
|
{ |
370
|
|
|
|
|
|
|
# temp method to die if bad read |
371
|
|
|
|
|
|
|
# TODO - revisist |
372
|
589
|
|
|
589
|
0
|
712
|
my $self = shift; |
373
|
|
|
|
|
|
|
|
374
|
589
|
50
|
|
|
|
1261
|
$self->smartReadExact(@_) |
375
|
|
|
|
|
|
|
or die "Error reading"; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub scanCentralDirectory |
379
|
|
|
|
|
|
|
{ |
380
|
|
|
|
|
|
|
# print "scanCentralDirectory\n"; |
381
|
|
|
|
|
|
|
|
382
|
169
|
|
|
169
|
0
|
299
|
my $self = shift; |
383
|
169
|
|
|
|
|
357
|
my $filesOnly = shift ; # *$self->{FilesOnly}; |
384
|
169
|
|
|
|
|
599
|
my $here = $self->smartTell(); |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# Use cases |
387
|
|
|
|
|
|
|
# 1 32-bit CD |
388
|
|
|
|
|
|
|
# 2 64-bit CD |
389
|
|
|
|
|
|
|
|
390
|
169
|
|
|
|
|
2503
|
my @CD = (); |
391
|
169
|
|
|
|
|
328
|
my %Members = (); |
392
|
169
|
|
|
|
|
645
|
my ($entries, $offset, $zipcomment) = $self->findCentralDirectoryOffset(); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
return () |
395
|
169
|
50
|
|
|
|
538
|
if ! defined $offset; |
396
|
|
|
|
|
|
|
|
397
|
169
|
50
|
|
|
|
458
|
return ([], {}, $zipcomment) |
398
|
|
|
|
|
|
|
if $entries == 0; |
399
|
|
|
|
|
|
|
|
400
|
169
|
|
|
|
|
498
|
$self->seekOrDie($offset, 0, SEEK_SET) ; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Now walk the Central Directory Records |
403
|
169
|
|
|
|
|
294
|
my $index = 0; |
404
|
169
|
|
|
|
|
254
|
my $buffer ; |
405
|
169
|
|
100
|
|
|
547
|
while ($self->smartReadExact(\$buffer, 46) && |
406
|
|
|
|
|
|
|
unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { |
407
|
|
|
|
|
|
|
|
408
|
846
|
|
|
|
|
33344
|
my $crc32 = unpack("V", substr($buffer, 16, 4)); |
409
|
846
|
|
|
|
|
1439
|
my $compressedLength = unpack("V", substr($buffer, 20, 4)); |
410
|
846
|
|
|
|
|
1419
|
my $uncompressedLength = unpack("V", substr($buffer, 24, 4)); |
411
|
846
|
|
|
|
|
1433
|
my $filename_length = unpack("v", substr($buffer, 28, 2)); |
412
|
846
|
|
|
|
|
1342
|
my $extra_length = unpack("v", substr($buffer, 30, 2)); |
413
|
846
|
|
|
|
|
1249
|
my $comment_length = unpack("v", substr($buffer, 32, 2)); |
414
|
846
|
|
|
|
|
1572
|
my $locHeaderOffset = unpack("V", substr($buffer, 42, 4)); |
415
|
|
|
|
|
|
|
|
416
|
846
|
|
|
|
|
1171
|
my $filename; |
417
|
|
|
|
|
|
|
my $extraField; |
418
|
846
|
|
|
|
|
1025
|
my $comment = ''; |
419
|
846
|
50
|
|
|
|
1453
|
if ($filename_length) |
420
|
|
|
|
|
|
|
{ |
421
|
846
|
50
|
|
|
|
1766
|
$self->smartReadExact(\$filename, $filename_length) |
422
|
|
|
|
|
|
|
or return $self->TruncatedTrailer("filename"); |
423
|
|
|
|
|
|
|
# print "Filename [$filename]\n"; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
846
|
50
|
|
|
|
29220
|
if ($extra_length) |
427
|
|
|
|
|
|
|
{ |
428
|
0
|
0
|
|
|
|
0
|
$self->smartReadExact(\$extraField, $extra_length) |
429
|
|
|
|
|
|
|
or return $self->TruncatedTrailer("extra"); |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
# Check for Zip64 |
432
|
0
|
|
|
|
|
0
|
my $zip64Extended = IO::Compress::Zlib::Extra::findID("\x01\x00", $extraField); |
433
|
0
|
0
|
|
|
|
0
|
if ($zip64Extended) |
434
|
|
|
|
|
|
|
{ |
435
|
0
|
0
|
|
|
|
0
|
if ($uncompressedLength == 0xFFFFFFFF) |
436
|
|
|
|
|
|
|
{ |
437
|
0
|
|
|
|
|
0
|
$uncompressedLength = U64::Value_VV64 substr($zip64Extended, 0, 8, ""); |
438
|
|
|
|
|
|
|
# $uncompressedLength = unpack "Q<", substr($zip64Extended, 0, 8, ""); |
439
|
|
|
|
|
|
|
} |
440
|
0
|
0
|
|
|
|
0
|
if ($compressedLength == 0xFFFFFFFF) |
441
|
|
|
|
|
|
|
{ |
442
|
0
|
|
|
|
|
0
|
$compressedLength = U64::Value_VV64 substr($zip64Extended, 0, 8, ""); |
443
|
|
|
|
|
|
|
# $compressedLength = unpack "Q<", substr($zip64Extended, 0, 8, ""); |
444
|
|
|
|
|
|
|
} |
445
|
0
|
0
|
|
|
|
0
|
if ($locHeaderOffset == 0xFFFFFFFF) |
446
|
|
|
|
|
|
|
{ |
447
|
0
|
|
|
|
|
0
|
$locHeaderOffset = U64::Value_VV64 substr($zip64Extended, 0, 8, ""); |
448
|
|
|
|
|
|
|
# $locHeaderOffset = unpack "Q<", substr($zip64Extended, 0, 8, ""); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
next |
454
|
846
|
100
|
100
|
|
|
2646
|
if $filesOnly && substr($filename, -1, 1) eq '/' && $uncompressedLength == 0; |
|
|
|
66
|
|
|
|
|
455
|
|
|
|
|
|
|
|
456
|
762
|
100
|
|
|
|
1179
|
if ($comment_length) |
457
|
|
|
|
|
|
|
{ |
458
|
168
|
50
|
|
|
|
423
|
$self->smartReadExact(\$comment, $comment_length) |
459
|
|
|
|
|
|
|
or return $self->TruncatedTrailer("comment"); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
762
|
|
|
|
|
9286
|
my %data = ( |
463
|
|
|
|
|
|
|
'Name' => $filename, |
464
|
|
|
|
|
|
|
'Comment' => $comment, |
465
|
|
|
|
|
|
|
'LocalHeaderOffset' => $locHeaderOffset, |
466
|
|
|
|
|
|
|
'CompressedLength' => $compressedLength , |
467
|
|
|
|
|
|
|
'UncompressedLength' => $uncompressedLength , |
468
|
|
|
|
|
|
|
'CRC32' => $crc32 , |
469
|
|
|
|
|
|
|
#'Time' => _dosToUnixTime($lastModTime), |
470
|
|
|
|
|
|
|
#'Stream' => $streamingMode, |
471
|
|
|
|
|
|
|
#'Zip64' => $zip64, |
472
|
|
|
|
|
|
|
# |
473
|
|
|
|
|
|
|
#'MethodID' => $compressedMethod, |
474
|
|
|
|
|
|
|
); |
475
|
762
|
|
|
|
|
1428
|
push @CD, \%data; |
476
|
762
|
|
|
|
|
1669
|
$Members{$filename} = \%data ; |
477
|
|
|
|
|
|
|
|
478
|
762
|
|
|
|
|
2042
|
++ $index; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
169
|
|
|
|
|
7061
|
$self->seekOrDie($here, 0, SEEK_SET) ; |
482
|
|
|
|
|
|
|
|
483
|
169
|
|
|
|
|
805
|
return (\@CD, \%Members, $zipcomment) ; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub offsetFromZip64 |
487
|
|
|
|
|
|
|
{ |
488
|
|
|
|
|
|
|
# print "offsetFromZip64\n"; |
489
|
|
|
|
|
|
|
|
490
|
84
|
|
|
84
|
0
|
712
|
my $self = shift ; |
491
|
84
|
|
|
|
|
138
|
my $here = shift; |
492
|
|
|
|
|
|
|
|
493
|
84
|
|
|
|
|
351
|
$self->seekOrDie($here - 20, 0, SEEK_SET) ; |
494
|
|
|
|
|
|
|
|
495
|
84
|
|
|
|
|
164
|
my $buffer; |
496
|
84
|
|
|
|
|
145
|
my $got = 0; |
497
|
84
|
|
|
|
|
321
|
$self->readOrDie(\$buffer, 20) ; |
498
|
|
|
|
|
|
|
# or die "xxx $here $got $!" ; |
499
|
|
|
|
|
|
|
|
500
|
84
|
50
|
|
|
|
4265
|
if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) { |
501
|
84
|
|
|
|
|
486
|
my $cd64 = U64::Value_VV64 substr($buffer, 8, 8); |
502
|
|
|
|
|
|
|
# my $cd64 = unpack "Q<", substr($buffer, 8, 8); |
503
|
|
|
|
|
|
|
|
504
|
84
|
|
|
|
|
1156
|
$self->seekOrDie($cd64, 0, SEEK_SET) ; |
505
|
|
|
|
|
|
|
|
506
|
84
|
|
|
|
|
280
|
$self->readOrDie(\$buffer, 4) ; |
507
|
|
|
|
|
|
|
|
508
|
84
|
50
|
|
|
|
3902
|
if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) { |
509
|
|
|
|
|
|
|
|
510
|
84
|
|
|
|
|
248
|
$self->readOrDie(\$buffer, 8); |
511
|
|
|
|
|
|
|
# or die "xxx" ; |
512
|
84
|
|
|
|
|
3112
|
my $size = U64::Value_VV64($buffer); |
513
|
|
|
|
|
|
|
# my $size = unpack "Q<", $buffer; |
514
|
|
|
|
|
|
|
|
515
|
84
|
|
|
|
|
668
|
$self->readOrDie(\$buffer, $size); |
516
|
|
|
|
|
|
|
# or die "xxx" ; |
517
|
|
|
|
|
|
|
|
518
|
84
|
|
|
|
|
3029
|
my $cd64 = U64::Value_VV64 substr($buffer, 36, 8); |
519
|
|
|
|
|
|
|
# my $cd64 = unpack "Q<", substr($buffer, 36, 8); |
520
|
|
|
|
|
|
|
|
521
|
84
|
|
|
|
|
770
|
return $cd64 ; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
0
|
|
|
|
|
0
|
die "zzz1"; |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
0
|
|
|
|
|
0
|
die "zzz2"; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
2
|
|
|
2
|
|
20
|
use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
983
|
|
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub findCentralDirectoryOffset |
533
|
|
|
|
|
|
|
{ |
534
|
169
|
|
|
169
|
0
|
297
|
my $self = shift ; |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# Most common use-case is where there is no comment, so |
537
|
|
|
|
|
|
|
# know exactly where the end of central directory record |
538
|
|
|
|
|
|
|
# should be. |
539
|
|
|
|
|
|
|
|
540
|
169
|
|
|
|
|
804
|
$self->seekOrDie(-22, 0, SEEK_END) ; |
541
|
169
|
|
|
|
|
486
|
my $here = $self->smartTell(); |
542
|
|
|
|
|
|
|
|
543
|
169
|
|
|
|
|
1568
|
my $buffer; |
544
|
169
|
|
|
|
|
617
|
$self->readOrDie(\$buffer, 22) ; |
545
|
|
|
|
|
|
|
|
546
|
169
|
|
|
|
|
8228
|
my $zip64 = 0; |
547
|
169
|
|
|
|
|
319
|
my $centralDirOffset ; |
548
|
169
|
|
|
|
|
376
|
my $comment = ''; |
549
|
169
|
|
|
|
|
419
|
my $entries = 0; |
550
|
169
|
100
|
|
|
|
693
|
if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { |
551
|
85
|
|
|
|
|
291
|
$entries = unpack("v", substr($buffer, 8, 2)); |
552
|
85
|
|
|
|
|
226
|
$centralDirOffset = unpack("V", substr($buffer, 16, 4)); |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
else { |
555
|
84
|
|
|
|
|
327
|
$self->seekOrDie(0, 0, SEEK_END) ; |
556
|
|
|
|
|
|
|
|
557
|
84
|
|
|
|
|
402
|
my $fileLen = $self->smartTell(); |
558
|
84
|
|
|
|
|
867
|
my $want = 0 ; |
559
|
|
|
|
|
|
|
|
560
|
84
|
|
|
|
|
162
|
while(1) { |
561
|
84
|
|
|
|
|
158
|
$want += 1024; |
562
|
84
|
|
|
|
|
161
|
my $seekTo = $fileLen - $want; |
563
|
84
|
50
|
|
|
|
306
|
if ($seekTo < 0 ) { |
564
|
84
|
|
|
|
|
157
|
$seekTo = 0; |
565
|
84
|
|
|
|
|
124
|
$want = $fileLen ; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
84
|
|
|
|
|
237
|
$self->seekOrDie($seekTo, 0, SEEK_SET) ; |
569
|
84
|
|
|
|
|
122
|
my $got; |
570
|
84
|
|
|
|
|
721
|
$self->readOrDie(\$buffer, $want) ; |
571
|
84
|
|
|
|
|
4096
|
my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG); |
572
|
|
|
|
|
|
|
|
573
|
84
|
50
|
|
|
|
334
|
if ($pos >= 0) { |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
#$here = $self->smartTell(); |
576
|
84
|
|
|
|
|
175
|
$here = $seekTo + $pos ; |
577
|
84
|
|
|
|
|
378
|
$entries = unpack("v", substr($buffer, $pos + 8, 2)); |
578
|
84
|
|
|
|
|
331
|
$centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4)); |
579
|
84
|
|
|
|
|
225
|
my $comment_length = unpack("v", substr($buffer, $pos + 20, 2)); |
580
|
84
|
50
|
|
|
|
360
|
$comment = substr($buffer, $pos + 22, $comment_length) |
581
|
|
|
|
|
|
|
if $comment_length ; |
582
|
|
|
|
|
|
|
|
583
|
84
|
|
|
|
|
246
|
last ; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
return undef |
587
|
0
|
0
|
|
|
|
0
|
if $want == $fileLen; |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
|
591
|
169
|
100
|
66
|
|
|
972
|
$centralDirOffset = $self->offsetFromZip64($here) |
592
|
|
|
|
|
|
|
if $entries and U64::full32 $centralDirOffset ; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# print "findCentralDirectoryOffset $centralDirOffset [$comment]\n"; |
595
|
169
|
|
|
|
|
1086
|
return ($entries, $centralDirOffset, $comment) ; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub STORABLE_freeze |
600
|
|
|
|
|
|
|
{ |
601
|
0
|
|
|
0
|
0
|
0
|
my $type = ref shift; |
602
|
0
|
|
|
|
|
0
|
croak "Cannot freeze $type object\n"; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub STORABLE_thaw |
606
|
|
|
|
|
|
|
{ |
607
|
0
|
|
|
0
|
0
|
0
|
my $type = ref shift; |
608
|
0
|
|
|
|
|
0
|
croak "Cannot thaw $type object\n"; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
{ |
612
|
|
|
|
|
|
|
package Archive::Zip::SimpleUnzip::Member; |
613
|
|
|
|
|
|
|
|
614
|
2
|
|
|
2
|
|
16
|
use IO::File ; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
387
|
|
615
|
2
|
|
|
2
|
|
16
|
use File::Basename; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
199
|
|
616
|
2
|
|
|
2
|
|
15
|
use File::Path ; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
3382
|
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
sub name |
619
|
|
|
|
|
|
|
{ |
620
|
510
|
|
|
510
|
|
130369
|
my $self = shift; |
621
|
|
|
|
|
|
|
# $self->_stdPreq() or return 0 ; |
622
|
|
|
|
|
|
|
|
623
|
510
|
|
|
|
|
3952
|
return $self->{Info}{Name}; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
sub isDirectory |
627
|
|
|
|
|
|
|
{ |
628
|
526
|
|
|
526
|
|
707
|
my $self = shift; |
629
|
|
|
|
|
|
|
# $self->_stdPreq() or return 0 ; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
return substr($self->{Info}{Name}, -1, 1) eq '/' && |
632
|
526
|
|
66
|
|
|
5620
|
$self->{Info}{UncompressedLength} == 0 ; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
sub isFile |
636
|
|
|
|
|
|
|
{ |
637
|
428
|
|
|
428
|
|
612
|
my $self = shift; |
638
|
|
|
|
|
|
|
# $self->_stdPreq() or return 0 ; |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# TODO - test for symlink |
641
|
428
|
|
|
|
|
985
|
return ! $self->isDirectory() ; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# TODO |
645
|
|
|
|
|
|
|
# |
646
|
|
|
|
|
|
|
# isZip64 |
647
|
|
|
|
|
|
|
# isDir |
648
|
|
|
|
|
|
|
# isSymLink |
649
|
|
|
|
|
|
|
# isText |
650
|
|
|
|
|
|
|
# isBinary |
651
|
|
|
|
|
|
|
# isEncrypted |
652
|
|
|
|
|
|
|
# isStreamed |
653
|
|
|
|
|
|
|
# getComment |
654
|
|
|
|
|
|
|
# getExtra |
655
|
|
|
|
|
|
|
# compressedSize - 64 bit alert |
656
|
|
|
|
|
|
|
# uncompressedSize |
657
|
|
|
|
|
|
|
# time |
658
|
|
|
|
|
|
|
# isStored |
659
|
|
|
|
|
|
|
# compressionName |
660
|
|
|
|
|
|
|
# |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub compressedSize |
663
|
|
|
|
|
|
|
{ |
664
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
665
|
|
|
|
|
|
|
# $self->_stdPreq() or return 0 ; |
666
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
0
|
return $self->{Info}{CompressedLength}; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub uncompressedSize |
671
|
|
|
|
|
|
|
{ |
672
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
673
|
|
|
|
|
|
|
# $self->_stdPreq() or return 0 ; |
674
|
|
|
|
|
|
|
|
675
|
0
|
|
|
|
|
0
|
return $self->{Info}{UncompressedLength}; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub content |
679
|
|
|
|
|
|
|
{ |
680
|
841
|
|
|
841
|
|
1700
|
my $self = shift; |
681
|
841
|
|
|
|
|
1141
|
my $data ; |
682
|
|
|
|
|
|
|
|
683
|
841
|
|
|
|
|
1654
|
my $inner = $self->{Inner}; |
684
|
|
|
|
|
|
|
|
685
|
841
|
100
|
|
|
|
3056
|
$inner->reset() if $self->{NeedsReset}; $self->{NeedsReset} ++ ; |
|
841
|
|
|
|
|
7635
|
|
686
|
841
|
|
|
|
|
2321
|
Archive::Zip::SimpleUnzip::resetter($inner, $self->{Info}); |
687
|
|
|
|
|
|
|
|
688
|
841
|
|
|
|
|
3274
|
$inner->smartSeek($self->{Info}{DataOffset}, 0, SEEK_SET); |
689
|
841
|
|
|
|
|
24286
|
$self->{Inner}->read($data, $self->{Info}{UncompressedLength}); |
690
|
|
|
|
|
|
|
|
691
|
841
|
|
|
|
|
71926
|
return $data; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
sub open |
695
|
|
|
|
|
|
|
{ |
696
|
258
|
|
|
258
|
|
665
|
my $self = shift; |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# return return $self->{Inner} ; |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# my $handle = Symbol::gensym(); |
701
|
|
|
|
|
|
|
# tie *$handle, "Archive::Zip::SimpleUnzip::Handle", $self->{SZ}{UnZip}; |
702
|
|
|
|
|
|
|
# return $handle; |
703
|
|
|
|
|
|
|
|
704
|
258
|
|
|
|
|
1413
|
my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::SimpleUnzip::Handle", \$SimpleUnzipError) ; |
705
|
|
|
|
|
|
|
|
706
|
258
|
|
|
|
|
3912
|
*$z->{Open} = 1 ; |
707
|
258
|
|
|
|
|
693
|
*$z->{SZ} = $self->{Inner}; |
708
|
|
|
|
|
|
|
|
709
|
258
|
|
|
|
|
559
|
my $inner = $self->{Inner}; |
710
|
258
|
100
|
|
|
|
1064
|
$inner->reset() if $self->{NeedsReset}; $self->{NeedsReset} ++ ; |
|
258
|
|
|
|
|
2503
|
|
711
|
258
|
|
|
|
|
912
|
Archive::Zip::SimpleUnzip::resetter($self->{Inner}, $self->{Info}); |
712
|
258
|
|
|
|
|
1084
|
$inner->smartSeek($self->{Info}{DataOffset}, 0, SEEK_SET); |
713
|
|
|
|
|
|
|
|
714
|
258
|
|
|
|
|
7881
|
Scalar::Util::weaken *$z->{SZ}; # for 5.8 |
715
|
|
|
|
|
|
|
|
716
|
258
|
|
|
|
|
591
|
$z; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub close |
720
|
|
|
|
|
|
|
{ |
721
|
84
|
|
|
84
|
|
226
|
my $self = shift; |
722
|
84
|
|
|
|
|
229
|
return 1; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
sub comment |
726
|
|
|
|
|
|
|
{ |
727
|
420
|
|
|
420
|
|
988
|
my $self = shift; |
728
|
|
|
|
|
|
|
|
729
|
420
|
|
|
|
|
2918
|
return $self->{Info}{Comment}; |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
sub _canonicalPath |
733
|
|
|
|
|
|
|
{ |
734
|
12
|
|
|
12
|
|
16
|
my $name = shift ; |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
# Not an absolute path |
737
|
12
|
|
|
|
|
25
|
$name =~ s#^/+## ; |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# Remove trailing slash |
740
|
12
|
|
|
|
|
41
|
$name =~ s#/+$## ; |
741
|
|
|
|
|
|
|
|
742
|
12
|
|
|
|
|
32
|
$name =~ s#/+#/#g ; |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
# Drop any ".." and "." paths |
745
|
|
|
|
|
|
|
# Use of ".." is unsafe |
746
|
12
|
|
|
|
|
33
|
my @paths = split '/', $name ; |
747
|
12
|
|
|
|
|
20
|
my @have = grep { ! m#^\.(\.)?$# } @paths ; |
|
26
|
|
|
|
|
80
|
|
748
|
|
|
|
|
|
|
|
749
|
12
|
|
|
|
|
44
|
return @have ; |
750
|
|
|
|
|
|
|
|
751
|
0
|
|
|
|
|
0
|
$name = join '/', grep { ! m#^\.(\.)?$# } @paths ; |
|
0
|
|
|
|
|
0
|
|
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# use Perl::OSType; |
754
|
|
|
|
|
|
|
# my $type = Perl::OSType::os_type(); |
755
|
|
|
|
|
|
|
# if ( $type eq 'Unix' ) |
756
|
|
|
|
|
|
|
# { |
757
|
|
|
|
|
|
|
# } |
758
|
|
|
|
|
|
|
# # TODO Win32 |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub canonicalName |
762
|
|
|
|
|
|
|
{ |
763
|
6
|
|
|
6
|
|
33
|
my $self = shift; |
764
|
|
|
|
|
|
|
|
765
|
6
|
|
|
|
|
28
|
return join '/', _canonicalPath($self->{Info}{Name}); |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub extract # to file |
769
|
|
|
|
|
|
|
{ |
770
|
8
|
|
|
8
|
|
28
|
my $self = shift; |
771
|
8
|
|
|
|
|
10
|
my $out = shift; |
772
|
|
|
|
|
|
|
|
773
|
8
|
|
|
|
|
11
|
my $path ; |
774
|
|
|
|
|
|
|
my $filename ; |
775
|
|
|
|
|
|
|
|
776
|
8
|
100
|
|
|
|
23
|
if (defined $out) |
777
|
|
|
|
|
|
|
{ |
778
|
|
|
|
|
|
|
# User has supplied output file, so allow absolute path |
779
|
2
|
|
|
|
|
4
|
$filename = $out; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
else |
782
|
|
|
|
|
|
|
{ |
783
|
|
|
|
|
|
|
# using name in zip file, so make it safe |
784
|
6
|
50
|
|
|
|
26
|
my @path = _canonicalPath(defined $out ? $out : $self->{Info}{Name}) ; |
785
|
6
|
|
|
|
|
12
|
$filename = join '/', @path ; |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
8
|
100
|
|
|
|
17
|
$path = $self->isDirectory() ? $filename : dirname $filename; |
789
|
|
|
|
|
|
|
|
790
|
8
|
50
|
|
|
|
34
|
if (defined $path) |
791
|
|
|
|
|
|
|
{ |
792
|
|
|
|
|
|
|
# check path isn't already a plain file |
793
|
8
|
50
|
66
|
|
|
234
|
return _setError("Path is not a directory '$path'") |
794
|
|
|
|
|
|
|
if -e $path && ! -d $path ; |
795
|
|
|
|
|
|
|
|
796
|
8
|
100
|
|
|
|
84
|
if (! -d $path) |
797
|
|
|
|
|
|
|
{ |
798
|
4
|
|
|
|
|
13
|
my $error ; |
799
|
4
|
50
|
|
|
|
923
|
File::Path::mkpath($path, {error => \$error}) |
800
|
|
|
|
|
|
|
or return _setError("Cannot create path '$path': $error"); |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# TODO - symlink |
805
|
|
|
|
|
|
|
|
806
|
8
|
100
|
|
|
|
51
|
if ($self->isFile()) |
807
|
|
|
|
|
|
|
{ |
808
|
6
|
|
|
|
|
15
|
my $handle = $self->open(); |
809
|
6
|
50
|
|
|
|
50
|
my $fh = new IO::File ">$filename" |
810
|
|
|
|
|
|
|
or return _setError("Cannot open file '$filename': $!"); |
811
|
|
|
|
|
|
|
#$fh->binmode(); # not available in 5.8.0 |
812
|
|
|
|
|
|
|
|
813
|
6
|
|
|
|
|
733
|
my $data; |
814
|
6
|
|
|
|
|
20
|
print $fh $data |
815
|
|
|
|
|
|
|
while $handle->read($data); |
816
|
6
|
|
|
|
|
34
|
$handle->close(); |
817
|
6
|
|
|
|
|
28
|
$fh->close(); |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
# TODO - set timestamps etc... |
821
|
|
|
|
|
|
|
|
822
|
8
|
|
|
|
|
51
|
return 1 ; |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
sub _setError |
826
|
|
|
|
|
|
|
{ |
827
|
0
|
|
|
0
|
|
0
|
$Archive::Zip::SimpleUnzip::SimpleUnzipError = $_[0] ; |
828
|
0
|
|
|
|
|
0
|
return 0; |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
{ |
834
|
|
|
|
|
|
|
package Archive::Zip::SimpleUnzip::Handle ; |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub TIEHANDLE |
837
|
|
|
|
|
|
|
{ |
838
|
258
|
50
|
|
258
|
|
12441
|
return $_[0] if ref($_[0]); |
839
|
0
|
|
|
|
|
0
|
die "OOPS\n" ; |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
sub UNTIE |
843
|
|
|
|
|
|
|
{ |
844
|
0
|
|
|
0
|
|
0
|
my $self = shift ; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
sub DESTROY |
848
|
|
|
|
|
|
|
{ |
849
|
|
|
|
|
|
|
# print "DESTROY H"; |
850
|
258
|
|
|
258
|
|
116646
|
my $self = shift ; |
851
|
258
|
|
|
|
|
2642
|
local ($., $@, $!, $^E, $?); |
852
|
258
|
|
|
|
|
989
|
$self->close() ; |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
# TODO - memory leak with 5.8.0 - this isn't called until |
855
|
|
|
|
|
|
|
# global destruction |
856
|
|
|
|
|
|
|
# |
857
|
258
|
|
|
|
|
479
|
%{ *$self } = () ; |
|
258
|
|
|
|
|
1700
|
|
858
|
258
|
|
|
|
|
2753
|
undef $self ; |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub close |
863
|
|
|
|
|
|
|
{ |
864
|
348
|
|
|
348
|
|
43055
|
my $self = shift ; |
865
|
348
|
100
|
|
|
|
1400
|
return 1 if ! *$self->{Open}; |
866
|
|
|
|
|
|
|
|
867
|
258
|
|
|
|
|
596
|
*$self->{Open} = 0 ; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
# untie *$self |
870
|
|
|
|
|
|
|
# if $] >= 5.008 ; |
871
|
|
|
|
|
|
|
|
872
|
258
|
50
|
|
|
|
727
|
if (defined *$self->{SZ}) |
873
|
|
|
|
|
|
|
{ |
874
|
|
|
|
|
|
|
# *$self->{SZ}{Raw} = undef ; |
875
|
258
|
|
|
|
|
544
|
*$self->{SZ} = undef ; |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
258
|
|
|
|
|
550
|
1; |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
sub read |
882
|
|
|
|
|
|
|
{ |
883
|
|
|
|
|
|
|
# TODO - remember to fix the return value to match real read & not the broken one in IO::Uncompress |
884
|
599
|
|
|
599
|
|
159548
|
my $self = shift; |
885
|
599
|
50
|
|
|
|
1293
|
$self->_stdPreq() or return 0 ; |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
# warn "READ [$self]\n"; |
888
|
|
|
|
|
|
|
# warn "READ [*$self->{SZ}]\n"; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# $_[0] = *$self->{SZ}{Unzip}; |
891
|
|
|
|
|
|
|
# my $status = goto &IO::Uncompress::Base::read; |
892
|
|
|
|
|
|
|
# $_[0] = \$_[0] unless ref $_[0]; |
893
|
599
|
|
|
|
|
2694
|
my $status = *$self->{SZ}->read(@_); |
894
|
599
|
50
|
|
|
|
25036
|
$status = undef if $status < 0 ; |
895
|
599
|
|
|
|
|
1344
|
return $status; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub readline |
899
|
|
|
|
|
|
|
{ |
900
|
84
|
|
|
84
|
|
22772
|
my $self = shift; |
901
|
84
|
50
|
|
|
|
229
|
$self->_stdPreq() or return 0 ; |
902
|
84
|
|
|
|
|
575
|
*$self->{SZ}->getline(@_); |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub tell |
906
|
|
|
|
|
|
|
{ |
907
|
1008
|
|
|
1008
|
|
81073
|
my $self = shift; |
908
|
1008
|
50
|
|
|
|
2170
|
$self->_stdPreq() or return 0 ; |
909
|
|
|
|
|
|
|
|
910
|
1008
|
|
|
|
|
3604
|
*$self->{SZ}->tell(@_); |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub eof |
914
|
|
|
|
|
|
|
{ |
915
|
672
|
|
|
672
|
|
142159
|
my $self = shift; |
916
|
672
|
50
|
|
|
|
1465
|
$self->_stdPreq() or return 0 ; |
917
|
|
|
|
|
|
|
|
918
|
672
|
|
|
|
|
3060
|
*$self->{SZ}->eof; |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
sub _stdPreq |
922
|
|
|
|
|
|
|
{ |
923
|
2363
|
|
|
2363
|
|
2754
|
my $self = shift; |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
# TODO - fix me |
926
|
2363
|
|
|
|
|
6159
|
return 1; |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
return _setError("Zip file closed") |
929
|
0
|
0
|
0
|
|
|
|
if ! defined defined *$self->{SZ} || ! *$self->{Inner}{Open} ; |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
return _setError("member filehandle closed") |
933
|
0
|
0
|
|
|
|
|
if ! *$self->{Open} ; #|| ! defined *$self->{SZ}{Raw}; |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
return 0 |
936
|
0
|
0
|
|
|
|
|
if *$self->{SZ}{Error} ; |
937
|
|
|
|
|
|
|
|
938
|
0
|
|
|
|
|
|
return 1; |
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
sub _setError |
942
|
|
|
|
|
|
|
{ |
943
|
0
|
|
|
0
|
|
|
$Archive::Zip::SimpleUnzip::SimpleUnzipError = $_[0] ; |
944
|
0
|
|
|
|
|
|
return 0; |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
0
|
|
|
0
|
|
|
sub binmode { 1 } |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
# sub clearerr { $Archive::Zip::SimpleUnzip::SimpleUnzipError = '' } |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
*BINMODE = \&binmode; |
952
|
|
|
|
|
|
|
# *SEEK = \&seek; |
953
|
|
|
|
|
|
|
*READ = \&read; |
954
|
|
|
|
|
|
|
*sysread = \&read; |
955
|
|
|
|
|
|
|
*TELL = \&tell; |
956
|
|
|
|
|
|
|
*READLINE = \&readline; |
957
|
|
|
|
|
|
|
*EOF = \&eof; |
958
|
|
|
|
|
|
|
*FILENO = \&fileno; |
959
|
|
|
|
|
|
|
*CLOSE = \&close; |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
1; |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
__END__ |