File Coverage

blib/lib/IO/Compress/Zip.pm
Criterion Covered Total %
statement 362 424 85.3
branch 106 180 58.8
condition 29 63 46.0
subroutine 32 35 91.4
pod 2 19 10.5
total 531 721 73.6


line stmt bran cond sub pod time code
1             package IO::Compress::Zip ;
2              
3 19     19   59872 use strict ;
  19         86  
  19         511  
4 19     19   88 use warnings;
  19         32  
  19         390  
5 19     19   5099 use bytes;
  19         134  
  19         81  
6              
7 19     19   4788 use IO::Compress::Base::Common 2.206 qw(:Status );
  19         350  
  19         2148  
8 19     19   8746 use IO::Compress::RawDeflate 2.206 ();
  19         376  
  19         659  
9 19     19   112 use IO::Compress::Adapter::Deflate 2.206 ;
  19         334  
  19         3228  
10 19     19   7495 use IO::Compress::Adapter::Identity 2.206 ;
  19         351  
  19         537  
11 19     19   3637 use IO::Compress::Zlib::Extra 2.206 ;
  19         253  
  19         491  
12 19     19   3614 use IO::Compress::Zip::Constants 2.206 ;
  19         255  
  19         3276  
13              
14 19     19   133 use File::Spec();
  19         36  
  19         290  
15 19     19   73 use Config;
  19         33  
  19         967  
16              
17 19     19   111 use Compress::Raw::Zlib 2.206 ();
  19         288  
  19         2756  
