File Coverage

blib/lib/LibZip/MyArchZip.pm
Criterion Covered Total %
statement 277 360 76.9
branch 65 146 44.5
condition 12 35 34.2
subroutine 60 83 72.2
pod 0 27 0.0
total 414 651 63.5


line stmt bran cond sub pod time code
1             ##########################################
2             # SIMPLE ARCHIVE::ZIP INDEPENDENT MODULE #
3             ##########################################
4            
5             package LibZip::MyArchZip ;
6            
7 2     2   11 no warnings ;
  2         4  
  2         142  
8            
9 2     2   11 no strict ;
  2         5  
  2         83  
10             #use vars qw($CHUNKSIZE) ;
11            
12             #use Compress'Zlib();
13 2     2   828 use LibZip::MyZlib ;
  2         6  
  2         61  
14 2     2   1241 use LibZip::MyFile ;
  2         6  
  2         336  
15             #use File::Spec;
16             #use File::Path;
17            
18             #########
19             # BEGIN #
20             #########
21            
22             sub BEGIN {
23 2     2   5324 $CHUNKSIZE = 1024*32 ; ## Memory to use!
24             }
25            
26             #############
27             # CONSTANTS #
28             #############
29            
30 6     6 0 31 sub END_CENTDIR_LENGTH { 18 }
31 10     10 0 83 sub END_CENTDIR_SIGN { 0x06054b50 }
32 2     2 0 9 sub END_CENTDIR_SIGN_STR { pack( "V", END_CENTDIR_SIGN ) }
33            
34 2     2 0 36 sub END_CENTDIR_FORMAT { "v4 V2 v" } ;
35            
36 6     6 0 17 sub SIGNATURE_FORMAT {"V"}
37 15     15 0 72 sub SIGNATURE_LENGTH { 4 }
38            
39             sub CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE { 0x02014b50 }
40            
41 2     2 0 109 sub LOCAL_FILE_HEADER_SIGNATURE { 0x04034b50 }
42 1     1 0 9 sub LOCAL_FILE_HEADER_FORMAT { "v3 V4 v2" }
43 2     2 0 20 sub LOCAL_FILE_HEADER_LENGTH { 26 }
44            
45 8     8 0 25 sub CENTRAL_DIRECTORY_FILE_HEADER_LENGTH { 42 }
46 6     6 0 171 sub CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE { 0x02014b50 }
47 4     4 0 41 sub CENTRAL_DIRECTORY_FILE_HEADER_FORMAT { "C2 v3 V4 v5 V2" }
48            
49 22     22 0 367 sub COMPRESSION_STORED { 0 } # file is stored (no compression)
50 1     1 0 8 sub COMPRESSION_DEFLATED { 8 } # file is Deflated
51            
52 6     6 0 106 sub COMPRESSION_LEVEL_NONE { 0 }
53 0     0 0 0 sub COMPRESSION_LEVEL_DEFAULT { -1 }
54 0     0 0 0 sub COMPRESSION_LEVEL_FASTEST { 1 }
55 0     0 0 0 sub COMPRESSION_LEVEL_BEST_COMPRESSION { 9 }
56            
57 2     2 0 8 sub GPBF_ENCRYPTED_MASK { 1 << 0 }
58            
59             #######
60             # NEW #
61             #######
62            
63             sub new {
64 2     2 0 6 my $class = shift ;
65 2         37 my $self = bless( {
66             'diskNumber' => 0,
67             'diskNumberWithStartOfCentralDirectory' => 0,
68             'numberOfCentralDirectoriesOnThisDisk' => 0, # shld be # of members
69             'numberOfCentralDirectories' => 0, # shld be # of members
70             'centralDirectorySize' => 0, # must re-compute on write
71             'centralDirectoryOffsetWRTStartingDiskNumber' => 0, # must re-compute
72             'writeEOCDOffset' => 0,
73             'writeCentralDirectoryOffset' => 0,
74             'eocdOffset' => 0,
75             'fileName' => ''
76             },
77             $class
78             );
79            
80 2         22 $self->{'members'} = [];
81            
82 2 50       8 if (@_) { $self->read(@_) ;}
  0         0  
83            
84 2         9 return $self;
85             }
86            
87             ########
88             # READ #
89             ########
90            
91             sub read {
92 2     2 0 5 my $self = shift;
93 2         3 my $fileName = shift;
94            
95 2 50       10 return _error('No filename given') unless $fileName ;
96            
97 2         40 my $ZIPFL ;
98 2         70 open ($ZIPFL,$fileName) ; binmode($ZIPFL) ;
  2         10  
99            
100 2         6 $self->{'fileName'} = $fileName ;
101 2         5 $self->{'fh'} = $ZIPFL ;
102            
103 2 50       9 if (! $self->_find_end_centdir($ZIPFL) ) { return( undef ) ;}
  0         0  
104            
105 2         4 my $eocdPosition = tell($ZIPFL) ;
106            
107 2 50       10 if (! $self->_read_end_centdir($ZIPFL) ) { return( undef ) ;}
  0         0  
108            
109 2 50       18 seek( $ZIPFL , $eocdPosition - $self->{'centralDirectorySize'} , 0 ) || return _error("Can't seek $fileName");
110            
111 2         6 $self->{'eocdOffset'} = $eocdPosition - $self->{'centralDirectorySize'} - $self->{'centralDirectoryOffsetWRTStartingDiskNumber'} ;
112            
113 2         4 for (;;) {
114 6         28 my $newMember = LibZip::MyArchZip::Member->_newFromZipFile( $ZIPFL , $fileName ) ;
115 6         23 my ( $status, $signature ) = $self->_readSignature( $ZIPFL , $fileName ) ;
116            
117 6 50       21 return $status if !$status ;
118            
119 6 100       14 last if $signature == END_CENTDIR_SIGN ;
120            
121 4 50       14 if (! $newMember->_readCentralDirectoryFileHeader() ) { return( undef ) ;}
  0         0  
122            
123 4         19 $newMember->endRead();
124            
125 4         8 $newMember->{'localHeaderRelativeOffset'} += $self->{'eocdOffset'} ;
126            
127 4         5 push ( @{ $self->{'members'} }, $newMember );
  4         18  
128             }
129            
130 2         9 return( 1 ) ;
131             }
132            
133             #################
134             # EXTRACTMEMBER #
135             #################
136            
137             sub extractMember {
138 1     1 0 2 my $self = shift;
139 1         2 my $member = shift;
140            
141 1 50       7 $member = $self->memberNamed($member) unless ref($member);
142 1 50       5 return _error('member not found') unless $member;
143            
144 1         2 my $name = shift; # local FS name if given
145 1 50       5 if (! defined($name)) { return _error('No save name past to extract!') ;}
  0         0  
146            
147 1         14 my ( $volumeName, $dirName, $fileName ) = LibZip::File::Spec->splitpath($name);
148 1         6 $dirName = LibZip::File::Spec->catpath( $volumeName, $dirName, '' );
149            
150 1 50       21 LibZip::File::Path::mkpath($dirName) if ( !-d $dirName );
151 1 50       15 return _error("can't create dir $dirName") if ( !-d $dirName );
152 1         5 return $member->extractToFileNamed( $name, @_ );
153             }
154            
155             ###############
156             # EXTRACTTREE #
157             ###############
158            
159             sub extractTree {
160 0     0 0 0 my $self = shift ();
161 0   0     0 my $root = shift () || ''; # Zip format
162 0   0     0 my $dest = shift || '.'; # Zip format
163 0         0 my $volume = shift; # optional
164 0         0 my $pattern = qr{^\Q$root};
165 0         0 my @members = $self->membersMatching($pattern);
166 0         0 my $slash = qr{/};
167            
168 0         0 foreach my $member (@members) {
169 0         0 my $fileName = $member->{'fileName'} ; # in Unix format
170 0         0 $fileName =~ s{$pattern}{$dest}; # in Unix format
171             # convert to platform format:
172            
173 0         0 my $status = $member->extractToFileNamed($fileName);
174 0 0       0 return $status if $status != 0;
175             }
176 0         0 return 0;
177             }
178            
179             ###################
180             # MEMBERSMATCHING #
181             ###################
182            
183             sub membersMatching {
184 0     0 0 0 my ( $self, $pattern ) = @_ ;
185 0         0 return grep { $_->{'fileName'} =~ /$pattern/ } $self->members();
  0         0  
186             }
187            
188            
189            
190             ###########
191             # MEMBERS #
192             ###########
193            
194 4     4 0 6 sub members { @{ shift->{'members'} } ;}
  4         32  
