File Coverage

lib/Archive/Zip/StreamedUnzip.pm
Criterion Covered Total %
statement 113 150 75.3
branch 24 50 48.0
condition 6 12 50.0
subroutine 30 41 73.1
pod 3 7 42.8
total 176 260 67.6


line stmt bran cond sub pod time code
1             package Archive::Zip::StreamedUnzip;
2              
3             require 5.006;
4              
5 1     1   896 use strict ;
  1         1  
  1         30  
6 1     1   5 use warnings;
  1         2  
  1         23  
7 1     1   5 use bytes;
  1         1  
  1         5  
8              
9 1     1   19 use IO::File;
  1         2  
  1         170  
10 1     1   7 use Carp;
  1         2  
  1         59  
11 1     1   6 use Scalar::Util ();
  1         2  
  1         25  
12              
13 1     1   4 use IO::Compress::Base::Common 2.096 qw(:Status);
  1         27  
  1         116  
14 1     1   7 use IO::Compress::Zip::Constants 2.096 ;
  1         16  
  1         206  
15 1     1   8 use IO::Uncompress::Unzip 2.096 ;
  1         15  
  1         233  
16              
17              
18             require Exporter ;
19              
20             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $StreamedUnzipError);
21              
22             $VERSION = '0.040';
23             $StreamedUnzipError = '';
24              
25             @ISA = qw(IO::Uncompress::Unzip Exporter);
26             @EXPORT_OK = qw( $StreamedUnzipError unzip );
27             %EXPORT_TAGS = %IO::Uncompress::RawInflate::EXPORT_TAGS ;
28             push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
29             Exporter::export_ok_tags('all');
30              
31              
32             sub _setError
33             {
34 4     4   99 $StreamedUnzipError = $_[2] ;
35 4 50       11 $_[0]->{Error} = $_[2]
36             if defined $_[0] ;
37              
38 4         12 return $_[1];
39             }
40              
41             sub _illegalFilename
42             {
43 2     2   4 return _setError(undef, undef, "Illegal Filename") ;
44             }
45              
46             sub is64BitPerl
47             {
48 1     1   7 use Config;
  1         9  
  1         1750  
49             # possibly use presence of pack/unpack "Q" for int size test?
50 0 0   0 0 0 $Config{lseeksize} >= 8 and $Config{uvsize} >= 8;
51             }
52              
53             sub new
54             {
55 88     88 1 4947 my $class = shift ;
56              
57 88 100       287 return _setError(undef, undef, "Missing Filename")
58             unless @_ ;
59              
60 87         154 my $inValue = shift ;
61 87         111 my $fh;
62              
63 87 100       287 if (!defined $inValue)
64             {
65 1         4 return _illegalFilename
66             }
67              
68 86         232 my $isSTDOUT = ($inValue eq '-') ;
69 86         296 my $inType = IO::Compress::Base::Common::whatIsOutput($inValue);
70              
71 86 100 33     2753 if ($inType eq 'filename')
    50          
72             {
73 58 100 66     1780 if (-e $inValue && ( ! -f _ || ! -r _))
      100        
74             {
75 1         5 return _illegalFilename
76             }
77              
78 57 100       569 $fh = new IO::File "<$inValue"
79             or return _setError(undef, undef, "cannot open file '$inValue': $!");
80             }
81             elsif( $inType eq 'buffer' || $inType eq 'handle')
82             {
83 28         57 $fh = $inValue;
84             }
85             else
86             {
87 0         0 return _illegalFilename
88             }
89              
90 84         4574 my %obj ;
91             # my $inner = IO::Compress::Base::Common::createSelfTiedObject($class, \$StreamedUnzipError);
92              
93             # # *$inner->{Pause} = 1;
94             # $inner->_create(undef, 0, $fh, @_)
95             # or return undef;
96              
97 84         543 my $inner = IO::Uncompress::Unzip->new($fh) ;
98              
99 84         105845 $obj{Inner} = $inner;
100 84         180 $obj{Open} = 1 ;
101 84         148 $obj{FirstOne} = 1 ;
102              
103 84         411 bless \%obj, $class;
104             }
105              
106             sub close
107             {
108 84     84 1 17442 my $self = shift;
109             # TODO - fix me
110 84         348 $self->{Inner}->close();
111 84         2773 return 1;
112             }
113              
114             sub DESTROY
115             {
116 84     84   16925 my $self = shift;
117             }
118              
119             sub next
120             {
121 504     504 1 84954 my $self = shift;
122              
123 504 100       1292 if ($self->{FirstOne})
124             {
125 84         145 $self->{FirstOne} = 0;
126             }
127             else
128             {
129 420         1313 my $status = $self->{Inner}->nextStream();
130             return undef
131 420 100       198373 if $status <= 0;
132             }
133              
134 420         602 my %member ;
135 420         824 $member{Inner} = $self->{Inner};
136             # $member{Member} = $member;
137 420         1116 $member{Info} = $self->{Inner}->getHeaderInfo() ;
138             #Scalar::Util::weaken $member{Inner}; # for 5.8
139              
140 420         3643 return bless \%member, 'Archive::Zip::StreamedUnzip::Member';
141             }
142              
143             sub member
144             {
145 0     0 0 0 my $self = shift;
146 0         0 my $name = shift;
147              
148 0 0       0 return _setError(undef, undef, "Member '$name' not in zip")
149             if ! defined $name ;
150              
151 0         0 while (my $member = $self->next())
152             {
153 0 0       0 return $member
154             if $member->name() eq $name ;
155              
156             }
157              
158 0         0 return _setError(undef, undef, "Member '$name' not in zip") ;
159             }
160              
161             sub getExtraParams
162             {
163              
164             return (
165             # Zip header fields
166 0     0 0 0 'name' => [IO::Compress::Base::Common::Parse_any, undef],
167              
168             # 'stream' => [IO::Compress::Base::Common::Parse_boolean, 1],
169             );
170             }
171              
172             sub ckParams
173             {
174 0     0 0 0 my $self = shift ;
175 0         0 my $got = shift ;
176              
177             # unzip always needs crc32
178 0         0 $got->setValue('crc32' => 1);
179              
180 0         0 *$self->{UnzipData}{Name} = $got->getValue('name');
181              
182 0         0 return 1;
183             }
184              
185              
186              
187              
188             {
189             package Archive::Zip::StreamedUnzip::Member;
190              
191             sub name
192             {
193 420     420   96677 my $self = shift;
194             # $self->_stdPreq() or return 0 ;
195              
196 420         2705 return $self->{Info}{Name};
197             }
198              
199             sub isDirectory
200             {
201 420     420   591 my $self = shift;
202             # $self->_stdPreq() or return 0 ;
203              
204 420         3118 return substr($self->{Info}{Name}, -1, 1) eq '/' ;
205             }
206              
207             sub isFile
208             {
209 336     336   459 my $self = shift;
210             # $self->_stdPreq() or return 0 ;
211              
212             # TODO - test for symlink
213 336         605 return ! $self->isDirectory() ;
214             }
215              
216             sub isEncrypted
217             {
218 0     0   0 my $self = shift;
219 0         0 return $self->{Info}{Encrypted};
220             # my $gpFlag = unpack ("v", substr($self->{Info}{Header}, 4 + 2, 2));
221             # return $gpFlag & (0x01 | (1 << 6)) ;
222             }
223              
224             # TODO
225             #
226             # isZip64
227             # isDir
228             # isSymLink
229             # isText
230             # isBinary
231             # isEncrypted
232             # isStreamed
233             # getComment
234             # getExtra
235             # compressedSize - 64 bit alert
236             # uncompressedSize
237             # time
238             # isStored
239             # compressionName
240             #
241             # extractToFile
242              
243             sub compressedSize
244             {
245 0     0   0 my $self = shift;
246             # $self->_stdPreq() or return 0 ;
247              
248 0         0 my $CompressedLength = $self->{Info}{CompressedLength};
249 0 0       0 if (ref $CompressedLength)
250             {
251 0         0 return U64::get64bit($CompressedLength)
252             }
253 0         0 return $CompressedLength;
254             }
255              
256             sub uncompressedSize
257             {
258 0     0   0 my $self = shift;
259             # $self->_stdPreq() or return 0 ;
260 0         0 my $UncompressedLength = $self->{Info}{UncompressedLength};
261 0 0       0 if (ref $UncompressedLength)
262             {
263 0         0 return U64::get64bit($UncompressedLength)
264             }
265 0         0 return $UncompressedLength;
266             }
267              
268             sub content
269             {
270 252     252   475 my $self = shift;
271 252         357 my $data ;
272              
273             # $self->{Inner}->read($data, $self->{UncompressedLength});
274 252         1159 $self->{Inner}->read($data, $self->{Info}{UncompressedLength});
275              
276 252         165449 return $data;
277             }
278              
279             sub open
280             {
281 168     168   358 my $self = shift;
282              
283             # return return $self->{Inner} ;
284              
285             # my $handle = Symbol::gensym();
286             # tie *$handle, "Archive::Zip::StreamedUnzip::Handle", $self->{SZ}{UnZip};
287             # return $handle;
288              
289 168         606 my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::StreamedUnzip::Handle", \$StreamedUnzipError) ;
290              
291 168         1983 *$z->{Open} = 1 ;
292 168         383 *$z->{SZ} = $self->{Inner};
293 168         569 Scalar::Util::weaken *$z->{SZ}; # for 5.8
294              
295 168         288 $z;
296             }
297              
298             sub close
299             {
300 84     84   179 my $self = shift;
301 84         211 return 1;
302             }
303              
304              
305             }
306              
307              
308             {
309             package Archive::Zip::StreamedUnzip::Handle ;
310              
311             sub TIEHANDLE
312             {
313 168 50   168   5294 return $_[0] if ref($_[0]);
314 0         0 die "OOPS\n" ;
315             }
316              
317             sub UNTIE
318             {
319 0     0   0 my $self = shift ;
320             }
321              
322             sub DESTROY
323             {
324             # print "DESTROY H";
325 168     168   85522 my $self = shift ;
326 168         1116 local ($., $@, $!, $^E, $?);
327 168         450 $self->close() ;
328              
329             # TODO - memory leak with 5.8.0 - this isn't called until
330             # global destruction
331             #
332 168         195 %{ *$self } = () ;
  168         765  
333 168         1276 undef $self ;
334             }
335              
336              
337             sub close
338             {
339 168     168   232 my $self = shift ;
340 168 50       480 return 1 if ! *$self->{Open};
341              
342 168         233 *$self->{Open} = 0 ;
343              
344             # untie *$self
345             # if $] >= 5.008 ;
346              
347 168 50       405 if (defined *$self->{SZ})
348             {
349             # *$self->{SZ}{Raw} = undef ;
350 168         361 *$self->{SZ} = undef ;
351             }
352              
353 168         207 1;
354             }
355              
356             sub read
357             {
358             # TODO - remember to fix the return value to match real read & not the broken one in IO::Uncompress
359 84     84   23566 my $self = shift;
360 84 50       198 $self->_stdPreq() or return 0 ;
361              
362             # warn "READ [$self]\n";
363             # warn "READ [*$self->{SZ}]\n";
364              
365             # $_[0] = *$self->{SZ}{Unzip};
366             # my $status = goto &IO::Uncompress::Base::read;
367             # $_[0] = \$_[0] unless ref $_[0];
368 84         427 my $status = *$self->{SZ}->read(@_);
369 84 50       34121 $status = undef if $status < 0 ;
370 84         322 return $status;
371             }
372              
373             sub readline
374             {
375 84     84   18177 my $self = shift;
376 84 50       218 $self->_stdPreq() or return 0 ;
377 84         435 *$self->{SZ}->getline(@_);
378             }
379              
380             sub tell
381             {
382 420     420   58533 my $self = shift;
383 420 50       847 $self->_stdPreq() or return 0 ;
384              
385 420         1599 *$self->{SZ}->tell(@_);
386             }
387              
388             sub eof
389             {
390 504     504   138538 my $self = shift;
391 504 50       1163 $self->_stdPreq() or return 0 ;
392              
393 504         1948 *$self->{SZ}->eof;
394             }
395              
396             sub _stdPreq
397             {
398 1092     1092   1326 my $self = shift;
399              
400             # TODO - fix me
401 1092         2708 return 1;
402              
403             return _setError("Zip file closed")
404 0 0 0       if ! defined defined *$self->{SZ} || ! *$self->{Inner}{Open} ;
405              
406              
407             return _setError("member filehandle closed")
408 0 0         if ! *$self->{Open} ; #|| ! defined *$self->{SZ}{Raw};
409              
410             return 0
411 0 0         if *$self->{SZ}{Error} ;
412              
413 0           return 1;
414             }
415              
416             sub _setError
417             {
418 0     0     $Archive::Zip::SimpleUnzip::StreamedUnzipError = $_[0] ;
419 0           return 0;
420             }
421              
422             sub clearerr
423             {
424 0     0     my $self = shift;
425              
426 0           return 0;
427             }
428              
429 0     0     sub binmode { 1 }
430              
431             # sub clearerr { $Archive::Zip::SimpleUnzip::StreamedUnzipError = '' }
432              
433             *BINMODE = \&binmode;
434             # *SEEK = \&seek;
435             *READ = \&read;
436             *sysread = \&read;
437             *TELL = \&tell;
438             *READLINE = \&readline;
439             *EOF = \&eof;
440             *FILENO = \&fileno;
441             *CLOSE = \&close;
442             }
443              
444              
445             1;
446              
447             __END__