18              
19             BEGIN
20             {
21 19     19   52 eval { require IO::Compress::Adapter::Bzip2 ;
  19         6912  
22 19         346 IO::Compress::Adapter::Bzip2->VERSION( 2.206 );
23 19         7500 require IO::Compress::Bzip2 ;
24 19         328 IO::Compress::Bzip2->VERSION( 2.206 );
25             } ;
26              
27 19         56 eval { require IO::Compress::Adapter::Lzma ;
  19         2738  
28 0         0 IO::Compress::Adapter::Lzma->VERSION( 2.206 );
29 0         0 require IO::Compress::Lzma ;
30 0         0 IO::Compress::Lzma->VERSION( 2.206 );
31             } ;
32              
33 19         441 eval { require IO::Compress::Adapter::Xz ;
  19         2351  
34 0         0 IO::Compress::Adapter::Xz->VERSION( 2.206 );
35 0         0 require IO::Compress::Xz ;
36 0         0 IO::Compress::Xz->VERSION( 2.206 );
37             } ;
38 19         358 eval { require IO::Compress::Adapter::Zstd ;
  19         7291  
39 19         34939 IO::Compress::Adapter::Zstd->VERSION( 2.206 );
40 19         8594 require IO::Compress::Zstd ;
41 19         83755 IO::Compress::Zstd->VERSION( 2.206 );
42             } ;
43             }
44              
45              
46             require Exporter ;
47              
48             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
49              
50             $VERSION = '2.206';
51             $ZipError = '';
52              
53             @ISA = qw(IO::Compress::RawDeflate Exporter);
54             @EXPORT_OK = qw( $ZipError zip ) ;
55             %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
56              
57             push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
58              
59             $EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_XZ ZIP_CM_ZSTD)];
60             push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };
61              
62             Exporter::export_ok_tags('all');
63              
64             sub new
65             {
66 151     151 1 129083 my $class = shift ;
67              
68 151         540 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError);
69 151         574 $obj->_create(undef, @_);
70              
71             }
72              
73             sub zip
74             {
75 197     197 1 9159291 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError);
76 197         586 return $obj->_def(@_);
77             }
78              
79             sub isMethodAvailable
80             {
81 3     3 0 265 my $method = shift;
82              
83             # Store & Deflate are always available
84 3 100 100     19 return 1
85             if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ;
86              
87             return 1
88             if $method == ZIP_CM_BZIP2 &&
89             defined $IO::Compress::Adapter::Bzip2::VERSION &&
90 1 0 33     4 defined &{ "IO::Compress::Adapter::Bzip2::mkRawZipCompObject" };
  0   33     0  
91              
92             return 1
93             if $method == ZIP_CM_LZMA &&
94             defined $IO::Compress::Adapter::Lzma::VERSION &&
95 1 0 33     4 defined &{ "IO::Compress::Adapter::Lzma::mkRawZipCompObject" };
  0   33     0  
96              
97             return 1
98             if $method == ZIP_CM_XZ &&
99             defined $IO::Compress::Adapter::Xz::VERSION &&
100 1 0 33     5 defined &{ "IO::Compress::Adapter::Xz::mkRawZipCompObject" };
  0   33     0  
101              
102             return 1
103             if $method == ZIP_CM_ZSTD &&
104             defined $IO::Compress::Adapter::ZSTD::VERSION &&
105 1 0 33     3 defined &{ "IO::Compress::Adapter::ZSTD::mkRawZipCompObject" };
  0   33     0  
106              
107 1         4 return 0;
108             }
109              
110             sub beforePayload
111             {
112 383     383 0 576 my $self = shift ;
113              
114 383 50       1756 if (*$self->{ZipData}{Sparse} ) {
115 0         0 my $inc = 1024 * 100 ;
116 0         0 my $NULLS = ("\x00" x $inc) ;
117 0         0 my $sparse = *$self->{ZipData}{Sparse} ;
118 0         0 *$self->{CompSize}->add( $sparse );
119 0         0 *$self->{UnCompSize}->add( $sparse );
120              
121 0         0 *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR);
122              
123             *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32})
124 0         0 for 1 .. int $sparse / $inc;
125             *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc),
126             *$self->{ZipData}{CRC32})
127 0 0       0 if $sparse % $inc;
128             }
129             }
130              
131             sub mkComp
132             {
133 385     385 0 497 my $self = shift ;
134 385         482 my $got = shift ;
135              
136 385         524 my ($obj, $errstr, $errno) ;
137              
138 385 100       1141 if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
    100          
    50          
    0          
    0          
    0          
139 34         72 ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
140             $got->getValue('level'),
141             $got->getValue('strategy')
142             );
143 34         145 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
144             }
145             elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
146 332         656 ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
147             $got->getValue('crc32'),
148             $got->getValue('adler32'),
149             $got->getValue('level'),
150             $got->getValue('strategy')
151             );
152             }
153             elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
154 19         45 ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
155             $got->getValue('blocksize100k'),
156             $got->getValue('workfactor'),
157             $got->getValue('verbosity')
158             );
159 19         84 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
160             }
161             elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) {
162 0         0 ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'),
163             $got->getValue('extreme'),
164             );
165 0         0 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
166             }
167             elsif (*$self->{ZipData}{Method} == ZIP_CM_XZ) {
168 0         0 ($obj, $errstr, $errno) = IO::Compress::Adapter::Xz::mkCompObject($got->getValue('preset'),
169             $got->getValue('extreme'),
170             0
171             );
172 0         0 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
173             }
174             elsif (*$self->{ZipData}{Method} == ZIP_CM_ZSTD) {
175 0 0       0 ($obj, $errstr, $errno) = IO::Compress::Adapter::Zstd::mkCompObject(defined $got->getValue('level') ? $got->getValue('level') : 3,
176             );
177 0         0 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
178             }
179              
180 385 50       965 return $self->saveErrorString(undef, $errstr, $errno)
181             if ! defined $obj;
182              
183 385 100       1088 if (! defined *$self->{ZipData}{SizesOffset}) {
184 314         560 *$self->{ZipData}{SizesOffset} = 0;
185 314         1369 *$self->{ZipData}{Offset} = U64->new();
186             }
187              
188             *$self->{ZipData}{AnyZip64} = 0
189 385 100       1113 if ! defined *$self->{ZipData}{AnyZip64} ;
190              
191 385         2278 return $obj;
192             }
193              
194             sub reset
195             {
196 0     0 0 0 my $self = shift ;
197              
198 0         0 *$self->{Compress}->reset();
199 0         0 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32('');
200              
201 0         0 return STATUS_OK;
202             }
203              
204             sub filterUncompressed
205             {
206 365     365 0 528 my $self = shift ;
207              
208 365 100       843 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
209 317         958 *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
210             }
211             else {
212 48         66 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32});
  48         254  