195            
196             ###############
197             # MEMBERNAMES #
198             ###############
199            
200             sub memberNames {
201 2     2 0 6 my $self = shift;
202 2         14 return map { $_->{'fileName'} } $self->members() ;
  4         19  
203             }
204            
205             ###############
206             # MEMBERNAMED #
207             ###############
208            
209             sub memberNamed {
210 2     2 0 4 my ( $self, $fileName ) = @_;
211 2 50       6 foreach my $member ( $self->members() ) { return $member if $member->{'fileName'} eq $fileName ;}
  2         48  
212 0         0 return undef;
213             }
214            
215             ##################
216             # _READSIGNATURE #
217             ##################
218            
219             sub _readSignature {
220 6     6   7 my $self = shift;
221 6         9 my $fh = shift;
222 6         8 my $fileName = shift;
223 6         8 my $signatureData;
224            
225 6         55 my $bytesRead = read( $fh , $signatureData , SIGNATURE_LENGTH );
226            
227 6 50       22 if ( $bytesRead != SIGNATURE_LENGTH ) { return _error("reading header signature") ;}
  0         0  
228            
229 6         16 my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
230            
231 6         12 my $status = 1;
232            
233 6 50 66     15 if ( $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE &&
      66        
234             $signature != LOCAL_FILE_HEADER_SIGNATURE &&
235             $signature != END_CENTDIR_SIGN ) {
236            
237 0         0 my $errmsg = sprintf( "bad signature: 0x%08x", $signature );
238 0 0       0 if (-f $self->{'fh'} ) { $errmsg .= sprintf( " at offset %d", tell($fh) - SIGNATURE_LENGTH ) ;}
  0         0  
239            
240 0         0 $status = _error("$errmsg in file $fileName");
241             }
242            
243 6         17 return ( $status, $signature );
244             }
245            
246             #####################
247             # _READ_END_CENTDIR #
248             #####################
249            
250             sub _read_end_centdir {
251 2     2   4 my $self = shift;
252 2         4 my $fh = shift;
253            
254 2 50       8 seek( $fh , SIGNATURE_LENGTH, 1 ) || return _error("Can't seek past EOCD signature") ;
255            
256 2         4 my $header ;
257 2         6 my $bytesRead = read( $fh , $header, END_CENTDIR_LENGTH );
258 2 50       14 if ( $bytesRead != END_CENTDIR_LENGTH ) { return _error("reading end of central directory $bytesRead") ;}
  0         0  
259            
260 2         4 my $zipfileCommentLength;
261            
262 2         10 ( $self->{'diskNumber'},
263             $self->{'diskNumberWithStartOfCentralDirectory'},
264             $self->{'numberOfCentralDirectoriesOnThisDisk'},
265             $self->{'numberOfCentralDirectories'},
266             $self->{'centralDirectorySize'},
267             $self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
268             $zipfileCommentLength ) = unpack( END_CENTDIR_FORMAT , $header );
269            
270 2         14 return( 1 ) ;
271             }
272            
273             #####################
274             # _FIND_END_CENTDIR #
275             #####################
276            
277             sub _find_end_centdir {
278 2     2   5 my $self = shift;
279 2         4 my $fh = shift;
280            
281 2         18 seek($fh, 0, 2) ;
282            
283 2         5 my $fileLength = tell($fh) ;
284            
285 2 50       9 if ($fileLength < END_CENTDIR_LENGTH+4) { _error("file is too short!") ;}
  0         0  
286            
287 2         45 my $seekOffset = 0;
288 2         5 my $pos = -1;
289 2         3 my $data ;
290            
291 2         3 for (;;) {
292 2         4 $seekOffset += 512;
293 2 50       9 $seekOffset = $fileLength if ( $seekOffset > $fileLength ) ;
294            
295 2 50       18 seek($fh, -$seekOffset , 2) || return _error("seek failed") ;
296            
297 2         34 my $bytesRead = read($fh, $data , $seekOffset) ;
298            
299 2 50       9 if ( $bytesRead != $seekOffset ) { return _error("read failed") ;}
  0         0  
300            
301 2         10 $pos = rindex( $data, END_CENTDIR_SIGN_STR ) ;
302            
303 2 0 33     13 if ( $pos >= 0 || $seekOffset == $fileLength || $seekOffset >= $CHUNKSIZE ) { last ;}
  2   33     5  
304             }
305            
306 2 50       8 if ( $pos >= 0 ) {
307 2 50       20 seek($fh, $pos-$seekOffset , 1) || return _error("seeking to EOCD") ;
308 2         10 return( 1 ) ;
309             }
310 0         0 else { return _error("can't find EOCD signature") ;}
311             }
312            
313             ##########
314             # _ERROR #
315             ##########
316            
317 0     0   0 sub _error { warn "ERROR: $_[0]\n" ; return( undef ) ;}
  0         0  
