File Coverage

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


line stmt bran cond sub pod time code
1             package IO::Compress::Zip ;
2              
3 19     19   74279 use strict ;
  19         101  
  19         600  
4 19     19   99 use warnings;
  19         46  
  19         469  
5 19     19   5792 use bytes;
  19         161  
  19         92  
6              
7 19     19   5412 use IO::Compress::Base::Common 2.205 qw(:Status );
  19         433  
  19         2473  
8 19     19   9565 use IO::Compress::RawDeflate 2.205 ();
  19         417  
  19         806  
9 19     19   128 use IO::Compress::Adapter::Deflate 2.205 ;
  19         358  
  19         3503  
10 19     19   8526 use IO::Compress::Adapter::Identity 2.205 ;
  19         399  
  19         594  
11 19     19   4201 use IO::Compress::Zlib::Extra 2.205 ;
  19         295  
  19         513  
12 19     19   4242 use IO::Compress::Zip::Constants 2.205 ;
  19         292  
  19         3842  
13              
14 19     19   140 use File::Spec();
  19         45  
  19         372  
15 19     19   90 use Config;
  19         38  
  19         1083  
16              
17 19     19   124 use Compress::Raw::Zlib 2.205 ();
  19         338  
  19         3184  
18              
19             BEGIN
20             {
21 19     19   63 eval { require IO::Compress::Adapter::Bzip2 ;
  19         7728  
22 19         212 IO::Compress::Adapter::Bzip2->import( 2.205 );
23 19         8584 require IO::Compress::Bzip2 ;
24 19         1863 IO::Compress::Bzip2->import( 2.205 );
25             } ;
26              
27 19         57 eval { require IO::Compress::Adapter::Lzma ;
  19         3345  
28 0         0 IO::Compress::Adapter::Lzma->import( 2.205 );
29 0         0 require IO::Compress::Lzma ;
30 0         0 IO::Compress::Lzma->import( 2.205 );
31             } ;
32              
33 19         502 eval { require IO::Compress::Adapter::Xz ;
  19         2628  
34 0         0 IO::Compress::Adapter::Xz->import( 2.205 );
35 0         0 require IO::Compress::Xz ;
36 0         0 IO::Compress::Xz->import( 2.205 );
37             } ;
38 19         401 eval { require IO::Compress::Adapter::Zstd ;
  19         48691  
39 0         0 IO::Compress::Adapter::Zstd->import( 2.205 );
40 0         0 require IO::Compress::Zstd ;
41 0         0 IO::Compress::Zstd->import( 2.205 );
42             } ;
43             }
44              
45              
46             require Exporter ;
47              
48             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
49              
50             $VERSION = '2.205';
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 155194 my $class = shift ;
67              
68 151         619 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError);
69 151         683 $obj->_create(undef, @_);
70              
71             }
72              
73             sub zip
74             {
75 197     197 1 9177665 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError);
76 197         685 return $obj->_def(@_);
77             }
78              
79             sub isMethodAvailable
80             {
81 3     3 0 329 my $method = shift;
82              
83             # Store & Deflate are always available
84 3 100 100     23 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     8 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     6 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     5 defined &{ "IO::Compress::Adapter::ZSTD::mkRawZipCompObject" };
  0   33     0  
106              
107 1         5 return 0;
108             }
109              
110             sub beforePayload
111             {
112 383     383 0 639 my $self = shift ;
113              
114 383 50       1208 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 596 my $self = shift ;
134 385         547 my $got = shift ;
135              
136 385         630 my ($obj, $errstr, $errno) ;
137              
138 385 100       1288 if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
    100          
    50          
    0          
    0          
    0          
139 34         81 ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
140             $got->getValue('level'),
141             $got->getValue('strategy')
142             );
143 34         156 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
144             }
145             elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
146 332         766 ($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         58 ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
155             $got->getValue('blocksize100k'),
156             $got->getValue('workfactor'),
157             $got->getValue('verbosity')
158             );
159 19         108 *$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       1160 return $self->saveErrorString(undef, $errstr, $errno)
181             if ! defined $obj;
182              
183 385 100       1230 if (! defined *$self->{ZipData}{SizesOffset}) {
184 314         685 *$self->{ZipData}{SizesOffset} = 0;
185 314         1614 *$self->{ZipData}{Offset} = U64->new();
186             }
187              
188             *$self->{ZipData}{AnyZip64} = 0
189 385 100       1351 if ! defined *$self->{ZipData}{AnyZip64} ;
190              
191 385         2652 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 632 my $self = shift ;
207              
208 365 100       930 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
209 317         1126 *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
210             }
211             else {
212 48         75 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32});
  48         304  
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 5 my $name = shift;
238 2         3 my $forceDir = shift ;
239              
240 2         44 my ( $volume, $directories, $file ) =
241             File::Spec->splitpath( File::Spec->canonpath($name), $forceDir );
242              
243 2         17 my @dirs = map { $_ =~ s{/}{_}g; $_ }
  6         11  
  6         14  