213              
214             }
215             }
216              
217             sub canonicalName
218             {
219             # This sub is derived from Archive::Zip::_asZipDirName
220              
221             # Return the normalized name as used in a zip file (path
222             # separators become slashes, etc.).
223             # Will translate internal slashes in path components (i.e. on Macs) to
224             # underscores. Discards volume names.
225             # When $forceDir is set, returns paths with trailing slashes
226             #
227             # input output
228             # . '.'
229             # ./a a
230             # ./a/b a/b
231             # ./a/b/ a/b
232             # a/b/ a/b
233             # /a/b/ a/b
234             # c:\a\b\c.doc a/b/c.doc # on Windows
235             # "i/o maps:whatever" i_o maps/whatever # on Macs
236              
237 2     2 0 4 my $name = shift;
238 2         3 my $forceDir = shift ;
239              
240 2         38 my ( $volume, $directories, $file ) =
241             File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
242              
243 2         14 my @dirs = map { $_ =~ s{/}{_}g; $_ }
  6         10  
  6         12  
244             File::Spec->splitdir($directories);
245              
246 2 50       6 if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component
  2 50       5  
247 2 50       7 push @dirs, defined($file) ? $file : '' ;
248              
249 2         5 my $normalised_path = join '/', @dirs;
250              
251             # Leading directory separators should not be stored in zip archives.
252             # Example:
253             # C:\a\b\c\ a/b/c
254             # C:\a\b\c.txt a/b/c.txt
255             # /a/b/c/ a/b/c
256             # /a/b/c.txt a/b/c.txt
257 2         5 $normalised_path =~ s{^/}{}; # remove leading separator
258              
259 2         6 return $normalised_path;
260             }
261              
262              
263             sub mkHeader
264             {
265 384     384 0 565 my $self = shift;
266 384         504 my $param = shift ;
267              
268 384         1026 *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset});
269              
270 384         626 my $comment = '';
271 384         876 $comment = $param->valueOrDefault('comment') ;
272              
273 384         586 my $filename = '';
274 384         716 $filename = $param->valueOrDefault('name') ;
275              
276 384 100 100     1108 $filename = canonicalName($filename)
277             if length $filename && $param->getValue('canonicalname') ;
278              
279 384 100       905 if (defined *$self->{ZipData}{FilterName} ) {
280 3         7 local *_ = \$filename ;
281 3         5 &{ *$self->{ZipData}{FilterName} }() ;
  3         8  
282             }
283              
284 384 100 66     772 if ( $param->getValue('efs') && $] >= 5.008004) {
285 5 50       12 if (length $filename) {
286 5 100       275 utf8::downgrade($filename, 1)
287             or Carp::croak "Wide character in zip filename";
288             }
289              
290 4 50       12 if (length $comment) {
291 0 0       0 utf8::downgrade($comment, 1)
292             or Carp::croak "Wide character in zip comment";
293             }
294             }
295              
296 383         583 my $hdr = '';
297              
298 383         687 my $time = _unixToDosTime($param->getValue('time'));
299              
300 383         591 my $extra = '';
301 383         478 my $ctlExtra = '';
302 383         469 my $empty = 0;
303 383         1065 my $osCode = $param->getValue('os_code') ;
304 383         556 my $extFileAttr = 0 ;
305              
306             # This code assumes Unix.
307             # TODO - revisit this
308 383 50       902 $extFileAttr = 0100644 << 16
309             if $osCode == ZIP_OS_CODE_UNIX ;
310              
311 383 100       959 if (*$self->{ZipData}{Zip64}) {
312 26         41 $empty = IO::Compress::Base::Common::MAX32;
313              
314 26         39 my $x = '';
315 26         37 $x .= pack "V V", 0, 0 ; # uncompressedLength
316 26         38 $x .= pack "V V", 0, 0 ; # compressedLength
317              
318             # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug
319             # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details
320 26         75 $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
321             }
322              
323 383 50       727 if (! $param->getValue('minimal')) {
324 383 100       802 if ($param->parsed('mtime'))
325             {
326 113         233 $extra .= mkExtendedTime($param->getValue('mtime'),
327             $param->getValue('atime'),
328             $param->getValue('ctime'));
329              
330 113         280 $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
331             }
332              
333 383 50       783 if ( $osCode == ZIP_OS_CODE_UNIX )
334             {
335 383 100       755 if ( $param->getValue('want_exunixn') )
336             {
337 113         148 my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') });
  113         187  
338 113         169 $extra .= $ux3;
339 113         181 $ctlExtra .= $ux3;
340             }
341              
342 383 50       714 if ( $param->getValue('exunix2') )
343             {
344 0         0 $extra .= mkUnix2Extra( @{ $param->getValue('exunix2') });
  0         0  
345 0         0 $ctlExtra .= mkUnix2Extra();
346             }
347             }
348              
349 383 50       746 $extFileAttr = $param->getValue('extattr')
350             if defined $param->getValue('extattr') ;
351              
352 383 50       733 $extra .= $param->getValue('extrafieldlocal')
353             if defined $param->getValue('extrafieldlocal');
354              
355 383 50       697 $ctlExtra .= $param->getValue('extrafieldcentral')
356             if defined $param->getValue('extrafieldcentral');
357             }
358              
359 383         762 my $method = *$self->{ZipData}{Method} ;
360 383         510 my $gpFlag = 0 ;
361             $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
362 383 100       846 if *$self->{ZipData}{Stream} ;
363              
364 383 50       683 $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT
365             if $method == ZIP_CM_LZMA ;
366              
367 383 50 33     719 $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING
      66        
