File Coverage

blib/lib/Archive/Zip/SimpleUnzip.pm
Criterion Covered Total %
statement 327 380 86.0
branch 72 126 57.1
condition 23 37 62.1
subroutine 57 70 81.4
pod 10 24 41.6
total 489 637 76.7


line stmt bran cond sub pod time code
1             package Archive::Zip::SimpleUnzip;
2              
3             require 5.006;
4              
5 2     2   1354 use strict ;
  2         3  
  2         46  
6 2     2   9 use warnings;
  2         3  
  2         40  
7 2     2   9 use bytes;
  2         2  
  2         7  
8              
9 2     2   32 use IO::File;
  2         7  
  2         260  
10 2     2   12 use Carp;
  2         3  
  2         91  
11 2     2   9 use Scalar::Util ();
  2         3  
  2         64  
12              
13 2     2   9 use IO::Compress::Base::Common 2.201 qw(:Status);
  2         39  
  2         225  
14 2     2   11 use IO::Compress::Zip::Constants 2.201 ;
  2         28  
  2         393  
15 2     2   11 use IO::Uncompress::Unzip 2.201 ;
  2         33  
  2         583  
16              
17              
18             require Exporter ;
19              
20             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $SimpleUnzipError);
21              
22             $VERSION = '1.000';
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   413 my $got = IO::Compress::Base::Parameters::new();
38              
39 169 50       1759 $got->parse(\%PARAMS, @_)
40             or _myDie("Parameter Error: " . $got->getError()) ;
41              
42 169         8639 return $got;
43             }
44              
45             sub _setError
46             {
47 256     256   473 $SimpleUnzipError = $_[2] ;
48 256 50       486 $_[0]->{Error} = $_[2]
49             if defined $_[0] ;
50              
51 256         811 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   6 return _setError(undef, undef, "Illegal Filename") ;
63             }
64              
65             sub is64BitPerl
66             {
67 2     2   12 use Config;
  2         9  
  2         3614  
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 6435 my $class = shift ;
75              
76 173 100       411 return _setError(undef, undef, "Missing Filename")
77             unless @_ ;
78              
79 172         221 my $inValue = shift ;
80 172         209 my $fh;
81              
82 172 100       293 if (!defined $inValue)
83             {
84 1         5 return _illegalFilename
85             }
86              
87 171         311 my $isSTDOUT = ($inValue eq '-') ;
88 171         466 my $inType = IO::Compress::Base::Common::whatIsOutput($inValue);
89              
90 171 100 33     4714 if ($inType eq 'filename')
    50          
91             {
92 114 100 66     2391 if (-e $inValue && ( ! -f _ || ! -r _))
      100        
93             {
94 1         5 return _illegalFilename
95             }
96              
97 113 100       863 $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         100 $fh = $inValue;
103             }
104             else
105             {
106 0         0 return _illegalFilename
107             }
108              
109 169         7453 my %obj ;
110              
111 169         390 my $got = _ckParams(@_);
112 169         366 my $filesOnly = $got->getValue('filesonly');
113              
114 169         711 my $inner = IO::Compress::Base::Common::createSelfTiedObject($class, \$SimpleUnzipError);
115              
116 169         5478 *$inner->{Pause} = 1;
117 169 50       408 $inner->_create(undef, 0, $fh)
118             or return undef;
119              
120 169         1435 my ($CD, $Members, $comment) = $inner->scanCentralDirectory($filesOnly);
121 169         349 $obj{CD} = $CD;
122 169         229 $obj{Members} = $Members ;
123 169         288 $obj{Comment} = $comment;
124 169         201 $obj{Cursor} = 0;
125 169         270 $obj{Inner} = $inner;
126 169         191 $obj{Open} = 1 ;
127              
128 169         1081 bless \%obj, $class;
129             }
130              
131             sub close
132             {
133 84     84 1 42038 my $self = shift;
134             # TODO - fix me
135             # $self->{Inner}->close();
136 84         228 return 1;
137             }
138              
139             sub DESTROY
140             {
141 338     338   19952 my $self = shift;
142             }
143              
144             sub resetter
145             {
146 1864     1864 0 1756 my $inner = shift;
147 1864         1611 my $member = shift;
148              
149              
150 1864         2353 *$inner->{NewStream} = 0 ;
151 1864         1940 *$inner->{EndStream} = 0 ;
152 1864         1716 *$inner->{TotalInflatedBytesRead} = 0;
153 1864         2165 *$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         2055 *$inner->{ZipData}{Streaming} = 0;
159 1864         2563 *$inner->{ZipData}{Crc32} = $member->{CRC32};
160 1864         2646 *$inner->{ZipData}{CompressedLen} = $member->{CompressedLength};
161 1864         2213 *$inner->{ZipData}{UnCompressedLen} = $member->{UncompressedLength};
162             *$inner->{CompressedInputLengthRemaining} =
163 1864         2963 *$inner->{CompressedInputLength} = $member->{CompressedLength};
164             }
165              
166             sub _readLocalHeader
167             {
168 765     765   681 my $self = shift;
169 765         618 my $member = shift;
170              
171 765         843 my $inner = $self->{Inner};
172              
173 765         1254 resetter($inner, $member);
174              
175 765         2047 my $status = $inner->smartSeek($member->{LocalHeaderOffset}, 0, SEEK_SET);
176 765         16282 $inner->_readFullZipHeader() ;
177 765         336696 $member->{DataOffset} = $inner->smartTell();
178             }
179              
180             sub comment
181             {
182 168     168 1 121732 my $self = shift;
183              
184 168         815 return $self->{Comment} ;
185             }
186              
187             sub _mkMember
188             {
189 765     765   745 my $self = shift;
190 765         719 my $member = shift;
191              
192 765         1341 $self->_readLocalHeader($member);
193              
194 765         6955 my %member ;
195 765         1200 $member{Inner} = $self->{Inner};
196 765         912 $member{Info} = $member;
197             #Scalar::Util::weaken $member{Inner}; # for 5.8
198              
199              
200 765         3207 return bless \%member, 'Archive::Zip::SimpleUnzip::Member';
201             }
202              
203             sub member
204             {
205 591     591 1 15622 my $self = shift;
206 591         587 my $name = shift;
207              
208 591 50       1165 return _setError(undef, undef, "Member '$name' not in zip")
209             if ! defined $name ;
210              
211 591         928 my $member = $self->{Members}{$name};
212              
213 591 100       1358 return _setError(undef, undef, "Member '$name' not in zip")
214             if ! defined $member ;
215              
216 339         499 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 2 my $self = shift;
245 1         6 my $name = shift;
246 1         3 my $out = shift;
247              
248 1 50       3 my $member = $self->member($name)
249             or return undef ;
250              
251 1 50       6 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 27487 my $self = shift;
276 421         609 my $name = shift;
277              
278 421 100       703 my $member = $self->member($name)
279             or return undef ;
280              
281 253         476 return $member->content();
282             }
283              
284             sub exists
285             {
286 336     336 1 64476 my $self = shift;
287 336         412 my $name = shift;
288              
289 336         1105 return exists $self->{Members}{$name};
290             }
291              
292             sub names
293             {
294 337     337 1 60587 my $self = shift ;
295 337 100       667 return wantarray ? map { $_->{Name} } @{ $self->{CD} } : scalar @{ $self->{CD} } ;
  756         1672  
  168         375  
  169         607  
296             }
297              
298             sub next
299             {
300 511     511 1 66883 my $self = shift;
301 511 100       612 return undef if $self->{Cursor} >= @{ $self->{CD} } ;
  511         1637  
302 426         845 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 5189 return ();
321             }
322              
323             sub ckParams
324             {
325 169     169 0 19158 my $self = shift ;
326 169         226 my $got = shift ;
327              
328             # unzip always needs crc32
329 169         385 $got->setValue('crc32' => 1);
330              
331 169         1064 return 1;
332             }
333              
334             sub mkUncomp
335             {
336 169     169 0 14076 my $self = shift ;
337 169         171 my $got = shift ;
338              
339 169 50       429 my $magic = $self->ckMagic()
340             or return 0;
341              
342 169         10850 return 1;
343             }
344              
345             sub chkTrailer
346             {
347 703     703 0 148779 my $self = shift;
348 703         763 my $trailer = shift;
349 703         928 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 850 my $self = shift ;
358 843         738 my $offset = shift ;
359 843         744 my $truncate = shift;
360 843   100     1543 my $position = shift || SEEK_SET;
361 843   50     1618 my $message = shift || "Error Seeking in CentralDirectory" ;
362              
363 843         1393 my $got = $self->smartSeek($offset, $truncate, $position);
364              
365 843         15096 return $got ;
366             }
367              
368             sub readOrDie
369             {
370             # temp method to die if bad read
371             # TODO - revisist
372 589     589 0 555 my $self = shift;
373              
374 589 50       874 $self->smartReadExact(@_)
375             or die "Error reading";
376             }
377              
378             sub scanCentralDirectory
379             {
380             # print "scanCentralDirectory\n";
381              
382 169     169 0 195 my $self = shift;
383 169         187 my $filesOnly = shift ; # *$self->{FilesOnly};
384 169         345 my $here = $self->smartTell();
385              
386             # Use cases
387             # 1 32-bit CD
388             # 2 64-bit CD
389              
390 169         1431 my @CD = ();
391 169         200 my %Members = ();
392 169         359 my ($entries, $offset, $zipcomment) = $self->findCentralDirectoryOffset();
393              
394             return ()
395 169 50       307 if ! defined $offset;
396              
397 169 50       295 return ([], {}, $zipcomment)
398             if $entries == 0;
399              
400 169         306 $self->seekOrDie($offset, 0, SEEK_SET) ;
401              
402             # Now walk the Central Directory Records
403 169         178 my $index = 0;
404 169         194 my $buffer ;
405 169   100     389 while ($self->smartReadExact(\$buffer, 46) &&
406             unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) {
407              
408 846         26016 my $crc32 = unpack("V", substr($buffer, 16, 4));
409 846         1056 my $compressedLength = unpack("V", substr($buffer, 20, 4));
410 846         999 my $uncompressedLength = unpack("V", substr($buffer, 24, 4));
411 846         988 my $filename_length = unpack("v", substr($buffer, 28, 2));
412 846         948 my $extra_length = unpack("v", substr($buffer, 30, 2));
413 846         903 my $comment_length = unpack("v", substr($buffer, 32, 2));
414 846         862 my $locHeaderOffset = unpack("V", substr($buffer, 42, 4));
415              
416 846         832 my $filename;
417             my $extraField;
418 846         794 my $comment = '';
419 846 50       1053 if ($filename_length)
420             {
421 846 50       1351 $self->smartReadExact(\$filename, $filename_length)
422             or return $self->TruncatedTrailer("filename");
423             # print "Filename [$filename]\n";
424             }
425              
426 846 50       23128 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     2002 if $filesOnly && substr($filename, -1, 1) eq '/' && $uncompressedLength == 0;
      66        
455              
456 762 100       901 if ($comment_length)
457             {
458 168 50       266 $self->smartReadExact(\$comment, $comment_length)
459             or return $self->TruncatedTrailer("comment");
460             }
461              
462 762         6716 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         1004 push @CD, \%data;
476 762         1211 $Members{$filename} = \%data ;
477              
478 762         1579 ++ $index;
479             }
480              
481 169         5442 $self->seekOrDie($here, 0, SEEK_SET) ;
482              
483 169         518 return (\@CD, \%Members, $zipcomment) ;
484             }
485              
486             sub offsetFromZip64
487             {
488             # print "offsetFromZip64\n";
489              
490 84     84 0 488 my $self = shift ;
491 84         106 my $here = shift;
492              
493 84         194 $self->seekOrDie($here - 20, 0, SEEK_SET) ;
494              
495 84         118 my $buffer;
496 84         114 my $got = 0;
497 84         203 $self->readOrDie(\$buffer, 20) ;
498             # or die "xxx $here $got $!" ;
499              
500 84 50       3093 if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) {
501 84         287 my $cd64 = U64::Value_VV64 substr($buffer, 8, 8);
502             # my $cd64 = unpack "Q<", substr($buffer, 8, 8);
503              
504 84         838 $self->seekOrDie($cd64, 0, SEEK_SET) ;
505              
506 84         203 $self->readOrDie(\$buffer, 4) ;
507              
508 84 50       3002 if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) {
509              
510 84         170 $self->readOrDie(\$buffer, 8);
511             # or die "xxx" ;
512 84         2354 my $size = U64::Value_VV64($buffer);
513             # my $size = unpack "Q<", $buffer;
514              
515 84         564 $self->readOrDie(\$buffer, $size);
516             # or die "xxx" ;
517              
518 84         2453 my $cd64 = U64::Value_VV64 substr($buffer, 36, 8);
519             # my $cd64 = unpack "Q<", substr($buffer, 36, 8);
520              
521 84         573 return $cd64 ;
522             }
523              
524 0         0 die "zzz1";
525             }
526              
527 0         0 die "zzz2";
528             }
529              
530 2     2   17 use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG);
  2         3  
  2         879  