244             File::Spec->splitdir($directories);
245              
246 2 50       9 if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component
  2 50       6  
247 2 50       9 push @dirs, defined($file) ? $file : '' ;
248              
249 2         6 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         6 $normalised_path =~ s{^/}{}; # remove leading separator
258              
259 2         7 return $normalised_path;
260             }
261              
262              
263             sub mkHeader
264             {
265 384     384 0 736 my $self = shift;
266 384         587 my $param = shift ;
267              
268 384         1174 *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset});
269              
270 384         754 my $comment = '';
271 384         1032 $comment = $param->valueOrDefault('comment') ;
272              
273 384         770 my $filename = '';
274 384         859 $filename = $param->valueOrDefault('name') ;
275              
276 384 100 100     1372 $filename = canonicalName($filename)
277             if length $filename && $param->getValue('canonicalname') ;
278              
279 384 100       1060 if (defined *$self->{ZipData}{FilterName} ) {
280 3         17 local *_ = \$filename ;
281 3         6 &{ *$self->{ZipData}{FilterName} }() ;
  3         13  
282             }
283              
284 384 100 66     986 if ( $param->getValue('efs') && $] >= 5.008004) {
285 5 50       39 if (length $filename) {
286 5 100       274 utf8::downgrade($filename, 1)
287             or Carp::croak "Wide character in zip filename";
288             }
289              
290 4 50       9 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         699 my $hdr = '';
297              
298 383         828 my $time = _unixToDosTime($param->getValue('time'));
299              
300 383         713 my $extra = '';
301 383         599 my $ctlExtra = '';
302 383         527 my $empty = 0;
303 383         1203 my $osCode = $param->getValue('os_code') ;
304 383         622 my $extFileAttr = 0 ;
305              
306             # This code assumes Unix.
307             # TODO - revisit this
308 383 50       1029 $extFileAttr = 0100644 << 16
309             if $osCode == ZIP_OS_CODE_UNIX ;
310              
311 383 100       1310 if (*$self->{ZipData}{Zip64}) {
312 26         51 $empty = IO::Compress::Base::Common::MAX32;
313              
314 26         60 my $x = '';
315 26         48 $x .= pack "V V", 0, 0 ; # uncompressedLength
316 26         43 $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         83 $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
321             }
322              
323 383 50       891 if (! $param->getValue('minimal')) {
324 383 100       906 if ($param->parsed('mtime'))
325             {
326 113         256 $extra .= mkExtendedTime($param->getValue('mtime'),
327             $param->getValue('atime'),
328             $param->getValue('ctime'));
329              
330 113         315 $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
331             }
332              
333 383 50       930 if ( $osCode == ZIP_OS_CODE_UNIX )
334             {
335 383 100       860 if ( $param->getValue('want_exunixn') )
336             {
337 113         159 my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') });
  113         227  
338 113         210 $extra .= $ux3;
339 113         217 $ctlExtra .= $ux3;
340             }
341              
342 383 50       941 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       893 $extFileAttr = $param->getValue('extattr')
350             if defined $param->getValue('extattr') ;
351              
352 383 50       802 $extra .= $param->getValue('extrafieldlocal')
353             if defined $param->getValue('extrafieldlocal');
354              
355 383 50       885 $ctlExtra .= $param->getValue('extrafieldcentral')
356             if defined $param->getValue('extrafieldcentral');
357             }
358              
359 383         858 my $method = *$self->{ZipData}{Method} ;
360 383         601 my $gpFlag = 0 ;
361             $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
362 383 100       955 if *$self->{ZipData}{Stream} ;
363              
364 383 50       921 $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT
365             if $method == ZIP_CM_LZMA ;
366              
367 383 50 33     834 $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING
      66        
368             if $param->getValue('efs') && (length($filename) || length($comment));
369              
370 383         788 my $version = $ZIP_CM_MIN_VERSIONS{$method};
371             $version = ZIP64_MIN_VERSION
372 383 100 100     1823 if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64};
373              
374 383         888 my $madeBy = ($param->getValue('os_code') << 8) + $version;
375 383         641 my $extract = $version;
376              
377 383         767 *$self->{ZipData}{Version} = $version;
378 383         734 *$self->{ZipData}{MadeBy} = $madeBy;
379              
380 383         527 my $ifa = 0;
381 383 100       784 $ifa |= ZIP_IFA_TEXT_MASK
382             if $param->getValue('textflag');
383              
384 383         868 $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
385 383         1165 $hdr .= pack 'v', $extract ; # extract Version & OS
386 383         789 $hdr .= pack 'v', $gpFlag ; # general purpose flag (set streaming mode)
387 383         706 $hdr .= pack 'v', $method ; # compression method (deflate)
388 383         804 $hdr .= pack 'V', $time ; # last mod date/time
389 383         565 $hdr .= pack 'V', 0 ; # crc32 - 0 when streaming
390 383         755 $hdr .= pack 'V', $empty ; # compressed length - 0 when streaming
391 383         615 $hdr .= pack 'V', $empty ; # uncompressed length - 0 when streaming
392 383         752 $hdr .= pack 'v', length $filename ; # filename length
393 383         721 $hdr .= pack 'v', length $extra ; # extra length
394              
395 383         586 $hdr .= $filename ;
396              
397             # Remember the offset for the compressed & uncompressed lengths in the
398             # local header.
399 383 100       923 if (*$self->{ZipData}{Zip64}) {
400             *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
401 26         87 + length($hdr) + 4 ;
402             }
403             else {
404             *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit()
405 357         1152 + 18;
406             }
407              
408 383         681 $hdr .= $extra ;
409              
410              
411 383         608 my $ctl = '';
412              
413 383         622 $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
414 383         692 $ctl .= pack 'v', $madeBy ; # version made by
415 383         713 $ctl .= pack 'v', $extract ; # extract Version
416 383         645 $ctl .= pack 'v', $gpFlag ; # general purpose flag (streaming mode)
417 383         633 $ctl .= pack 'v', $method ; # compression method (deflate)
418 383         607 $ctl .= pack 'V', $time ; # last mod date/time
419 383         512 $ctl .= pack 'V', 0 ; # crc32
420 383         673 $ctl .= pack 'V', $empty ; # compressed length
421 383         659 $ctl .= pack 'V', $empty ; # uncompressed length
422 383         642 $ctl .= pack 'v', length $filename ; # filename length
423              
424 383         736 *$self->{ZipData}{ExtraOffset} = length $ctl;
425 383         697 *$self->{ZipData}{ExtraSize} = length $ctlExtra ;
426              
427 383         679 $ctl .= pack 'v', length $ctlExtra ; # extra length
428 383         680 $ctl .= pack 'v', length $comment ; # file comment length
429 383         587 $ctl .= pack 'v', 0 ; # disk number start
430 383         645 $ctl .= pack 'v', $ifa ; # internal file attributes
431 383         652 $ctl .= pack 'V', $extFileAttr ; # external file attributes
432              
433             # offset to local hdr
434 383 50       1113 if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) {
435 0         0 $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
436             }
437             else {
438 383         1037 $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ;
439             }
440              
441 383         809 $ctl .= $filename ;
442              
443 383         1384 *$self->{ZipData}{Offset}->add32(length $hdr) ;
444              
445 383         1230 *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment];
446              
447 383         1475 return $hdr;
448             }
449              
450             sub mkTrailer
451             {
452 383     383 0 660 my $self = shift ;
453              
454 383         544 my $crc32 ;
455 383 100       998 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
456 330         998 $crc32 = pack "V", *$self->{Compress}->crc32();
457             }
458             else {
459 53         182 $crc32 = pack "V", *$self->{ZipData}{CRC32};
460             }
461              
462 383         682 my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} };
  383         1165  