368             if $param->getValue('efs') && (length($filename) || length($comment));
369              
370 383         656 my $version = $ZIP_CM_MIN_VERSIONS{$method};
371             $version = ZIP64_MIN_VERSION
372 383 100 100     1467 if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64};
373              
374 383         699 my $madeBy = ($param->getValue('os_code') << 8) + $version;
375 383         510 my $extract = $version;
376              
377 383         648 *$self->{ZipData}{Version} = $version;
378 383         622 *$self->{ZipData}{MadeBy} = $madeBy;
379              
380 383         475 my $ifa = 0;
381 383 100       674 $ifa |= ZIP_IFA_TEXT_MASK
382             if $param->getValue('textflag');
383              
384 383         710 $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
385 383         926 $hdr .= pack 'v', $extract ; # extract Version & OS
386 383         636 $hdr .= pack 'v', $gpFlag ; # general purpose flag (set streaming mode)
387 383         560 $hdr .= pack 'v', $method ; # compression method (deflate)
388 383         598 $hdr .= pack 'V', $time ; # last mod date/time
389 383         504 $hdr .= pack 'V', 0 ; # crc32 - 0 when streaming
390 383         628 $hdr .= pack 'V', $empty ; # compressed length - 0 when streaming
391 383         515 $hdr .= pack 'V', $empty ; # uncompressed length - 0 when streaming
392 383         573 $hdr .= pack 'v', length $filename ; # filename length
393 383         591 $hdr .= pack 'v', length $extra ; # extra length
394              
395 383         473 $hdr .= $filename ;
396              
397             # Remember the offset for the compressed & uncompressed lengths in the
398             # local header.
399 383 100       747 if (*$self->{ZipData}{Zip64}) {
400             *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
401 26         63 + length($hdr) + 4 ;
402             }
403             else {
404             *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
405 357         921 + 18;
406             }
407              
408 383         584 $hdr .= $extra ;
409              
410              
411 383         563 my $ctl = '';
412              
413 383         549 $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
414 383         641 $ctl .= pack 'v', $madeBy ; # version made by
415 383         546 $ctl .= pack 'v', $extract ; # extract Version
416 383         519 $ctl .= pack 'v', $gpFlag ; # general purpose flag (streaming mode)
417 383         517 $ctl .= pack 'v', $method ; # compression method (deflate)
418 383         527 $ctl .= pack 'V', $time ; # last mod date/time
419 383         479 $ctl .= pack 'V', 0 ; # crc32
420 383         525 $ctl .= pack 'V', $empty ; # compressed length
421 383         518 $ctl .= pack 'V', $empty ; # uncompressed length
422 383         529 $ctl .= pack 'v', length $filename ; # filename length
423              
424 383         617 *$self->{ZipData}{ExtraOffset} = length $ctl;
425 383         586 *$self->{ZipData}{ExtraSize} = length $ctlExtra ;
426              
427 383         587 $ctl .= pack 'v', length $ctlExtra ; # extra length
428 383         531 $ctl .= pack 'v', length $comment ; # file comment length
429 383         486 $ctl .= pack 'v', 0 ; # disk number start
430 383         542 $ctl .= pack 'v', $ifa ; # internal file attributes
431 383         554 $ctl .= pack 'V', $extFileAttr ; # external file attributes
432              
433             # offset to local hdr
434 383 50       925 if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) {
435 0         0 $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
436             }
437             else {
438 383         877 $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ;
439             }
440              
441 383         623 $ctl .= $filename ;
442              
443 383         1105 *$self->{ZipData}{Offset}->add32(length $hdr) ;
444              
445 383         1061 *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment];
446              
447 383         1261 return $hdr;
448             }
449              
450             sub mkTrailer
451             {
452 383     383 0 600 my $self = shift ;
453              
454 383         474 my $crc32 ;
455 383 100       881 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
456 330         878 $crc32 = pack "V", *$self->{Compress}->crc32();
457             }
458             else {
459 53         160 $crc32 = pack "V", *$self->{ZipData}{CRC32};
460             }
461              
462 383         548 my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} };
  383         998  