531              
532             sub findCentralDirectoryOffset
533             {
534 169     169 0 210 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         406 $self->seekOrDie(-22, 0, SEEK_END) ;
541 169         370 my $here = $self->smartTell();
542              
543 169         1180 my $buffer;
544 169         444 $self->readOrDie(\$buffer, 22) ;
545              
546 169         6169 my $zip64 = 0;
547 169         179 my $centralDirOffset ;
548 169         191 my $comment = '';
549 169         169 my $entries = 0;
550 169 100       473 if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) {
551 85         187 $entries = unpack("v", substr($buffer, 8, 2));
552 85         146 $centralDirOffset = unpack("V", substr($buffer, 16, 4));
553             }
554             else {
555 84         220 $self->seekOrDie(0, 0, SEEK_END) ;
556              
557 84         189 my $fileLen = $self->smartTell();
558 84         639 my $want = 0 ;
559              
560 84         107 while(1) {
561 84         103 $want += 1024;
562 84         113 my $seekTo = $fileLen - $want;
563 84 50       198 if ($seekTo < 0 ) {
564 84         90 $seekTo = 0;
565 84         112 $want = $fileLen ;
566             }
567              
568 84         157 $self->seekOrDie($seekTo, 0, SEEK_SET) ;
569 84         137 my $got;
570 84         178 $self->readOrDie(\$buffer, $want) ;
571 84         3047 my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG);
572              
573 84 50       181 if ($pos >= 0) {
574              
575             #$here = $self->smartTell();
576 84         102 $here = $seekTo + $pos ;
577 84         215 $entries = unpack("v", substr($buffer, $pos + 8, 2));
578 84         164 $centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4));
579 84         125 my $comment_length = unpack("v", substr($buffer, $pos + 20, 2));
580 84 50       195 $comment = substr($buffer, $pos + 22, $comment_length)
581             if $comment_length ;
582              
583 84         142 last ;
584             }
585              
586             return undef
587 0 0       0 if $want == $fileLen;
588             }
589             }
590              
591 169 100 66     539 $centralDirOffset = $self->offsetFromZip64($here)
592             if $entries and U64::full32 $centralDirOffset ;
593              
594             # print "findCentralDirectoryOffset $centralDirOffset [$comment]\n";
595 169         687 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   12 use IO::File ;
  2         4  
  2         301  
