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   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__