463              
464 383         518 my $sizes ;
465 383 100       744 if (! *$self->{ZipData}{Zip64}) {
466 357         797 $sizes .= *$self->{CompSize}->getPacked_V32() ; # Compressed size
467 357         804 $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size
468             }
469             else {
470 26         62 $sizes .= *$self->{CompSize}->getPacked_V64() ; # Compressed size
471 26         60 $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
472             }
473              
474 383         721 my $data = $crc32 . $sizes ;
475              
476 383         816 my $xtrasize = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
477 383         789 $xtrasize .= *$self->{CompSize}->getPacked_V64() ; # Compressed size
478              
479 383         540 my $hdr = '';
480              
481 383 100       720 if (*$self->{ZipData}{Stream}) {
482 332         1346 $hdr = pack "V", ZIP_DATA_HDR_SIG ; # signature
483 332         547 $hdr .= $data ;
484             }
485             else {
486 51 50       111 $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14, $crc32)
487             or return undef;
488             $self->writeAt(*$self->{ZipData}{SizesOffset},
489 51 100       216 *$self->{ZipData}{Zip64} ? $xtrasize : $sizes)
    50          
490             or return undef;
491             }
492              
493             # Central Header Record/Zip64 extended field
494              
495 383         901 substr($ctl, 16, length $crc32) = $crc32 ;
496              
497 383         516 my $zip64Payload = '';
498              
499             # uncompressed length - only set zip64 if needed
500 383 50       873 if (*$self->{UnCompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) {
501 0         0 $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ;
502             } else {
503 383         742 substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ;
504             }
505              
506             # compressed length - only set zip64 if needed
507 383 50       869 if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) {
508 0         0 $zip64Payload .= *$self->{CompSize}->getPacked_V64() ;
509             } else {
510 383         785 substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ;
511             }
512              
513             # Local Header offset
514             $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64()
515 383 50       945 if *$self->{ZipData}{LocalHdrOffset}->is64bit() ;
516              
517             # disk no - always zero, so don't need to include it.
518             #$zip64Payload .= pack "V", 0 ;
519              
520 383         589 my $zip64Xtra = '';
521              
522 383 50       681 if (length $zip64Payload) {
523 0         0 $zip64Xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $zip64Payload);
524              
525             substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) =
526 0         0 pack 'v', *$self->{ZipData}{ExtraSize} + length $zip64Xtra;
527              
528 0         0 *$self->{ZipData}{AnyZip64} = 1;
529             }
530              
531             # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug
532             # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details
533 383         810 $ctl .= $zip64Xtra . $ctlExtra . $comment;
534              
535 383         1113 *$self->{ZipData}{Offset}->add32(length($hdr));
536 383         1099 *$self->{ZipData}{Offset}->add( *$self->{CompSize} );
537 383         455 push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
  383         1123  