615 2     2   12 use File::Basename;
  2         3  
  2         152  
616 2     2   11 use File::Path ;
  2         3  
  2         2615  
617              
618             sub name
619             {
620 510     510   95124 my $self = shift;
621             # $self->_stdPreq() or return 0 ;
622              
623 510         2554 return $self->{Info}{Name};
624             }
625              
626             sub isDirectory
627             {
628 526     526   590 my $self = shift;
629             # $self->_stdPreq() or return 0 ;
630              
631             return substr($self->{Info}{Name}, -1, 1) eq '/' &&
632 526   66     4252 $self->{Info}{UncompressedLength} == 0 ;
633             }
634              
635             sub isFile
636             {
637 428     428   471 my $self = shift;
638             # $self->_stdPreq() or return 0 ;
639              
640             # TODO - test for symlink
641 428         599 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   1208 my $self = shift;
681 841         763 my $data ;
682              
683 841         1033 my $inner = $self->{Inner};
684              
685 841 100       1932 $inner->reset() if $self->{NeedsReset}; $self->{NeedsReset} ++ ;
  841         4759  
686 841         1521 Archive::Zip::SimpleUnzip::resetter($inner, $self->{Info});
687              
688 841         2203 $inner->smartSeek($self->{Info}{DataOffset}, 0, SEEK_SET);
689 841         17726 $self->{Inner}->read($data, $self->{Info}{UncompressedLength});
690              
691 841         51265 return $data;
692             }
693              
694             sub open
695             {
696 258     258   391 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         705 my $z = IO::Compress::Base::Common::createSelfTiedObject("Archive::Zip::SimpleUnzip::Handle", \$SimpleUnzipError) ;
705              
706 258         2461 *$z->{Open} = 1 ;
707 258         410 *$z->{SZ} = $self->{Inner};
708              
709 258         295 my $inner = $self->{Inner};
710 258 100       586 $inner->reset() if $self->{NeedsReset}; $self->{NeedsReset} ++ ;
  258         1536  
711 258         574 Archive::Zip::SimpleUnzip::resetter($self->{Inner}, $self->{Info});
712 258         751 $inner->smartSeek($self->{Info}{DataOffset}, 0, SEEK_SET);
713              
714 258         5679 Scalar::Util::weaken *$z->{SZ}; # for 5.8
715              
716 258         468 $z;
717             }
718              
719             sub close
720             {
721 84     84   142 my $self = shift;
722 84         176 return 1;
723             }
724              
725             sub comment
726             {
727 420     420   643 my $self = shift;
728              
729 420         2091 return $self->{Info}{Comment};
730             }
731              
732             sub _canonicalPath
733             {
734 12     12   19 my $name = shift ;
735              
736             # Not an absolute path
737 12         25 $name =~ s#^/+## ;
738              
739             # Remove trailing slash
740 12         35 $name =~ s#/+$## ;
741              
742 12         46 $name =~ s#/+#/#g ;
743              
744             # Drop any ".." and "." paths
745             # Use of ".." is unsafe
746 12         35 my @paths = split '/', $name ;
747 12         20 my @have = grep { ! m#^\.(\.)?$# } @paths ;
  26         53  
748              
749 12         35 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   29 my $self = shift;
764              
765 6         20 return join '/', _canonicalPath($self->{Info}{Name});
766             }
767              
768             sub extract # to file
769             {
770 8     8   26 my $self = shift;
771 8         11 my $out = shift;
772              
773 8         13 my $path ;
774             my $filename ;
775              
776 8 100       18 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       18 my @path = _canonicalPath(defined $out ? $out : $self->{Info}{Name}) ;
785 6         16 $filename = join '/', @path ;
786             }
787              
788 8 100       23 $path = $self->isDirectory() ? $filename : dirname $filename;
789              
790 8 50       25 if (defined $path)
791             {
792             # check path isn't already a plain file
793 8 50 66     192 return _setError("Path is not a directory '$path'")
794             if -e $path && ! -d $path ;
795              
796 8 100       67 if (! -d $path)
797             {
798 4         8 my $error ;
799 4 50       831 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       41 if ($self->isFile())
807             {
808 6         21 my $handle = $self->open();
809 6 50       40 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         734 my $data;
814 6         27 print $fh $data
815             while $handle->read($data);
816 6         23 $handle->close();
817 6         27 $fh->close();
818             }
819              
820             # TODO - set timestamps etc...
821              
822 8         46 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   7073 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   87992 my $self = shift ;
851 258         1366 local ($., $@, $!, $^E, $?);
852 258         502 $self->close() ;
853              
854             # TODO - memory leak with 5.8.0 - this isn't called until
855             # global destruction
856             #
857 258         275 %{ *$self } = () ;
  258         895  
858 258         1700 undef $self ;
859             }
860              
861              
862             sub close
863             {
864 348     348   33306 my $self = shift ;
865 348 100       883 return 1 if ! *$self->{Open};
866              
867 258         346 *$self->{Open} = 0 ;
868              
869             # untie *$self
870             # if $] >= 5.008 ;
871              
872 258 50       509 if (defined *$self->{SZ})
873             {
874             # *$self->{SZ}{Raw} = undef ;
875 258         373 *$self->{SZ} = undef ;
876             }
877              
878 258         473 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   120815 my $self = shift;
885 599 50       977 $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         1730 my $status = *$self->{SZ}->read(@_);
894 599 50       18952 $status = undef if $status < 0 ;
895 599         1067 return $status;
896             }
897              
898             sub readline
899             {
900 84     84   16664 my $self = shift;
901 84 50       148 $self->_stdPreq() or return 0 ;
902 84         373 *$self->{SZ}->getline(@_);
903             }
904              
905             sub tell
906             {
907 1008     1008   61363 my $self = shift;
908 1008 50       1245 $self->_stdPreq() or return 0 ;
909              
910 1008         2415 *$self->{SZ}->tell(@_);
911             }
912              
913             sub eof
914             {
915 672     672   107497 my $self = shift;
916 672 50       1086 $self->_stdPreq() or return 0 ;
917              
918 672         1704 *$self->{SZ}->eof;
919             }
920              
921             sub _stdPreq
922             {
923 2363     2363   2110 my $self = shift;
924              
925             # TODO - fix me
926 2363         4258 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__