463              
464 383         594 my $sizes ;
465 383 100       1786 if (! *$self->{ZipData}{Zip64}) {
466 357         931 $sizes .= *$self->{CompSize}->getPacked_V32() ; # Compressed size
467 357         998 $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size
468             }
469             else {
470 26         70 $sizes .= *$self->{CompSize}->getPacked_V64() ; # Compressed size
471 26         68 $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
472             }
473              
474 383         906 my $data = $crc32 . $sizes ;
475              
476 383         1040 my $xtrasize = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size
477 383         913 $xtrasize .= *$self->{CompSize}->getPacked_V64() ; # Compressed size
478              
479 383         644 my $hdr = '';
480              
481 383 100       945 if (*$self->{ZipData}{Stream}) {
482 332         581 $hdr = pack "V", ZIP_DATA_HDR_SIG ; # signature
483 332         674 $hdr .= $data ;
484             }
485             else {
486 51 50       148 $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14, $crc32)
487             or return undef;
488             $self->writeAt(*$self->{ZipData}{SizesOffset},
489 51 100       304 *$self->{ZipData}{Zip64} ? $xtrasize : $sizes)
    50          
490             or return undef;
491             }
492              
493             # Central Header Record/Zip64 extended field
494              
495 383         1113 substr($ctl, 16, length $crc32) = $crc32 ;
496              
497 383         664 my $zip64Payload = '';
498              
499             # uncompressed length - only set zip64 if needed
500 383 50       1074 if (*$self->{UnCompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) {
501 0         0 $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ;
502             } else {
503 383         980 substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ;
504             }
505              
506             # compressed length - only set zip64 if needed
507 383 50       1099 if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) {
508 0         0 $zip64Payload .= *$self->{CompSize}->getPacked_V64() ;
509             } else {
510 383         903 substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ;
511             }
512              
513             # Local Header offset
514             $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64()
515 383 50       1100 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         743 my $zip64Xtra = '';
521              
522 383 50       1699 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         955 $ctl .= $zip64Xtra . $ctlExtra . $comment;
534              
535 383         1266 *$self->{ZipData}{Offset}->add32(length($hdr));
536 383         1235 *$self->{ZipData}{Offset}->add( *$self->{CompSize} );
537 383         594 push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
  383         1420  