538              
539 383         980 return $hdr;
540             }
541              
542             sub mkFinalTrailer
543             {
544 317     317 0 385 my $self = shift ;
545              
546 317         408 my $comment = '';
547 317         509 $comment = *$self->{ZipData}{ZipComment} ;
548              
549 317         743 my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir
550              
551 317         393 my $entries = @{ *$self->{ZipData}{CentralDir} };
  317         505  
552              
553             *$self->{ZipData}{AnyZip64} = 1
554 317 50 33     647 if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ;
555              
556 317         469 my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
  317         714  
557 317         490 my $cd_len = length $cd ;
558              
559 317         424 my $z64e = '';
560              
561 317 100       642 if ( *$self->{ZipData}{AnyZip64} ) {
562              
563 21         38 my $v = *$self->{ZipData}{Version} ;
564 21         35 my $mb = *$self->{ZipData}{MadeBy} ;
565 21         46 $z64e .= pack 'v', $mb ; # Version made by
566 21         30 $z64e .= pack 'v', $v ; # Version to extract
567 21         55 $z64e .= pack 'V', 0 ; # number of disk
568 21         30 $z64e .= pack 'V', 0 ; # number of disk with central dir
569 21         44 $z64e .= U64::pack_V64 $entries ; # entries in central dir on this disk
570 21         39 $z64e .= U64::pack_V64 $entries ; # entries in central dir
571 21         37 $z64e .= U64::pack_V64 $cd_len ; # size of central dir
572 21         52 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to start central dir
573             $z64e .= *$self->{ZipData}{extrafieldzip64} # otional extra field
574 21 50       47 if defined *$self->{ZipData}{extrafieldzip64} ;
575              
576 21         47 $z64e = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) # signature
577             . U64::pack_V64(length $z64e)
578             . $z64e ;
579              
580 21         55 *$self->{ZipData}{Offset}->add32(length $cd) ;
581              
582 21         26 $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature
583 21         28 $z64e .= pack 'V', 0 ; # number of disk with central dir
584 21         49 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir
585 21         27 $z64e .= pack 'V', 1 ; # Total number of disks
586              
587 21         26 $cd_offset = IO::Compress::Base::Common::MAX32 ;
588 21 50       40 $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ;
589 21 50       37 $entries = 0xFFFF if $entries >= 0xFFFF ;
590             }
591              
592 317         437 my $ecd = '';
593 317         413 $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
594 317         422 $ecd .= pack 'v', 0 ; # number of disk
595 317         412 $ecd .= pack 'v', 0 ; # number of disk with central dir
596 317         579 $ecd .= pack 'v', $entries ; # entries in central dir on this disk
597 317         411 $ecd .= pack 'v', $entries ; # entries in central dir
598 317         428 $ecd .= pack 'V', $cd_len ; # size of central dir
599 317         453 $ecd .= pack 'V', $cd_offset ; # offset to start central dir
600 317         439 $ecd .= pack 'v', length $comment ; # zipfile comment length
601 317         415 $ecd .= $comment;
602              
603 317         962 return $cd . $z64e . $ecd ;
604             }
605              
606             sub ckParams
607             {
608 386     386 0 516 my $self = shift ;
609 386         470 my $got = shift;
610              
611 386         969 $got->setValue('crc32' => 1);
612              
613 386 100       780 if (! $got->parsed('time') ) {
614             # Modification time defaults to now.
615 297         679 $got->setValue('time' => time) ;
616             }
617              
618 386 50       777 if ($got->parsed('extime') ) {
619 0         0 my $timeRef = $got->getValue('extime');
620 0 0       0 if ( defined $timeRef) {
621 0 0 0     0 return $self->saveErrorString(undef, "exTime not a 3-element array ref")
622             if ref $timeRef ne 'ARRAY' || @$timeRef != 3;
623             }
624              
625 0         0 $got->setValue("mtime", $timeRef->[1]);
626 0         0 $got->setValue("atime", $timeRef->[0]);
627 0         0 $got->setValue("ctime", $timeRef->[2]);
628             }
629              
630             # Unix2/3 Extended Attribute
631 386         756 for my $name (qw(exunix2 exunixn))
632             {
633 772 50       1234 if ($got->parsed($name) ) {
634 0         0 my $idRef = $got->getValue($name);
635 0 0       0 if ( defined $idRef) {
636 0 0 0     0 return $self->saveErrorString(undef, "$name not a 2-element array ref")
637             if ref $idRef ne 'ARRAY' || @$idRef != 2;
638             }
639              
640 0         0 $got->setValue("uid", $idRef->[0]);
641 0         0 $got->setValue("gid", $idRef->[1]);
642 0         0 $got->setValue("want_$name", $idRef);
643             }
644             }
645              
646 386 100 66     725 *$self->{ZipData}{AnyZip64} = 1
647             if $got->getValue('zip64') || $got->getValue('extrafieldzip64') ;
648 386         793 *$self->{ZipData}{Zip64} = $got->getValue('zip64');
649 386         822 *$self->{ZipData}{Stream} = $got->getValue('stream');
650              
651 386         739 my $method = $got->getValue('method');
652             return $self->saveErrorString(undef, "Unknown Method '$method'")
653 386 50       1029 if ! defined $ZIP_CM_MIN_VERSIONS{$method};
654              
655 386 50 66     931 return $self->saveErrorString(undef, "Bzip2 not available")
656             if $method == ZIP_CM_BZIP2 and
657             ! defined $IO::Compress::Adapter::Bzip2::VERSION;
658              
659 386 50 33     814 return $self->saveErrorString(undef, "Lzma not available")
660             if $method == ZIP_CM_LZMA
661             and ! defined $IO::Compress::Adapter::Lzma::VERSION;
662              
663 386         753 *$self->{ZipData}{Method} = $method;
664              
665 386         728 *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ;
666              
667 386         698 for my $name (qw( extrafieldlocal extrafieldcentral extrafieldzip64))
668             {
669 1158         1782 my $data = $got->getValue($name) ;
670 1158 50       2115 if (defined $data) {
671 0         0 my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ;
672 0 0       0 return $self->saveErrorString(undef, "Error with $name Parameter: $bad")
673             if $bad ;
674              
675 0         0 $got->setValue($name, $data) ;
676 0         0 *$self->{ZipData}{$name} = $data;
677             }
678             }
679              
680             return undef
681 386 50 33     1487 if defined $IO::Compress::Bzip2::VERSION
682             and ! IO::Compress::Bzip2::ckParams($self, $got);
683              
684 386 50       742 if ($got->parsed('sparse') ) {
685 0         0 *$self->{ZipData}{Sparse} = $got->getValue('sparse') ;
686 0         0 *$self->{ZipData}{Method} = ZIP_CM_STORE;
687             }
688              
689 386 100       697 if ($got->parsed('filtername')) {
690 3         6 my $v = $got->getValue('filtername') ;
691 3 50       11 *$self->{ZipData}{FilterName} = $v
692             if ref $v eq 'CODE' ;
693             }
694              
695 386         973 return 1 ;
696             }
697              
698             sub outputPayload
699             {
700 371     371 0 515 my $self = shift ;
701 371 50       803 return 1 if *$self->{ZipData}{Sparse} ;
702 371         831 return $self->output(@_);
703             }
704              
705              
706             #sub newHeader
707             #{
708             # my $self = shift ;
709             #
710             # return $self->mkHeader(*$self->{Got});
711             #}
712              
713              
714             our %PARAMS = (
715             'stream' => [IO::Compress::Base::Common::Parse_boolean, 1],
716             #'store' => [IO::Compress::Base::Common::Parse_boolean, 0],
717             'method' => [IO::Compress::Base::Common::Parse_unsigned, ZIP_CM_DEFLATE],
718              
719             # # Zip header fields
720             'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0],
721             'zip64' => [IO::Compress::Base::Common::Parse_boolean, 0],
722             'comment' => [IO::Compress::Base::Common::Parse_any, ''],
723             'zipcomment'=> [IO::Compress::Base::Common::Parse_any, ''],
724             'name' => [IO::Compress::Base::Common::Parse_any, ''],
725             'filtername'=> [IO::Compress::Base::Common::Parse_code, undef],
726             'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean, 0],
727             'efs' => [IO::Compress::Base::Common::Parse_boolean, 0],
728             'time' => [IO::Compress::Base::Common::Parse_any, undef],
729             'extime' => [IO::Compress::Base::Common::Parse_any, undef],
730             'exunix2' => [IO::Compress::Base::Common::Parse_any, undef],
731             'exunixn' => [IO::Compress::Base::Common::Parse_any, undef],
732             'extattr' => [IO::Compress::Base::Common::Parse_any,
733             $Compress::Raw::Zlib::gzip_os_code == 3
734             ? 0100644 << 16
735             : 0],
736             'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
737              
738             'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0],
739             'extrafieldlocal' => [IO::Compress::Base::Common::Parse_any, undef],
740             'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any, undef],
741             'extrafieldzip64' => [IO::Compress::Base::Common::Parse_any, undef],
742              
743             # Lzma
744             'preset' => [IO::Compress::Base::Common::Parse_unsigned, 6],
745             'extreme' => [IO::Compress::Base::Common::Parse_boolean, 0],
746              
747             # For internal use only
748             'sparse' => [IO::Compress::Base::Common::Parse_unsigned, 0],
749              
750             IO::Compress::RawDeflate::getZlibParams(),
751             defined $IO::Compress::Bzip2::VERSION
752             ? IO::Compress::Bzip2::getExtraParams()
753             : ()
754              
755              
756             );
757              
758             sub getExtraParams
759             {
760 386     386 0 5321 return %PARAMS ;
761             }
762              
763             sub getInverseClass
764             {
765 19     19   179 no warnings 'once';
  19         38  
  19         4794  
766 0     0 0 0 return ('IO::Uncompress::Unzip',
767             \$IO::Uncompress::Unzip::UnzipError);
768             }
769              
770             sub getFileInfo
771             {
772 163     163 0 269 my $self = shift ;
773 163         184 my $params = shift;
774 163         199 my $filename = shift ;
775              
776 163 100       278 if (IO::Compress::Base::Common::isaScalar($filename))
777             {
778             $params->setValue(zip64 => 1)
779 50 50       78 if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ;
  50         116  
780              
781 50         104 return ;
782             }
783              
784 113         240 my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;
785 113 50       245 if ( $params->parsed('storelinks') )
786             {
787 0         0 ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
788             = (lstat($filename))[2, 4,5,7, 8,9,10] ;
789             }
790             else
791             {
792 113         1554 ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
793             = (stat($filename))[2, 4,5,7, 8,9,10] ;
794             }
795              
796 113 100       483 $params->setValue(textflag => -T $filename )
797             if ! $params->parsed('textflag');
798              
799 113 50       296 $params->setValue(zip64 => 1)
800             if IO::Compress::Base::Common::isGeMax32 $size ;
801              
802 113 100       245 $params->setValue('name' => $filename)
803             if ! $params->parsed('name') ;
804              
805 113 100       215 $params->setValue('time' => $mtime)
806             if ! $params->parsed('time') ;
807              
808 113 50       217 if ( ! $params->parsed('extime'))
809             {
810 113         239 $params->setValue('mtime' => $mtime) ;
811 113         222 $params->setValue('atime' => $atime) ;
812 113         247 $params->setValue('ctime' => undef) ; # No Creation time
813             # TODO - see if can fillout creation time on non-Unix
814             }
815              
816             # NOTE - Unix specific code alert
817 113 100       222 if (! $params->parsed('extattr'))
818             {
819 19     19   136 use Fcntl qw(:mode) ;
  19         47  
  19         12462  
820 108         167 my $attr = $mode << 16;
821 108 50       220 $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ;
822 108 50       324 $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ;
823              
824 108         215 $params->setValue('extattr' => $attr);
825             }
826              
827 113         313 $params->setValue('want_exunixn', [$uid, $gid]);
828 113         234 $params->setValue('uid' => $uid) ;
829 113         199 $params->setValue('gid' => $gid) ;
830              
831             }
832              
833             sub mkExtendedTime
834             {
835             # order expected is m, a, c
836              
837 226     226 0 270 my $times = '';
838 226         252 my $bit = 1 ;
839 226         232 my $flags = 0;
840              
841 226         345 for my $time (@_)
842             {
843 452 100       629 if (defined $time)
844             {
845 339         405 $flags |= $bit;
846 339         581 $times .= pack("V", $time);
847             }
848              
849 452         563 $bit <<= 1 ;
850             }
851              
852 226         699 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP,
853             pack("C", $flags) . $times);
854             }
855              
856             sub mkUnix2Extra
857             {
858 0     0 0 0 my $ids = '';
859 0         0 for my $id (@_)
860             {
861 0         0 $ids .= pack("v", $id);
862             }
863              
864 0         0 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2,
865             $ids);
866             }
867              
868             sub mkUnixNExtra
869             {
870 113     113 0 148 my $uid = shift;
871 113         135 my $gid = shift;
872              
873             # Assumes UID/GID are 32-bit
874 113         129 my $ids ;
875 113         156 $ids .= pack "C", 1; # version
876 113         1068 $ids .= pack "C", $Config{uidsize};
877 113         307 $ids .= pack "V", $uid;
878 113         534 $ids .= pack "C", $Config{gidsize};
879 113         227 $ids .= pack "V", $gid;
880              
881 113         217 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN,
882             $ids);
883             }
884              
885              
886             # from Archive::Zip
887             sub _unixToDosTime # Archive::Zip::Member
888             {
889 383     383   525 my $time_t = shift;
890              
891             # TODO - add something to cope with unix time < 1980
892 383         8567 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
893 383         1108 my $dt = 0;
894 383         606 $dt += ( $sec >> 1 );
895 383         526 $dt += ( $min << 5 );
896 383         462 $dt += ( $hour << 11 );
897 383         522 $dt += ( $mday << 16 );
898 383         513 $dt += ( ( $mon + 1 ) << 21 );
899 383         651 $dt += ( ( $year - 80 ) << 25 );
900 383         724 return $dt;
901             }
902              
903             1;
904              
905             __END__