318            
319             ################################################################################
320             # LIBZIP::MYARCHZIP::MEMBER
321             ################################################################################
322            
323             package LibZip::MyArchZip::Member ;
324            
325             #use Compress'Zlib ();
326 2     2   26 use LibZip::MyZlib ;
  2         4  
  2         49  
327 2     2   42 use LibZip::MyFile ;
  2         3  
  2         525  
328             #use File::Path;
329             #use File::Basename;
330            
331 0     0   0 sub _error { LibZip::MyArchZip::_error(@_) ;}
332            
333 0     0   0 sub Z_OK {0}
334 0     0   0 sub Z_STREAM_END {1}
335 0     0   0 sub MAX_WBITS {15}
336            
337             #########
338             # BEGIN #
339             #########
340            
341             sub BEGIN {
342            
343 2     2   8 my @CONST = qw(
344             CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
345             CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
346             CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
347             CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
348             COMPRESSION_DEFLATED
349             COMPRESSION_LEVEL_BEST_COMPRESSION
350             COMPRESSION_LEVEL_DEFAULT
351             COMPRESSION_LEVEL_FASTEST
352             COMPRESSION_LEVEL_NONE
353             COMPRESSION_STORED
354             END_CENTDIR_FORMAT
355             END_CENTDIR_LENGTH
356             END_CENTDIR_SIGN
357             END_CENTDIR_SIGN_STR
358             GPBF_ENCRYPTED_MASK
359             LOCAL_FILE_HEADER_FORMAT
360             LOCAL_FILE_HEADER_LENGTH
361             LOCAL_FILE_HEADER_SIGNATURE
362             SIGNATURE_FORMAT
363             SIGNATURE_LENGTH
364             ) ;
365            
366 2         6 foreach my $CONST_i ( @CONST ) {
367 40     4   10076 eval(qq` sub $CONST_i { &LibZip::MyArchZip::$CONST_i } `);
  4     8   83  
  8     0   25  
  0     1   0  
  1     0   4  
  0     0   0  
  0     0   0  
  0     6   0  
  6     22   24  
  22     0   62  
  0     0   0  
  0     0   0  
  0     0   0  
  0     2   0  
  2     1   8  
  1     2   5  
  2     0   6  
  0     0   0  
  0     1   0  
  1         5  
368             }
369            
370             }
371            
372             ###################
373             # _NEWFROMZIPFILE #
374             ###################
375            
376             sub _newFromZipFile {
377 6     6   9 my $class = shift;
378 6         9 my $fh = shift;
379 6         10 my $externalFileName = shift;
380            
381 6         217 my $self = {
382             'lastModFileDateTime' => 0,
383             'fileAttributeFormat' => FA_UNIX,
384             'versionMadeBy' => 20,
385             'versionNeededToExtract' => 20,
386             'bitFlag' => 0,
387             'compressionMethod' => COMPRESSION_STORED,
388             'desiredCompressionMethod' => COMPRESSION_STORED,
389             'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE,
390             'internalFileAttributes' => 0,
391             'externalFileAttributes' => 0, # set later
392             'fileName' => '',
393             'cdExtraField' => '',
394             'localExtraField' => '',
395             'fileComment' => '',
396             'crc32' => 0,
397             'compressedSize' => 0,
398             'uncompressedSize' => 0,
399             'diskNumberStart' => 0,
400             'localHeaderRelativeOffset' => 0,
401             'dataOffset' => 0, # localHeaderRelativeOffset + header length
402             @_
403             };
404 6         23 bless( $self, $class );
405 6         21 $self->{'externalFileName'} = $externalFileName;
406 6         13 $self->{'fh'} = $fh;
407 6         14 return $self ;
408             }
409            
410             ###################################
411             # _READCENTRALDIRECTORYFILEHEADER #
412             ###################################
413            
414             sub _readCentralDirectoryFileHeader {
415 4     4   8 my $self = shift;
416 4         6 my $fh = $self->{'fh'} ;
417            
418 4         6 my $header ;
419 4         116 my $bytesRead = read($fh , $header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH );
420            
421 4 50       103 if ( $bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH ) { return _error("reading central dir header") ;}
  0         0  
422            
423 4         6 my ( $fileNameLength, $extraFieldLength, $fileCommentLength ) ;
424            
425 4         106 ( $self->{'versionMadeBy'}, $self->{'fileAttributeFormat'},
426             $self->{'versionNeededToExtract'}, $self->{'bitFlag'},
427             $self->{'compressionMethod'}, $self->{'lastModFileDateTime'},
428             $self->{'crc32'}, $self->{'compressedSize'},
429             $self->{'uncompressedSize'}, $fileNameLength,
430             $extraFieldLength, $fileCommentLength,
431             $self->{'diskNumberStart'}, $self->{'internalFileAttributes'},
432             $self->{'externalFileAttributes'}, $self->{'localHeaderRelativeOffset'} ) = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
433            
434 4 50       18 if ($fileNameLength) {
435 4         13 $bytesRead = read( $fh , $self->{'fileName'}, $fileNameLength );
436 4 50       18 if ( $bytesRead != $fileNameLength ) { _error("reading central dir filename") ;}
  0         0  
437             }
438            
439 4 50       10 if ($extraFieldLength) {
440 0         0 $bytesRead = read($fh , $self->{'cdExtraField'}, $extraFieldLength );
441 0 0       0 if ( $bytesRead != $extraFieldLength ) { return _error("reading central dir extra field") ;}
  0         0  
442             }
443            
444 4 50       12 if ($fileCommentLength) {
445 0         0 $bytesRead = read($fh , $self->{'fileComment'}, $fileCommentLength );
446 0 0       0 if ( $bytesRead != $fileCommentLength ) { return _error("reading central dir file comment") ;}
  0         0  
447             }
448            
449 4         15 $self->desiredCompressionMethod( $self->{'compressionMethod'} );
450            
451 4         14 return 1 ;
452             }
453            
454             ############################
455             # DESIREDCOMPRESSIONMETHOD #
456             ############################
457            
458             sub desiredCompressionMethod {
459 7     7   12 my $self = shift;
460 7         9 my $newDesiredCompressionMethod = shift;
461 7         19 my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
462            
463 7 100       19 if ( defined($newDesiredCompressionMethod) ) {
464 6         8 $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
465            
466 6 50       162 if ( $newDesiredCompressionMethod == COMPRESSION_STORED ) {
    0          
467 6         13 $self->{'desiredCompressionLevel'} = 0;
468             }
469             elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED ) {
470 0         0 $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
471             }
472             }
473            
474 7         13 return $oldDesiredCompressionMethod;
475             }
476            
477             ###########
478             # ENDREAD #
479             ###########
480            
481             sub endRead {
482 6     6   723 my $self = shift;
483 6         15 $self->{'fh'} = undef;
484 6         24 delete $self->{'inflater'};
485 6         8 delete $self->{'deflater'};
486 6         10 $self->{'dataEnded'} = 1;
487 6         9 $self->{'readDataRemaining'} = 0;
488 6         11 return 0 ;
489             }
490            
491             ###############################
492             # _BECOMEDIRECTORYIFNECESSARY #
493             ###############################
494            
495 0     0   0 sub _becomeDirectoryIfNecessary { 1 }
496            
497             ###############
498             # ISDIRECTORY #
499             ###############
500            
501             sub isDirectory {
502 0     0   0 my $self = shift;
503 0   0     0 return ( substr( $self->{'fileName'} , -1) eq '/' and $self->{'uncompressedSize'} == 0 );
504             }
505            
506             ######################
507             # EXTRACTTOFILENAMED #
508             ######################
509            
510             sub extractToFileNamed {
511 1     1   2 my $self = shift;
512 1         2 my $name = shift; # local FS name
513 1 50       5 return _error("encryption unsupported") if $self->isEncrypted();
514            
515 1         4 LibZip::File::Path::mkpath( LibZip::File::Basename::dirname($name) ); # croaks on error
516            
517 1         2 my $fh ;
518 1         81 open ($fh,">$name") ; binmode($fh) ;
  1         3  
519 1         10 my $retval = $self->extractToFileHandle($fh) ;
520 1         46 close($fh) ;
521            
522 1         37 utime( $self->{'lastModTime'}, $self->{'lastModTime'}, $name );
523            
524 1         6 return $retval;
525             }
526            
527             #######################
528             # EXTRACTTOFILEHANDLE #
529             #######################
530            
531             sub extractToFileHandle {
532 1     1   2 my $self = shift;
533 1 50       3 return _error("encryption unsupported") if $self->isEncrypted();
534 1         2 my $fh = shift;
535 1         2 binmode($fh) ;
536            
537 1         28 my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED);
538            
539 1         3 $self->{'fh'} = undef ;
540            
541 1         4 my $status = $self->rewindData2(@_);
542            
543 1 50       13 $status = $self->_writeData($fh) if $status == 0 ;
544            
545 1         4 $self->desiredCompressionMethod($oldCompression);
546 1         4 $self->endRead();
547            
548 1         2 return $status;
549             }
550            
551             ##############
552             # REWINDDATA #
553             ##############
554            
555             sub rewindData {
556 1     1   2 my $self = shift;
557 1         2 my $status;
558            
559 1         10 $self->{'chunkHandler'} = $self->can('_noChunk');
560            
561             # Work around WinZip bug with 0-length DEFLATED files
562 1 50       4 $self->desiredCompressionMethod(COMPRESSION_STORED) if $self->{'uncompressedSize'} == 0 ;
563            
564             # assume that we're going to read the whole file, and compute the CRC anew.
565            
566 1 50       27 $self->{'crc32'} = 0 if ( $self->{'compressionMethod'} == COMPRESSION_STORED );
567            
568 1 50 33     27 if ( $self->{'compressionMethod'} == COMPRESSION_DEFLATED && $self->desiredCompressionMethod() == COMPRESSION_STORED ) {
    50          
569 0         0 ( $self->{'inflater'}, $status ) = LibZip::MyZlib::inflateInit(
570             '-WindowBits' => -MAX_WBITS(),
571             @_
572             );
573            
574 0 0       0 return _error( 'inflateInit error!' ) unless $status == 0 ;
575 0         0 $self->{'chunkHandler'} = $self->can('_inflateChunk');
576             }
577            
578 1         5 elsif ( $self->{'compressionMethod'} == $self->desiredCompressionMethod() ) { $self->{'chunkHandler'} = $self->can('_copyChunk') ;}
579            
580             else {
581 0         0 return _error(
582             sprintf( "Unsupported compression combination: read %d, write %d", $self->{'compressionMethod'}, $self->desiredCompressionMethod() )
583             );
584             }
585            
586 1 50       32 $self->{'readDataRemaining'} = ( $self->{'compressionMethod'} == COMPRESSION_STORED ) ? $self->{'uncompressedSize'} : $self->{'compressedSize'} ;
587 1         2 $self->{'dataEnded'} = 0;
588 1         2 $self->{'readOffset'} = 0;
589            
590 1         3 return 0 ;
591             }
592            
593             ###############
594             # REWINDDATA2 #
595             ###############
596            
597             sub rewindData2 {
598 1     1   2 my $self = shift;
599            
600 1         5 my $status = $self->rewindData(@_);
601 1 50       3 return $status unless $status == 0;
602            
603 1 50       12 return 4 unless $self->fh() ;
604            
605             # Seek to local file header.
606             # The only reason that I'm doing this this way is that the extraField
607             # length seems to be different between the CD header and the LF header.
608 1 50       32 seek( $self->{'fh'} , $self->{'localHeaderRelativeOffset'} + SIGNATURE_LENGTH , 0 ) or return _error("seeking to local header");
609            
610            
611             # skip local file header
612 1         17 $status = $self->_skipLocalFileHeader();
613 1 50       4 return $status unless $status == 0 ;
614            
615             # Seek to beginning of file data
616 1 50       8 seek($self->{'fh'} , $self->{'dataOffset'} , 0 ) || return _error("seeking to beginning of file data") ;
617            
618 1         2 return 0 ;
619             }
620            
621             ########################
622             # _SKIPLOCALFILEHEADER #
623             ########################
624            
625             sub _skipLocalFileHeader {
626 1     1   3 my $self = shift;
627 1         2 my $header;
628 1         28 my $bytesRead = read($self->{'fh'} , $header, LOCAL_FILE_HEADER_LENGTH );
629 1 50       46 if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH ) { return _error("reading local file header") ;}
  0         0  