538              
539 383         1175 return $hdr;
540             }
541              
542             sub mkFinalTrailer
543             {
544 317     317 0 530 my $self = shift ;
545              
546 317         507 my $comment = '';
547 317         695 $comment = *$self->{ZipData}{ZipComment} ;
548              
549 317         926 my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir
550              
551 317         473 my $entries = @{ *$self->{ZipData}{CentralDir} };
  317         645  
552              
553             *$self->{ZipData}{AnyZip64} = 1
554 317 50 33     771 if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ;
555              
556 317         578 my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
  317         916  
557 317         510 my $cd_len = length $cd ;
558              
559 317         500 my $z64e = '';
560              
561 317 100       796 if ( *$self->{ZipData}{AnyZip64} ) {
562              
563 21         86 my $v = *$self->{ZipData}{Version} ;
564 21         43 my $mb = *$self->{ZipData}{MadeBy} ;
565 21         66 $z64e .= pack 'v', $mb ; # Version made by
566 21         59 $z64e .= pack 'v', $v ; # Version to extract
567 21         37 $z64e .= pack 'V', 0 ; # number of disk
568 21         31 $z64e .= pack 'V', 0 ; # number of disk with central dir
569 21         52 $z64e .= U64::pack_V64 $entries ; # entries in central dir on this disk
570 21         52 $z64e .= U64::pack_V64 $entries ; # entries in central dir
571 21         44 $z64e .= U64::pack_V64 $cd_len ; # size of central dir
572 21         61 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to start central dir
573             $z64e .= *$self->{ZipData}{extrafieldzip64} # otional extra field
574 21 50       64 if defined *$self->{ZipData}{extrafieldzip64} ;
575              
576 21         96 $z64e = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) # signature
577             . U64::pack_V64(length $z64e)
578             . $z64e ;
579              
580 21         73 *$self->{ZipData}{Offset}->add32(length $cd) ;
581              
582 21         37 $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature
583 21         37 $z64e .= pack 'V', 0 ; # number of disk with central dir
584 21         59 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir
585 21         31 $z64e .= pack 'V', 1 ; # Total number of disks
586              
587 21         32 $cd_offset = IO::Compress::Base::Common::MAX32 ;
588 21 50       42 $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ;
589 21 50       60 $entries = 0xFFFF if $entries >= 0xFFFF ;
590             }
591              
592 317         512 my $ecd = '';
593 317         532 $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
594 317         435 $ecd .= pack 'v', 0 ; # number of disk
595 317         446 $ecd .= pack 'v', 0 ; # number of disk with central dir
596 317         683 $ecd .= pack 'v', $entries ; # entries in central dir on this disk
597 317         587 $ecd .= pack 'v', $entries ; # entries in central dir
598 317         513 $ecd .= pack 'V', $cd_len ; # size of central dir
599 317         528 $ecd .= pack 'V', $cd_offset ; # offset to start central dir
600 317         542 $ecd .= pack 'v', length $comment ; # zipfile comment length
601 317         505 $ecd .= $comment;
602              
603 317         1157 return $cd . $z64e . $ecd ;
604             }
605              
606             sub ckParams
607             {
608 386     386 0 644 my $self = shift ;
609 386         539 my $got = shift;
610              
611 386         1113 $got->setValue('crc32' => 1);
612              
613 386 100       874 if (! $got->parsed('time') ) {
614             # Modification time defaults to now.
615 297         841 $got->setValue('time' => time) ;
616             }
617              
618 386 50       897 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         913 for my $name (qw(exunix2 exunixn))
632             {
633 772 50       1530 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     953 *$self->{ZipData}{AnyZip64} = 1
647             if $got->getValue('zip64') || $got->getValue('extrafieldzip64') ;
648 386         940 *$self->{ZipData}{Zip64} = $got->getValue('zip64');
649 386         922 *$self->{ZipData}{Stream} = $got->getValue('stream');
650              
651 386         844 my $method = $got->getValue('method');
652             return $self->saveErrorString(undef, "Unknown Method '$method'")
653 386 50       1261 if ! defined $ZIP_CM_MIN_VERSIONS{$method};
654              
655 386 50 66     1084 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     936 return $self->saveErrorString(undef, "Lzma not available")
660             if $method == ZIP_CM_LZMA
661             and ! defined $IO::Compress::Adapter::Lzma::VERSION;
662              
663 386         821 *$self->{ZipData}{Method} = $method;
664              
665 386         802 *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ;
666              
667 386         800 for my $name (qw( extrafieldlocal extrafieldcentral extrafieldzip64))
668             {
669 1158         2157 my $data = $got->getValue($name) ;
670 1158 50       2508 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     1765 if defined $IO::Compress::Bzip2::VERSION
682             and ! IO::Compress::Bzip2::ckParams($self, $got);
683              
684 386 50       866 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       880 if ($got->parsed('filtername')) {
690 3         7 my $v = $got->getValue('filtername') ;
691 3 50       12 *$self->{ZipData}{FilterName} = $v
692             if ref $v eq 'CODE' ;
693             }
694              
695 386         1071 return 1 ;
696             }
697              
698             sub outputPayload
699             {
700 371     371 0 637 my $self = shift ;
701 371 50       910 return 1 if *$self->{ZipData}{Sparse} ;
702 371         1777 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 6274 return %PARAMS ;
761             }
762              
763             sub getInverseClass
764             {
765 19     19   35211 no warnings 'once';
  19         43  
  19         5433  
766 0     0 0 0 return ('IO::Uncompress::Unzip',
767             \$IO::Uncompress::Unzip::UnzipError);
768             }
769              
770             sub getFileInfo
771             {
772 163     163 0 286 my $self = shift ;
773 163         242 my $params = shift;
774 163         277 my $filename = shift ;
775              
776 163 100       342 if (IO::Compress::Base::Common::isaScalar($filename))
777             {
778             $params->setValue(zip64 => 1)
779 50 50       101 if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ;
  50         157  
780              
781 50         130 return ;
782             }
783              
784 113         301 my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;
785 113 50       304 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         1939 ($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
793             = (stat($filename))[2, 4,5,7, 8,9,10] ;
794             }
795              
796 113 100       600 $params->setValue(textflag => -T $filename )
797             if ! $params->parsed('textflag');
798              
799 113 50       355 $params->setValue(zip64 => 1)
800             if IO::Compress::Base::Common::isGeMax32 $size ;
801              
802 113 100       306 $params->setValue('name' => $filename)
803             if ! $params->parsed('name') ;
804              
805 113 100       350 $params->setValue('time' => $mtime)
806             if ! $params->parsed('time') ;
807              
808 113 50       301 if ( ! $params->parsed('extime'))
809             {
810 113         295 $params->setValue('mtime' => $mtime) ;
811 113         279 $params->setValue('atime' => $atime) ;
812 113         286 $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       309 if (! $params->parsed('extattr'))
818             {
819 19     19   145 use Fcntl qw(:mode) ;
  19         55  
  19         15388  
820 108         217 my $attr = $mode << 16;
821 108 50       295 $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ;
822 108 50       482 $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ;
823              
824 108         228 $params->setValue('extattr' => $attr);
825             }
826              
827 113         408 $params->setValue('want_exunixn', [$uid, $gid]);
828 113         298 $params->setValue('uid' => $uid) ;
829 113         321 $params->setValue('gid' => $gid) ;
830              
831             }
832              
833             sub mkExtendedTime
834             {
835             # order expected is m, a, c
836              
837 226     226 0 341 my $times = '';
838 226         289 my $bit = 1 ;
839 226         315 my $flags = 0;
840              
841 226         380 for my $time (@_)
842             {
843 452 100       793 if (defined $time)
844             {
845 339         433 $flags |= $bit;
846 339         732 $times .= pack("V", $time);
847             }
848              
849 452         654 $bit <<= 1 ;
850             }
851              
852 226         833 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 201 my $uid = shift;
871 113         145 my $gid = shift;
872              
873             # Assumes UID/GID are 32-bit
874 113         153 my $ids ;
875 113         193 $ids .= pack "C", 1; # version
876 113         1401 $ids .= pack "C", $Config{uidsize};
877 113         365 $ids .= pack "V", $uid;
878 113         668 $ids .= pack "C", $Config{gidsize};
879 113         262 $ids .= pack "V", $gid;
880              
881 113         282 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   634 my $time_t = shift;
890              
891             # TODO - add something to cope with unix time < 1980
892 383         10275 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
893 383         1336 my $dt = 0;
894 383         824 $dt += ( $sec >> 1 );
895 383         720 $dt += ( $min << 5 );
896 383         567 $dt += ( $hour << 11 );
897 383         675 $dt += ( $mday << 16 );
898 383         644 $dt += ( ( $mon + 1 ) << 21 );
899 383         870 $dt += ( ( $year - 80 ) << 25 );
900 383         854 return $dt;
901             }
902              
903             1;
904              
905             __END__