630            
631 1         3 my $fileNameLength;
632             my $extraFieldLength;
633            
634             ( undef, # $self->{'versionNeededToExtract'},
635             undef, # $self->{'bitFlag'},
636             undef, # $self->{'compressionMethod'},
637             undef, # $self->{'lastModFileDateTime'},
638             undef, # $crc32,
639             undef, # $compressedSize,
640             undef, # $uncompressedSize,
641 1         27 $fileNameLength,
642             $extraFieldLength )
643             = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
644            
645 1 50       4 if ($fileNameLength) {
646 1 50       12 seek($self->{'fh'} , $fileNameLength, 1 ) || return _error("skipping local file name") ;
647             }
648            
649 1 50       3 if ($extraFieldLength) {
650 0         0 $bytesRead = read( $self->{'fh'} , $self->{'localExtraField'}, $extraFieldLength );
651 0 0       0 if ( $bytesRead != $extraFieldLength ) { return _error("reading local extra field") ;}
  0         0  
652             }
653            
654 1         4 $self->{'dataOffset'} = tell($self->{'fh'}) ;
655            
656 1         2 return 0 ;
657             }
658            
659             ##############
660             # _WRITEDATA #
661             ##############
662            
663             sub _writeData {
664 1     1   2 my $self = shift;
665 1         3 my $writeFh = shift;
666            
667 1 50       3 return 0 if ( $self->{'uncompressedSize'} == 0 ) ;
668            
669 1         2 my $status;
670 1         6 my $chunkSize = $LibZip::MyArchZip::CHUNKSIZE ;
671            
672 1         3 while ( $self->{'readDataRemaining'} > 0 ) {
673 1         1 my $outRef;
674 1         6 ( $outRef, $status ) = $self->readChunk($chunkSize);
675 1 50 33     5 return $status if ( $status != 0 and $status != 1 );
676            
677 1 50       3 if ( length($$outRef) > 0 ) {
678 1   50     15 print $writeFh $$outRef || return _error("write error during copy");
679             }
680            
681 1 50       6 last if $status == 1 ;
682             }
683            
684 1         3 $self->{'compressedSize'} = $self->{'writeOffset'} ;
685 1         2 return 0 ;
686             }
687            
688             #############
689             # READCHUNK #
690             #############
691            
692             sub readChunk {
693 1     1   2 my ( $self, $chunkSize ) = @_;
694            
695 1 50       4 if ( $self->readIsDone() ) {
696 0         0 $self->endRead();
697 0         0 my $dummy = '';
698 0         0 return ( \$dummy, 1 );
699             }
700            
701 1 50       5 $chunkSize = $LibZip::MyArchZip::CHUNKSIZE if not defined($chunkSize);
702 1 50       4 $chunkSize = $self->{'readDataRemaining'} if $chunkSize > $self->{'readDataRemaining'} ;
703            
704 1         3 my $buffer ;
705             my $outputRef;
706 1         11 my ( $bytesRead, $status ) = $self->_readRawChunk( \$buffer, $chunkSize );
707 1 50       4 return ( \$buffer, $status ) unless $status == 0 ;
708            
709 1         2 $self->{'readDataRemaining'} -= $bytesRead;
710 1         2 $self->{'readOffset'} += $bytesRead;
711            
712 1 50       33 if ( $self->{'compressionMethod'} == COMPRESSION_STORED ) {
713 1         5 $self->{'crc32'} = $self->computeCRC32( $buffer, $self->{'crc32'} );
714             }
715            
716 1         2 ( $outputRef, $status ) = &{ $self->{'chunkHandler'} } ( $self, \$buffer );
  1         3  
717 1         2 $self->{'writeOffset'} += length($$outputRef);
718            
719 1 50       3 $self->endRead() if $self->readIsDone() ;
720            
721 1         3 return ( $outputRef, $status );
722             }
723            
724             #################
725             # _READRAWCHUNK #
726             #################
727            
728             sub _readRawChunk {
729 1     1   2 my ( $self, $dataRef, $chunkSize ) = @_;
730 1 50       4 return ( 0, 0 ) unless $chunkSize;
731            
732 1         5 my $fh = $self->fh ;
733 1   50     10 my $bytesRead = read( $fh , $$dataRef, $chunkSize ) || return ( 0, _error("reading data") );
734            
735 1         3 return ( $bytesRead, 0 );
736             }
737            
738             ######
739             # FH #
740             ######
741            
742             sub fh {
743 2     2   3 my $self = shift;
744 2 100       10 $self->fh_open() if ! $self->{'fh'} ;
745 2         13 return $self->{'fh'};
746             }
747            
748             ###########
749             # FH_OPEN #
750             ###########
751            
752             sub fh_open {
753 1     1   2 my $self = shift ;
754 1         2 my $fh ;
755 1         33 open ($fh, $self->{'externalFileName'} ) ;
756 1         3 binmode($fh);
757 1         3 $self->{'fh'} = $fh ;
758 1         2 return( $fh ) ;
759             }
760            
761             ##############
762             # READISDONE #
763             ##############
764            
765             sub readIsDone {
766 2     2   2 my $self = shift;
767 2   66     19 return ( $self->{'dataEnded'} or !$self->{'readDataRemaining'} );
768             }
769            
770             #################
771             # _INFLATECHUNK #
772             #################
773            
774             sub _inflateChunk {
775 0     0   0 my ( $self, $buffer ) = @_;
776 0         0 my ( $out, $status ) = $self->{'inflater'}->inflate($buffer);
777            
778 0         0 my $retval;
779 0 0       0 $self->endRead() unless $status == Z_OK;
780 0 0 0     0 if ( $status == Z_OK || $status == Z_STREAM_END ) {
781 0 0       0 $retval = ( $status == Z_STREAM_END ) ? 1 : 0 ;
782 0         0 return ( \$out, $retval );
783             }
784             else {
785 0         0 $retval = _error( 'inflate error', $status );
786 0         0 my $dummy = '';
787 0         0 return ( \$dummy, $retval );
788             }
789             }
790            
791             sub _copyChunk {
792 1     1   2 my ( $self, $dataRef ) = @_;
793 1         3 return ( $dataRef, 0 );
794             }
795            
796             sub computeCRC32 {
797 1     1   2 my $data = shift;
798 1 50       4 $data = shift if ref($data); # allow calling as an obj method
799 1         1 my $crc = shift;
800 1 50       7 return LibZip::MyZlib::crc32( $data, $crc ) if defined &LibZip::MyZlib::crc32 ;
801             }
802            
803            
804             ###############
805             # ISENCRYPTED #
806             ###############
807            
808 2     2   67 sub isEncrypted { shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK ;}
809            
810             #######
811             # END #
812             #######
813            
814             1;
815            
816