1package IO::Compress::Zip ; 2 3use strict ; 4use warnings; 5use bytes; 6 7use IO::Compress::Base::Common 2.093 qw(:Status ); 8use IO::Compress::RawDeflate 2.093 (); 9use IO::Compress::Adapter::Deflate 2.093 ; 10use IO::Compress::Adapter::Identity 2.093 ; 11use IO::Compress::Zlib::Extra 2.093 ; 12use IO::Compress::Zip::Constants 2.093 ; 13 14use File::Spec(); 15use Config; 16 17use Compress::Raw::Zlib 2.093 (); 18 19BEGIN 20{ 21 eval { require IO::Compress::Adapter::Bzip2 ; 22 import IO::Compress::Adapter::Bzip2 2.093 ; 23 require IO::Compress::Bzip2 ; 24 import IO::Compress::Bzip2 2.093 ; 25 } ; 26 27 eval { require IO::Compress::Adapter::Lzma ; 28 import IO::Compress::Adapter::Lzma 2.093 ; 29 require IO::Compress::Lzma ; 30 import IO::Compress::Lzma 2.093 ; 31 } ; 32} 33 34 35require Exporter ; 36 37our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); 38 39$VERSION = '2.093'; 40$ZipError = ''; 41 42@ISA = qw(IO::Compress::RawDeflate Exporter); 43@EXPORT_OK = qw( $ZipError zip ) ; 44%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; 45 46push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; 47 48$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA)]; 49push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} }; 50 51Exporter::export_ok_tags('all'); 52 53sub new 54{ 55 my $class = shift ; 56 57 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError); 58 $obj->_create(undef, @_); 59 60} 61 62sub zip 63{ 64 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError); 65 return $obj->_def(@_); 66} 67 68sub isMethodAvailable 69{ 70 my $method = shift; 71 72 # Store & Deflate are always available 73 return 1 74 if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ; 75 76 return 1 77 if $method == ZIP_CM_BZIP2 and 78 defined $IO::Compress::Adapter::Bzip2::VERSION; 79 80 return 1 81 if $method == ZIP_CM_LZMA and 82 defined $IO::Compress::Adapter::Lzma::VERSION; 83 84 return 0; 85} 86 87sub beforePayload 88{ 89 my $self = shift ; 90 91 if (*$self->{ZipData}{Sparse} ) { 92 my $inc = 1024 * 100 ; 93 my $NULLS = ("\x00" x $inc) ; 94 my $sparse = *$self->{ZipData}{Sparse} ; 95 *$self->{CompSize}->add( $sparse ); 96 *$self->{UnCompSize}->add( $sparse ); 97 98 *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR); 99 100 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32}) 101 for 1 .. int $sparse / $inc; 102 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc), 103 *$self->{ZipData}{CRC32}) 104 if $sparse % $inc; 105 } 106} 107 108sub mkComp 109{ 110 my $self = shift ; 111 my $got = shift ; 112 113 my ($obj, $errstr, $errno) ; 114 115 if (*$self->{ZipData}{Method} == ZIP_CM_STORE) { 116 ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject( 117 $got->getValue('level'), 118 $got->getValue('strategy') 119 ); 120 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); 121 } 122 elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { 123 ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject( 124 $got->getValue('crc32'), 125 $got->getValue('adler32'), 126 $got->getValue('level'), 127 $got->getValue('strategy') 128 ); 129 } 130 elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) { 131 ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject( 132 $got->getValue('blocksize100k'), 133 $got->getValue('workfactor'), 134 $got->getValue('verbosity') 135 ); 136 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); 137 } 138 elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { 139 ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'), 140 $got->getValue('extreme'), 141 ); 142 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); 143 } 144 145 return $self->saveErrorString(undef, $errstr, $errno) 146 if ! defined $obj; 147 148 if (! defined *$self->{ZipData}{SizesOffset}) { 149 *$self->{ZipData}{SizesOffset} = 0; 150 *$self->{ZipData}{Offset} = new U64 ; 151 } 152 153 *$self->{ZipData}{AnyZip64} = 0 154 if ! defined *$self->{ZipData}{AnyZip64} ; 155 156 return $obj; 157} 158 159sub reset 160{ 161 my $self = shift ; 162 163 *$self->{Compress}->reset(); 164 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(''); 165 166 return STATUS_OK; 167} 168 169sub filterUncompressed 170{ 171 my $self = shift ; 172 173 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { 174 *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32(); 175 } 176 else { 177 *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}); 178 179 } 180} 181 182sub canonicalName 183{ 184 # This sub is derived from Archive::Zip::_asZipDirName 185 186 # Return the normalized name as used in a zip file (path 187 # separators become slashes, etc.). 188 # Will translate internal slashes in path components (i.e. on Macs) to 189 # underscores. Discards volume names. 190 # When $forceDir is set, returns paths with trailing slashes 191 # 192 # input output 193 # . '.' 194 # ./a a 195 # ./a/b a/b 196 # ./a/b/ a/b 197 # a/b/ a/b 198 # /a/b/ a/b 199 # c:\a\b\c.doc a/b/c.doc # on Windows 200 # "i/o maps:whatever" i_o maps/whatever # on Macs 201 202 my $name = shift; 203 my $forceDir = shift ; 204 205 my ( $volume, $directories, $file ) = 206 File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); 207 208 my @dirs = map { $_ =~ s{/}{_}g; $_ } 209 File::Spec->splitdir($directories); 210 211 if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component 212 push @dirs, defined($file) ? $file : '' ; 213 214 my $normalised_path = join '/', @dirs; 215 216 # Leading directory separators should not be stored in zip archives. 217 # Example: 218 # C:\a\b\c\ a/b/c 219 # C:\a\b\c.txt a/b/c.txt 220 # /a/b/c/ a/b/c 221 # /a/b/c.txt a/b/c.txt 222 $normalised_path =~ s{^/}{}; # remove leading separator 223 224 return $normalised_path; 225} 226 227 228sub mkHeader 229{ 230 my $self = shift; 231 my $param = shift ; 232 233 *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset}); 234 235 my $comment = ''; 236 $comment = $param->valueOrDefault('comment') ; 237 238 my $filename = ''; 239 $filename = $param->valueOrDefault('name') ; 240 241 $filename = canonicalName($filename) 242 if length $filename && $param->getValue('canonicalname') ; 243 244 if (defined *$self->{ZipData}{FilterName} ) { 245 local *_ = \$filename ; 246 &{ *$self->{ZipData}{FilterName} }() ; 247 } 248 249 if ( $param->getValue('efs') && $] >= 5.008004) { 250 if (length $filename) { 251 utf8::downgrade($filename, 1) 252 or Carp::croak "Wide character in zip filename"; 253 } 254 255 if (length $comment) { 256 utf8::downgrade($comment, 1) 257 or Carp::croak "Wide character in zip comment"; 258 } 259 } 260 261 my $hdr = ''; 262 263 my $time = _unixToDosTime($param->getValue('time')); 264 265 my $extra = ''; 266 my $ctlExtra = ''; 267 my $empty = 0; 268 my $osCode = $param->getValue('os_code') ; 269 my $extFileAttr = 0 ; 270 271 # This code assumes Unix. 272 # TODO - revisit this 273 $extFileAttr = 0100644 << 16 274 if $osCode == ZIP_OS_CODE_UNIX ; 275 276 if (*$self->{ZipData}{Zip64}) { 277 $empty = IO::Compress::Base::Common::MAX32; 278 279 my $x = ''; 280 $x .= pack "V V", 0, 0 ; # uncompressedLength 281 $x .= pack "V V", 0, 0 ; # compressedLength 282 283 # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug 284 # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details 285 $extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x); 286 } 287 288 if (! $param->getValue('minimal')) { 289 if ($param->parsed('mtime')) 290 { 291 $extra .= mkExtendedTime($param->getValue('mtime'), 292 $param->getValue('atime'), 293 $param->getValue('ctime')); 294 295 $ctlExtra .= mkExtendedTime($param->getValue('mtime')); 296 } 297 298 if ( $osCode == ZIP_OS_CODE_UNIX ) 299 { 300 if ( $param->getValue('want_exunixn') ) 301 { 302 my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') }); 303 $extra .= $ux3; 304 $ctlExtra .= $ux3; 305 } 306 307 if ( $param->getValue('exunix2') ) 308 { 309 $extra .= mkUnix2Extra( @{ $param->getValue('exunix2') }); 310 $ctlExtra .= mkUnix2Extra(); 311 } 312 } 313 314 $extFileAttr = $param->getValue('extattr') 315 if defined $param->getValue('extattr') ; 316 317 $extra .= $param->getValue('extrafieldlocal') 318 if defined $param->getValue('extrafieldlocal'); 319 320 $ctlExtra .= $param->getValue('extrafieldcentral') 321 if defined $param->getValue('extrafieldcentral'); 322 } 323 324 my $method = *$self->{ZipData}{Method} ; 325 my $gpFlag = 0 ; 326 $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK 327 if *$self->{ZipData}{Stream} ; 328 329 $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT 330 if $method == ZIP_CM_LZMA ; 331 332 $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING 333 if $param->getValue('efs') && (length($filename) || length($comment)); 334 335 my $version = $ZIP_CM_MIN_VERSIONS{$method}; 336 $version = ZIP64_MIN_VERSION 337 if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64}; 338 339 my $madeBy = ($param->getValue('os_code') << 8) + $version; 340 my $extract = $version; 341 342 *$self->{ZipData}{Version} = $version; 343 *$self->{ZipData}{MadeBy} = $madeBy; 344 345 my $ifa = 0; 346 $ifa |= ZIP_IFA_TEXT_MASK 347 if $param->getValue('textflag'); 348 349 $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature 350 $hdr .= pack 'v', $extract ; # extract Version & OS 351 $hdr .= pack 'v', $gpFlag ; # general purpose flag (set streaming mode) 352 $hdr .= pack 'v', $method ; # compression method (deflate) 353 $hdr .= pack 'V', $time ; # last mod date/time 354 $hdr .= pack 'V', 0 ; # crc32 - 0 when streaming 355 $hdr .= pack 'V', $empty ; # compressed length - 0 when streaming 356 $hdr .= pack 'V', $empty ; # uncompressed length - 0 when streaming 357 $hdr .= pack 'v', length $filename ; # filename length 358 $hdr .= pack 'v', length $extra ; # extra length 359 360 $hdr .= $filename ; 361 362 # Remember the offset for the compressed & uncompressed lengths in the 363 # local header. 364 if (*$self->{ZipData}{Zip64}) { 365 *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit() 366 + length($hdr) + 4 ; 367 } 368 else { 369 *$self->{ZipData}{SizesOffset} = *$self->{ZipData}{Offset}->get64bit() 370 + 18; 371 } 372 373 $hdr .= $extra ; 374 375 376 my $ctl = ''; 377 378 $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature 379 $ctl .= pack 'v', $madeBy ; # version made by 380 $ctl .= pack 'v', $extract ; # extract Version 381 $ctl .= pack 'v', $gpFlag ; # general purpose flag (streaming mode) 382 $ctl .= pack 'v', $method ; # compression method (deflate) 383 $ctl .= pack 'V', $time ; # last mod date/time 384 $ctl .= pack 'V', 0 ; # crc32 385 $ctl .= pack 'V', $empty ; # compressed length 386 $ctl .= pack 'V', $empty ; # uncompressed length 387 $ctl .= pack 'v', length $filename ; # filename length 388 389 *$self->{ZipData}{ExtraOffset} = length $ctl; 390 *$self->{ZipData}{ExtraSize} = length $ctlExtra ; 391 392 $ctl .= pack 'v', length $ctlExtra ; # extra length 393 $ctl .= pack 'v', length $comment ; # file comment length 394 $ctl .= pack 'v', 0 ; # disk number start 395 $ctl .= pack 'v', $ifa ; # internal file attributes 396 $ctl .= pack 'V', $extFileAttr ; # external file attributes 397 398 # offset to local hdr 399 if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { 400 $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ; 401 } 402 else { 403 $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; 404 } 405 406 $ctl .= $filename ; 407 408 *$self->{ZipData}{Offset}->add32(length $hdr) ; 409 410 *$self->{ZipData}{CentralHeader} = [ $ctl, $ctlExtra, $comment]; 411 412 return $hdr; 413} 414 415sub mkTrailer 416{ 417 my $self = shift ; 418 419 my $crc32 ; 420 if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { 421 $crc32 = pack "V", *$self->{Compress}->crc32(); 422 } 423 else { 424 $crc32 = pack "V", *$self->{ZipData}{CRC32}; 425 } 426 427 my ($ctl, $ctlExtra, $comment) = @{ *$self->{ZipData}{CentralHeader} }; 428 429 my $sizes ; 430 if (! *$self->{ZipData}{Zip64}) { 431 $sizes .= *$self->{CompSize}->getPacked_V32() ; # Compressed size 432 $sizes .= *$self->{UnCompSize}->getPacked_V32() ; # Uncompressed size 433 } 434 else { 435 $sizes .= *$self->{CompSize}->getPacked_V64() ; # Compressed size 436 $sizes .= *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size 437 } 438 439 my $data = $crc32 . $sizes ; 440 441 my $xtrasize = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size 442 $xtrasize .= *$self->{CompSize}->getPacked_V64() ; # Compressed size 443 444 my $hdr = ''; 445 446 if (*$self->{ZipData}{Stream}) { 447 $hdr = pack "V", ZIP_DATA_HDR_SIG ; # signature 448 $hdr .= $data ; 449 } 450 else { 451 $self->writeAt(*$self->{ZipData}{LocalHdrOffset}->get64bit() + 14, $crc32) 452 or return undef; 453 $self->writeAt(*$self->{ZipData}{SizesOffset}, 454 *$self->{ZipData}{Zip64} ? $xtrasize : $sizes) 455 or return undef; 456 } 457 458 # Central Header Record/Zip64 extended field 459 460 substr($ctl, 16, length $crc32) = $crc32 ; 461 462 my $zip64Payload = ''; 463 464 # uncompressed length - only set zip64 if needed 465 if (*$self->{UnCompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) { 466 $zip64Payload .= *$self->{UnCompSize}->getPacked_V64() ; 467 } else { 468 substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ; 469 } 470 471 # compressed length - only set zip64 if needed 472 if (*$self->{CompSize}->isAlmost64bit()) { # || *$self->{ZipData}{Zip64}) { 473 $zip64Payload .= *$self->{CompSize}->getPacked_V64() ; 474 } else { 475 substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ; 476 } 477 478 # Local Header offset 479 $zip64Payload .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V64() 480 if *$self->{ZipData}{LocalHdrOffset}->is64bit() ; 481 482 # disk no - always zero, so don't need to include it. 483 #$zip64Payload .= pack "V", 0 ; 484 485 my $zip64Xtra = ''; 486 487 if (length $zip64Payload) { 488 $zip64Xtra = IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $zip64Payload); 489 490 substr($ctl, *$self->{ZipData}{ExtraOffset}, 2) = 491 pack 'v', *$self->{ZipData}{ExtraSize} + length $zip64Xtra; 492 493 *$self->{ZipData}{AnyZip64} = 1; 494 } 495 496 # Zip64 needs to be first in extra field to workaround a Windows Explorer Bug 497 # See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details 498 $ctl .= $zip64Xtra . $ctlExtra . $comment; 499 500 *$self->{ZipData}{Offset}->add32(length($hdr)); 501 *$self->{ZipData}{Offset}->add( *$self->{CompSize} ); 502 push @{ *$self->{ZipData}{CentralDir} }, $ctl ; 503 504 return $hdr; 505} 506 507sub mkFinalTrailer 508{ 509 my $self = shift ; 510 511 my $comment = ''; 512 $comment = *$self->{ZipData}{ZipComment} ; 513 514 my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir 515 516 my $entries = @{ *$self->{ZipData}{CentralDir} }; 517 518 *$self->{ZipData}{AnyZip64} = 1 519 if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ; 520 521 my $cd = join '', @{ *$self->{ZipData}{CentralDir} }; 522 my $cd_len = length $cd ; 523 524 my $z64e = ''; 525 526 if ( *$self->{ZipData}{AnyZip64} ) { 527 528 my $v = *$self->{ZipData}{Version} ; 529 my $mb = *$self->{ZipData}{MadeBy} ; 530 $z64e .= pack 'v', $mb ; # Version made by 531 $z64e .= pack 'v', $v ; # Version to extract 532 $z64e .= pack 'V', 0 ; # number of disk 533 $z64e .= pack 'V', 0 ; # number of disk with central dir 534 $z64e .= U64::pack_V64 $entries ; # entries in central dir on this disk 535 $z64e .= U64::pack_V64 $entries ; # entries in central dir 536 $z64e .= U64::pack_V64 $cd_len ; # size of central dir 537 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to start central dir 538 539 $z64e = pack("V", ZIP64_END_CENTRAL_REC_HDR_SIG) # signature 540 . U64::pack_V64(length $z64e) 541 . $z64e ; 542 543 *$self->{ZipData}{Offset}->add32(length $cd) ; 544 545 $z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature 546 $z64e .= pack 'V', 0 ; # number of disk with central dir 547 $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir 548 $z64e .= pack 'V', 1 ; # Total number of disks 549 550 $cd_offset = IO::Compress::Base::Common::MAX32 ; 551 $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ; 552 $entries = 0xFFFF if $entries >= 0xFFFF ; 553 } 554 555 my $ecd = ''; 556 $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature 557 $ecd .= pack 'v', 0 ; # number of disk 558 $ecd .= pack 'v', 0 ; # number of disk with central dir 559 $ecd .= pack 'v', $entries ; # entries in central dir on this disk 560 $ecd .= pack 'v', $entries ; # entries in central dir 561 $ecd .= pack 'V', $cd_len ; # size of central dir 562 $ecd .= pack 'V', $cd_offset ; # offset to start central dir 563 $ecd .= pack 'v', length $comment ; # zipfile comment length 564 $ecd .= $comment; 565 566 return $cd . $z64e . $ecd ; 567} 568 569sub ckParams 570{ 571 my $self = shift ; 572 my $got = shift; 573 574 $got->setValue('crc32' => 1); 575 576 if (! $got->parsed('time') ) { 577 # Modification time defaults to now. 578 $got->setValue('time' => time) ; 579 } 580 581 if ($got->parsed('extime') ) { 582 my $timeRef = $got->getValue('extime'); 583 if ( defined $timeRef) { 584 return $self->saveErrorString(undef, "exTime not a 3-element array ref") 585 if ref $timeRef ne 'ARRAY' || @$timeRef != 3; 586 } 587 588 $got->setValue("mtime", $timeRef->[1]); 589 $got->setValue("atime", $timeRef->[0]); 590 $got->setValue("ctime", $timeRef->[2]); 591 } 592 593 # Unix2/3 Extended Attribute 594 for my $name (qw(exunix2 exunixn)) 595 { 596 if ($got->parsed($name) ) { 597 my $idRef = $got->getValue($name); 598 if ( defined $idRef) { 599 return $self->saveErrorString(undef, "$name not a 2-element array ref") 600 if ref $idRef ne 'ARRAY' || @$idRef != 2; 601 } 602 603 $got->setValue("uid", $idRef->[0]); 604 $got->setValue("gid", $idRef->[1]); 605 $got->setValue("want_$name", $idRef); 606 } 607 } 608 609 *$self->{ZipData}{AnyZip64} = 1 610 if $got->getValue('zip64'); 611 *$self->{ZipData}{Zip64} = $got->getValue('zip64'); 612 *$self->{ZipData}{Stream} = $got->getValue('stream'); 613 614 my $method = $got->getValue('method'); 615 return $self->saveErrorString(undef, "Unknown Method '$method'") 616 if ! defined $ZIP_CM_MIN_VERSIONS{$method}; 617 618 return $self->saveErrorString(undef, "Bzip2 not available") 619 if $method == ZIP_CM_BZIP2 and 620 ! defined $IO::Compress::Adapter::Bzip2::VERSION; 621 622 return $self->saveErrorString(undef, "Lzma not available") 623 if $method == ZIP_CM_LZMA 624 and ! defined $IO::Compress::Adapter::Lzma::VERSION; 625 626 *$self->{ZipData}{Method} = $method; 627 628 *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ; 629 630 for my $name (qw( extrafieldlocal extrafieldcentral )) 631 { 632 my $data = $got->getValue($name) ; 633 if (defined $data) { 634 my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ; 635 return $self->saveErrorString(undef, "Error with $name Parameter: $bad") 636 if $bad ; 637 638 $got->setValue($name, $data) ; 639 } 640 } 641 642 return undef 643 if defined $IO::Compress::Bzip2::VERSION 644 and ! IO::Compress::Bzip2::ckParams($self, $got); 645 646 if ($got->parsed('sparse') ) { 647 *$self->{ZipData}{Sparse} = $got->getValue('sparse') ; 648 *$self->{ZipData}{Method} = ZIP_CM_STORE; 649 } 650 651 if ($got->parsed('filtername')) { 652 my $v = $got->getValue('filtername') ; 653 *$self->{ZipData}{FilterName} = $v 654 if ref $v eq 'CODE' ; 655 } 656 657 return 1 ; 658} 659 660sub outputPayload 661{ 662 my $self = shift ; 663 return 1 if *$self->{ZipData}{Sparse} ; 664 return $self->output(@_); 665} 666 667 668#sub newHeader 669#{ 670# my $self = shift ; 671# 672# return $self->mkHeader(*$self->{Got}); 673#} 674 675 676our %PARAMS = ( 677 'stream' => [IO::Compress::Base::Common::Parse_boolean, 1], 678 #'store' => [IO::Compress::Base::Common::Parse_boolean, 0], 679 'method' => [IO::Compress::Base::Common::Parse_unsigned, ZIP_CM_DEFLATE], 680 681# # Zip header fields 682 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 683 'zip64' => [IO::Compress::Base::Common::Parse_boolean, 0], 684 'comment' => [IO::Compress::Base::Common::Parse_any, ''], 685 'zipcomment'=> [IO::Compress::Base::Common::Parse_any, ''], 686 'name' => [IO::Compress::Base::Common::Parse_any, ''], 687 'filtername'=> [IO::Compress::Base::Common::Parse_code, undef], 688 'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean, 0], 689 'efs' => [IO::Compress::Base::Common::Parse_boolean, 0], 690 'time' => [IO::Compress::Base::Common::Parse_any, undef], 691 'extime' => [IO::Compress::Base::Common::Parse_any, undef], 692 'exunix2' => [IO::Compress::Base::Common::Parse_any, undef], 693 'exunixn' => [IO::Compress::Base::Common::Parse_any, undef], 694 'extattr' => [IO::Compress::Base::Common::Parse_any, 695 $Compress::Raw::Zlib::gzip_os_code == 3 696 ? 0100644 << 16 697 : 0], 698 'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], 699 700 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0], 701 'extrafieldlocal' => [IO::Compress::Base::Common::Parse_any, undef], 702 'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any, undef], 703 704 # Lzma 705 'preset' => [IO::Compress::Base::Common::Parse_unsigned, 6], 706 'extreme' => [IO::Compress::Base::Common::Parse_boolean, 0], 707 708 # For internal use only 709 'sparse' => [IO::Compress::Base::Common::Parse_unsigned, 0], 710 711 IO::Compress::RawDeflate::getZlibParams(), 712 defined $IO::Compress::Bzip2::VERSION 713 ? IO::Compress::Bzip2::getExtraParams() 714 : () 715 716 717 ); 718 719sub getExtraParams 720{ 721 return %PARAMS ; 722} 723 724sub getInverseClass 725{ 726 return ('IO::Uncompress::Unzip', 727 \$IO::Uncompress::Unzip::UnzipError); 728} 729 730sub getFileInfo 731{ 732 my $self = shift ; 733 my $params = shift; 734 my $filename = shift ; 735 736 if (IO::Compress::Base::Common::isaScalar($filename)) 737 { 738 $params->setValue(zip64 => 1) 739 if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ; 740 741 return ; 742 } 743 744 my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ; 745 if ( $params->parsed('storelinks') ) 746 { 747 ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) 748 = (lstat($filename))[2, 4,5,7, 8,9,10] ; 749 } 750 else 751 { 752 ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) 753 = (stat($filename))[2, 4,5,7, 8,9,10] ; 754 } 755 756 $params->setValue(textflag => -T $filename ) 757 if ! $params->parsed('textflag'); 758 759 $params->setValue(zip64 => 1) 760 if IO::Compress::Base::Common::isGeMax32 $size ; 761 762 $params->setValue('name' => $filename) 763 if ! $params->parsed('name') ; 764 765 $params->setValue('time' => $mtime) 766 if ! $params->parsed('time') ; 767 768 if ( ! $params->parsed('extime')) 769 { 770 $params->setValue('mtime' => $mtime) ; 771 $params->setValue('atime' => $atime) ; 772 $params->setValue('ctime' => undef) ; # No Creation time 773 # TODO - see if can fillout creation time on non-Unix 774 } 775 776 # NOTE - Unix specific code alert 777 if (! $params->parsed('extattr')) 778 { 779 use Fcntl qw(:mode) ; 780 my $attr = $mode << 16; 781 $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ; 782 $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ; 783 784 $params->setValue('extattr' => $attr); 785 } 786 787 $params->setValue('want_exunixn', [$uid, $gid]); 788 $params->setValue('uid' => $uid) ; 789 $params->setValue('gid' => $gid) ; 790 791} 792 793sub mkExtendedTime 794{ 795 # order expected is m, a, c 796 797 my $times = ''; 798 my $bit = 1 ; 799 my $flags = 0; 800 801 for my $time (@_) 802 { 803 if (defined $time) 804 { 805 $flags |= $bit; 806 $times .= pack("V", $time); 807 } 808 809 $bit <<= 1 ; 810 } 811 812 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP, 813 pack("C", $flags) . $times); 814} 815 816sub mkUnix2Extra 817{ 818 my $ids = ''; 819 for my $id (@_) 820 { 821 $ids .= pack("v", $id); 822 } 823 824 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX2, 825 $ids); 826} 827 828sub mkUnixNExtra 829{ 830 my $uid = shift; 831 my $gid = shift; 832 833 # Assumes UID/GID are 32-bit 834 my $ids ; 835 $ids .= pack "C", 1; # version 836 $ids .= pack "C", $Config{uidsize}; 837 $ids .= pack "V", $uid; 838 $ids .= pack "C", $Config{gidsize}; 839 $ids .= pack "V", $gid; 840 841 return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, 842 $ids); 843} 844 845 846# from Archive::Zip 847sub _unixToDosTime # Archive::Zip::Member 848{ 849 my $time_t = shift; 850 851 # TODO - add something to cope with unix time < 1980 852 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); 853 my $dt = 0; 854 $dt += ( $sec >> 1 ); 855 $dt += ( $min << 5 ); 856 $dt += ( $hour << 11 ); 857 $dt += ( $mday << 16 ); 858 $dt += ( ( $mon + 1 ) << 21 ); 859 $dt += ( ( $year - 80 ) << 25 ); 860 return $dt; 861} 862 8631; 864 865__END__ 866 867=head1 NAME 868 869IO::Compress::Zip - Write zip files/buffers 870 871=head1 SYNOPSIS 872 873 use IO::Compress::Zip qw(zip $ZipError) ; 874 875 my $status = zip $input => $output [,OPTS] 876 or die "zip failed: $ZipError\n"; 877 878 my $z = new IO::Compress::Zip $output [,OPTS] 879 or die "zip failed: $ZipError\n"; 880 881 $z->print($string); 882 $z->printf($format, $string); 883 $z->write($string); 884 $z->syswrite($string [, $length, $offset]); 885 $z->flush(); 886 $z->tell(); 887 $z->eof(); 888 $z->seek($position, $whence); 889 $z->binmode(); 890 $z->fileno(); 891 $z->opened(); 892 $z->autoflush(); 893 $z->input_line_number(); 894 $z->newStream( [OPTS] ); 895 896 $z->deflateParams(); 897 898 $z->close() ; 899 900 $ZipError ; 901 902 # IO::File mode 903 904 print $z $string; 905 printf $z $format, $string; 906 tell $z 907 eof $z 908 seek $z, $position, $whence 909 binmode $z 910 fileno $z 911 close $z ; 912 913=head1 DESCRIPTION 914 915This module provides a Perl interface that allows writing zip 916compressed data to files or buffer. 917 918The primary purpose of this module is to provide streaming write access to 919zip files and buffers. It is not a general-purpose file archiver. If that 920is what you want, check out C<Archive::Zip> or C<Archive::Zip::SimpleZip>. 921 922At present the following compression methods are supported by IO::Compress::Zip, 923namely Store (no compression at all), Deflate, Bzip2 and LZMA. 924 925B<Note> 926 927=over 5 928 929=item * To use Bzip2 compression, the module C<IO::Compress::Bzip2> must be installed. 930 931=item * To use LZMA compression, the module C<IO::Compress::Lzma> must be installed. 932 933=back 934 935For reading zip files/buffers, see the companion module 936L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>. 937 938=head1 Functional Interface 939 940A top-level function, C<zip>, is provided to carry out 941"one-shot" compression between buffers and/or files. For finer 942control over the compression process, see the L</"OO Interface"> 943section. 944 945 use IO::Compress::Zip qw(zip $ZipError) ; 946 947 zip $input_filename_or_reference => $output_filename_or_reference [,OPTS] 948 or die "zip failed: $ZipError\n"; 949 950The functional interface needs Perl5.005 or better. 951 952=head2 zip $input_filename_or_reference => $output_filename_or_reference [, OPTS] 953 954C<zip> expects at least two parameters, 955C<$input_filename_or_reference> and C<$output_filename_or_reference> 956and zero or more optional parameters (see L</Optional Parameters>) 957 958=head3 The C<$input_filename_or_reference> parameter 959 960The parameter, C<$input_filename_or_reference>, is used to define the 961source of the uncompressed data. 962 963It can take one of the following forms: 964 965=over 5 966 967=item A filename 968 969If the C<$input_filename_or_reference> parameter is a simple scalar, it is 970assumed to be a filename. This file will be opened for reading and the 971input data will be read from it. 972 973=item A filehandle 974 975If the C<$input_filename_or_reference> parameter is a filehandle, the input 976data will be read from it. The string '-' can be used as an alias for 977standard input. 978 979=item A scalar reference 980 981If C<$input_filename_or_reference> is a scalar reference, the input data 982will be read from C<$$input_filename_or_reference>. 983 984=item An array reference 985 986If C<$input_filename_or_reference> is an array reference, each element in 987the array must be a filename. 988 989The input data will be read from each file in turn. 990 991The complete array will be walked to ensure that it only 992contains valid filenames before any data is compressed. 993 994=item An Input FileGlob string 995 996If C<$input_filename_or_reference> is a string that is delimited by the 997characters "<" and ">" C<zip> will assume that it is an 998I<input fileglob string>. The input is the list of files that match the 999fileglob. 1000 1001See L<File::GlobMapper|File::GlobMapper> for more details. 1002 1003=back 1004 1005If the C<$input_filename_or_reference> parameter is any other type, 1006C<undef> will be returned. 1007 1008In addition, if C<$input_filename_or_reference> is a simple filename, 1009the default values for 1010the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options will be sourced from that file. 1011 1012If you do not want to use these defaults they can be overridden by 1013explicitly setting the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options or by setting the 1014C<Minimal> parameter. 1015 1016=head3 The C<$output_filename_or_reference> parameter 1017 1018The parameter C<$output_filename_or_reference> is used to control the 1019destination of the compressed data. This parameter can take one of 1020these forms. 1021 1022=over 5 1023 1024=item A filename 1025 1026If the C<$output_filename_or_reference> parameter is a simple scalar, it is 1027assumed to be a filename. This file will be opened for writing and the 1028compressed data will be written to it. 1029 1030=item A filehandle 1031 1032If the C<$output_filename_or_reference> parameter is a filehandle, the 1033compressed data will be written to it. The string '-' can be used as 1034an alias for standard output. 1035 1036=item A scalar reference 1037 1038If C<$output_filename_or_reference> is a scalar reference, the 1039compressed data will be stored in C<$$output_filename_or_reference>. 1040 1041=item An Array Reference 1042 1043If C<$output_filename_or_reference> is an array reference, 1044the compressed data will be pushed onto the array. 1045 1046=item An Output FileGlob 1047 1048If C<$output_filename_or_reference> is a string that is delimited by the 1049characters "<" and ">" C<zip> will assume that it is an 1050I<output fileglob string>. The output is the list of files that match the 1051fileglob. 1052 1053When C<$output_filename_or_reference> is an fileglob string, 1054C<$input_filename_or_reference> must also be a fileglob string. Anything 1055else is an error. 1056 1057See L<File::GlobMapper|File::GlobMapper> for more details. 1058 1059=back 1060 1061If the C<$output_filename_or_reference> parameter is any other type, 1062C<undef> will be returned. 1063 1064=head2 Notes 1065 1066When C<$input_filename_or_reference> maps to multiple files/buffers and 1067C<$output_filename_or_reference> is a single 1068file/buffer the input files/buffers will each be stored 1069in C<$output_filename_or_reference> as a distinct entry. 1070 1071=head2 Optional Parameters 1072 1073The optional parameters for the one-shot function C<zip> 1074are (for the most part) identical to those used with the OO interface defined in the 1075L</"Constructor Options"> section. The exceptions are listed below 1076 1077=over 5 1078 1079=item C<< AutoClose => 0|1 >> 1080 1081This option applies to any input or output data streams to 1082C<zip> that are filehandles. 1083 1084If C<AutoClose> is specified, and the value is true, it will result in all 1085input and/or output filehandles being closed once C<zip> has 1086completed. 1087 1088This parameter defaults to 0. 1089 1090=item C<< BinModeIn => 0|1 >> 1091 1092This option is now a no-op. All files will be read in binmode. 1093 1094=item C<< Append => 0|1 >> 1095 1096The behaviour of this option is dependent on the type of output data 1097stream. 1098 1099=over 5 1100 1101=item * A Buffer 1102 1103If C<Append> is enabled, all compressed data will be append to the end of 1104the output buffer. Otherwise the output buffer will be cleared before any 1105compressed data is written to it. 1106 1107=item * A Filename 1108 1109If C<Append> is enabled, the file will be opened in append mode. Otherwise 1110the contents of the file, if any, will be truncated before any compressed 1111data is written to it. 1112 1113=item * A Filehandle 1114 1115If C<Append> is enabled, the filehandle will be positioned to the end of 1116the file via a call to C<seek> before any compressed data is 1117written to it. Otherwise the file pointer will not be moved. 1118 1119=back 1120 1121When C<Append> is specified, and set to true, it will I<append> all compressed 1122data to the output data stream. 1123 1124So when the output is a filehandle it will carry out a seek to the eof 1125before writing any compressed data. If the output is a filename, it will be opened for 1126appending. If the output is a buffer, all compressed data will be 1127appended to the existing buffer. 1128 1129Conversely when C<Append> is not specified, or it is present and is set to 1130false, it will operate as follows. 1131 1132When the output is a filename, it will truncate the contents of the file 1133before writing any compressed data. If the output is a filehandle 1134its position will not be changed. If the output is a buffer, it will be 1135wiped before any compressed data is output. 1136 1137Defaults to 0. 1138 1139=back 1140 1141=head2 Examples 1142 1143Here are a few example that show the capabilities of the module. 1144 1145=head3 Streaming 1146 1147This very simple command line example demonstrates the streaming capabilities of the module. 1148The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT. 1149 1150 $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip \*STDIN => \*STDOUT' >output.zip 1151 1152The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>, 1153so the above can be rewritten as 1154 1155 $ echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-"' >output.zip 1156 1157One problem with creating a zip archive directly from STDIN can be demonstrated by looking at 1158the contents of the zip file, output.zip, that we have just created. 1159 1160 $ unzip -l output.zip 1161 Archive: output.zip 1162 Length Date Time Name 1163 --------- ---------- ----- ---- 1164 12 2019-08-16 22:21 1165 --------- ------- 1166 12 1 file 1167 1168The archive member (filename) used is the empty string. 1169 1170If that doesn't suit your needs, you can explicitly set the filename used 1171in the zip archive by specifying the L<Name|"File Naming Options"> option, like so 1172 1173 echo hello world | perl -MIO::Compress::Zip=zip -e 'zip "-" => "-", Name => "hello.txt"' >output.zip 1174 1175Now the contents of the zip file looks like this 1176 1177 $ unzip -l output.zip 1178 Archive: output.zip 1179 Length Date Time Name 1180 --------- ---------- ----- ---- 1181 12 2019-08-16 22:22 hello.txt 1182 --------- ------- 1183 12 1 file 1184 1185=head3 Compressing a file from the filesystem 1186 1187To read the contents of the file C<file1.txt> and write the compressed 1188data to the file C<file1.txt.zip>. 1189 1190 use strict ; 1191 use warnings ; 1192 use IO::Compress::Zip qw(zip $ZipError) ; 1193 1194 my $input = "file1.txt"; 1195 zip $input => "$input.zip" 1196 or die "zip failed: $ZipError\n"; 1197 1198=head3 Reading from a Filehandle and writing to an in-memory buffer 1199 1200To read from an existing Perl filehandle, C<$input>, and write the 1201compressed data to a buffer, C<$buffer>. 1202 1203 use strict ; 1204 use warnings ; 1205 use IO::Compress::Zip qw(zip $ZipError) ; 1206 use IO::File ; 1207 1208 my $input = new IO::File "<file1.txt" 1209 or die "Cannot open 'file1.txt': $!\n" ; 1210 my $buffer ; 1211 zip $input => \$buffer 1212 or die "zip failed: $ZipError\n"; 1213 1214=head3 Compressing multiple files 1215 1216To create a zip file, C<output.zip>, that contains the compressed contents 1217of the files C<alpha.txt> and C<beta.txt> 1218 1219 use strict ; 1220 use warnings ; 1221 use IO::Compress::Zip qw(zip $ZipError) ; 1222 1223 zip [ 'alpha.txt', 'beta.txt' ] => 'output.zip' 1224 or die "zip failed: $ZipError\n"; 1225 1226Alternatively, rather than having to explicitly name each of the files that 1227you want to compress, you could use a fileglob to select all the C<txt> 1228files in the current directory, as follows 1229 1230 use strict ; 1231 use warnings ; 1232 use IO::Compress::Zip qw(zip $ZipError) ; 1233 1234 my @files = <*.txt>; 1235 zip \@files => 'output.zip' 1236 or die "zip failed: $ZipError\n"; 1237 1238or more succinctly 1239 1240 zip [ <*.txt> ] => 'output.zip' 1241 or die "zip failed: $ZipError\n"; 1242 1243=head1 OO Interface 1244 1245=head2 Constructor 1246 1247The format of the constructor for C<IO::Compress::Zip> is shown below 1248 1249 my $z = new IO::Compress::Zip $output [,OPTS] 1250 or die "IO::Compress::Zip failed: $ZipError\n"; 1251 1252It returns an C<IO::Compress::Zip> object on success and undef on failure. 1253The variable C<$ZipError> will contain an error message on failure. 1254 1255If you are running Perl 5.005 or better the object, C<$z>, returned from 1256IO::Compress::Zip can be used exactly like an L<IO::File|IO::File> filehandle. 1257This means that all normal output file operations can be carried out 1258with C<$z>. 1259For example, to write to a compressed file/buffer you can use either of 1260these forms 1261 1262 $z->print("hello world\n"); 1263 print $z "hello world\n"; 1264 1265The mandatory parameter C<$output> is used to control the destination 1266of the compressed data. This parameter can take one of these forms. 1267 1268=over 5 1269 1270=item A filename 1271 1272If the C<$output> parameter is a simple scalar, it is assumed to be a 1273filename. This file will be opened for writing and the compressed data 1274will be written to it. 1275 1276=item A filehandle 1277 1278If the C<$output> parameter is a filehandle, the compressed data will be 1279written to it. 1280The string '-' can be used as an alias for standard output. 1281 1282=item A scalar reference 1283 1284If C<$output> is a scalar reference, the compressed data will be stored 1285in C<$$output>. 1286 1287=back 1288 1289If the C<$output> parameter is any other type, C<IO::Compress::Zip>::new will 1290return undef. 1291 1292=head2 Constructor Options 1293 1294C<OPTS> is any combination of zero or more the following options: 1295 1296=over 5 1297 1298=item C<< AutoClose => 0|1 >> 1299 1300This option is only valid when the C<$output> parameter is a filehandle. If 1301specified, and the value is true, it will result in the C<$output> being 1302closed once either the C<close> method is called or the C<IO::Compress::Zip> 1303object is destroyed. 1304 1305This parameter defaults to 0. 1306 1307=item C<< Append => 0|1 >> 1308 1309Opens C<$output> in append mode. 1310 1311The behaviour of this option is dependent on the type of C<$output>. 1312 1313=over 5 1314 1315=item * A Buffer 1316 1317If C<$output> is a buffer and C<Append> is enabled, all compressed data 1318will be append to the end of C<$output>. Otherwise C<$output> will be 1319cleared before any data is written to it. 1320 1321=item * A Filename 1322 1323If C<$output> is a filename and C<Append> is enabled, the file will be 1324opened in append mode. Otherwise the contents of the file, if any, will be 1325truncated before any compressed data is written to it. 1326 1327=item * A Filehandle 1328 1329If C<$output> is a filehandle, the file pointer will be positioned to the 1330end of the file via a call to C<seek> before any compressed data is written 1331to it. Otherwise the file pointer will not be moved. 1332 1333=back 1334 1335This parameter defaults to 0. 1336 1337=back 1338 1339=head3 File Naming Options 1340 1341A quick bit of zip file terminology -- A zip archive consists of one or more I<archive members>, where each member has an associated 1342filename, known as the I<archive member name>. 1343 1344The options listed in this section control how the I<archive member name> (or filename) is stored the zip archive. 1345 1346=over 5 1347 1348=item C<< Name => $string >> 1349 1350This option is used to explicitly set the I<archive member name> in 1351the zip archive to C<$string>. 1352Most of the time you don't need to make use of this option. 1353By default when adding a filename to the zip archive, the I<archive member name> will match the filename. 1354 1355You should only need to use this option if you want the I<archive member name> 1356to be different from the uncompressed filename or when the input is a filehandle or a buffer. 1357 1358The default behaviour for what I<archive member name> is used when the C<Name> option 1359is I<not> specified depends on the form of the C<$input> parameter: 1360 1361=over 5 1362 1363=item * 1364 1365If the C<$input> parameter is a filename, the 1366value of C<$input> will be used for the I<archive member name> . 1367 1368=item * 1369If the C<$input> parameter is not a filename, 1370the I<archive member name> will be an empty string. 1371 1372=back 1373 1374Note that both the C<CanonicalName> and C<FilterName> options 1375can modify the value used for the I<archive member name>. 1376 1377Also note that you should set the C<Efs> option to true if you are working 1378with UTF8 filenames. 1379 1380=item C<< CanonicalName => 0|1 >> 1381 1382This option controls whether the I<archive member name> is 1383I<normalized> into Unix format before being written to the zip file. 1384 1385It is recommended that you enable this option unless you really need 1386to create a non-standard Zip file. 1387 1388This is what APPNOTE.TXT has to say on what should be stored in the zip 1389filename header field. 1390 1391 The name of the file, with optional relative path. 1392 The path stored should not contain a drive or 1393 device letter, or a leading slash. All slashes 1394 should be forward slashes '/' as opposed to 1395 backwards slashes '\' for compatibility with Amiga 1396 and UNIX file systems etc. 1397 1398This option defaults to B<false>. 1399 1400=item C<< FilterName => sub { ... } >> 1401 1402This option allow the I<archive member> name to be modified 1403before it is written to the zip file. 1404 1405This option takes a parameter that must be a reference to a sub. On entry 1406to the sub the C<$_> variable will contain the name to be filtered. If no 1407filename is available C<$_> will contain an empty string. 1408 1409The value of C<$_> when the sub returns will be used as the I<archive member name>. 1410 1411Note that if C<CanonicalName> is enabled, a 1412normalized filename will be passed to the sub. 1413 1414If you use C<FilterName> to modify the filename, it is your responsibility 1415to keep the filename in Unix format. 1416 1417Although this option can be used with the OO interface, it is of most use 1418with the one-shot interface. For example, the code below shows how 1419C<FilterName> can be used to remove the path component from a series of 1420filenames before they are stored in C<$zipfile>. 1421 1422 sub compressTxtFiles 1423 { 1424 my $zipfile = shift ; 1425 my $dir = shift ; 1426 1427 zip [ <$dir/*.txt> ] => $zipfile, 1428 FilterName => sub { s[^$dir/][] } ; 1429 } 1430 1431=item C<< Efs => 0|1 >> 1432 1433This option controls setting of the "Language Encoding Flag" (EFS) in the zip 1434archive. When set, the filename and comment fields for the zip archive MUST 1435be valid UTF-8. 1436 1437If the string used for the filename and/or comment is not valid UTF-8 when this option 1438is true, the script will die with a "wide character" error. 1439 1440Note that this option only works with Perl 5.8.4 or better. 1441 1442This option defaults to B<false>. 1443 1444=back 1445 1446=head3 Overall Zip Archive Structure 1447 1448=over 5 1449 1450=item C<< Minimal => 1|0 >> 1451 1452If specified, this option will disable the creation of all extra fields 1453in the zip local and central headers. So the C<exTime>, C<exUnix2>, 1454C<exUnixN>, C<ExtraFieldLocal> and C<ExtraFieldCentral> options will 1455be ignored. 1456 1457This parameter defaults to 0. 1458 1459=item C<< Stream => 0|1 >> 1460 1461This option controls whether the zip file/buffer output is created in 1462streaming mode. 1463 1464Note that when outputting to a file with streaming mode disabled (C<Stream> 1465is 0), the output file must be seekable. 1466 1467The default is 1. 1468 1469=item C<< Zip64 => 0|1 >> 1470 1471Create a Zip64 zip file/buffer. This option is used if you want 1472to store files larger than 4 Gig or store more than 64K files in a single 1473zip archive. 1474 1475C<Zip64> will be automatically set, as needed, if working with the one-shot 1476interface when the input is either a filename or a scalar reference. 1477 1478If you intend to manipulate the Zip64 zip files created with this module 1479using an external zip/unzip, make sure that it supports Zip64. 1480 1481In particular, if you are using Info-Zip you need to have zip version 3.x 1482or better to update a Zip64 archive and unzip version 6.x to read a zip64 1483archive. 1484 1485The default is 0. 1486 1487=back 1488 1489=head3 Deflate Compression Options 1490 1491=over 5 1492 1493=item -Level 1494 1495Defines the compression level used by zlib. The value should either be 1496a number between 0 and 9 (0 means no compression and 9 is maximum 1497compression), or one of the symbolic constants defined below. 1498 1499 Z_NO_COMPRESSION 1500 Z_BEST_SPEED 1501 Z_BEST_COMPRESSION 1502 Z_DEFAULT_COMPRESSION 1503 1504The default is Z_DEFAULT_COMPRESSION. 1505 1506Note, these constants are not imported by C<IO::Compress::Zip> by default. 1507 1508 use IO::Compress::Zip qw(:strategy); 1509 use IO::Compress::Zip qw(:constants); 1510 use IO::Compress::Zip qw(:all); 1511 1512=item -Strategy 1513 1514Defines the strategy used to tune the compression. Use one of the symbolic 1515constants defined below. 1516 1517 Z_FILTERED 1518 Z_HUFFMAN_ONLY 1519 Z_RLE 1520 Z_FIXED 1521 Z_DEFAULT_STRATEGY 1522 1523The default is Z_DEFAULT_STRATEGY. 1524 1525=back 1526 1527=head3 Bzip2 Compression Options 1528 1529=over 5 1530 1531=item C<< BlockSize100K => number >> 1532 1533Specify the number of 100K blocks bzip2 uses during compression. 1534 1535Valid values are from 1 to 9, where 9 is best compression. 1536 1537This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored 1538otherwise. 1539 1540The default is 1. 1541 1542=item C<< WorkFactor => number >> 1543 1544Specifies how much effort bzip2 should take before resorting to a slower 1545fallback compression algorithm. 1546 1547Valid values range from 0 to 250, where 0 means use the default value 30. 1548 1549This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored 1550otherwise. 1551 1552The default is 0. 1553 1554=back 1555 1556=head3 Lzma Compression Options 1557 1558=over 5 1559 1560=item C<< Preset => number >> 1561 1562Used to choose the LZMA compression preset. 1563 1564Valid values are 0-9 and C<LZMA_PRESET_DEFAULT>. 1565 15660 is the fastest compression with the lowest memory usage and the lowest 1567compression. 1568 15699 is the slowest compression with the highest memory usage but with the best 1570compression. 1571 1572This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored 1573otherwise. 1574 1575Defaults to C<LZMA_PRESET_DEFAULT> (6). 1576 1577=item C<< Extreme => 0|1 >> 1578 1579Makes LZMA compression a lot slower, but a small compression gain. 1580 1581This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored 1582otherwise. 1583 1584Defaults to 0. 1585 1586=back 1587 1588=head3 Other Options 1589 1590=over 5 1591 1592=item C<< Time => $number >> 1593 1594Sets the last modified time field in the zip header to $number. 1595 1596This field defaults to the time the C<IO::Compress::Zip> object was created 1597if this option is not specified and the C<$input> parameter is not a 1598filename. 1599 1600=item C<< ExtAttr => $attr >> 1601 1602This option controls the "external file attributes" field in the central 1603header of the zip file. This is a 4 byte field. 1604 1605If you are running a Unix derivative this value defaults to 1606 1607 0100644 << 16 1608 1609This should allow read/write access to any files that are extracted from 1610the zip file/buffer`. 1611 1612For all other systems it defaults to 0. 1613 1614=item C<< exTime => [$atime, $mtime, $ctime] >> 1615 1616This option expects an array reference with exactly three elements: 1617C<$atime>, C<mtime> and C<$ctime>. These correspond to the last access 1618time, last modification time and creation time respectively. 1619 1620It uses these values to set the extended timestamp field (ID is "UT") in 1621the local zip header using the three values, $atime, $mtime, $ctime. In 1622addition it sets the extended timestamp field in the central zip header 1623using C<$mtime>. 1624 1625If any of the three values is C<undef> that time value will not be used. 1626So, for example, to set only the C<$mtime> you would use this 1627 1628 exTime => [undef, $mtime, undef] 1629 1630If the C<Minimal> option is set to true, this option will be ignored. 1631 1632By default no extended time field is created. 1633 1634=item C<< exUnix2 => [$uid, $gid] >> 1635 1636This option expects an array reference with exactly two elements: C<$uid> 1637and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID 1638(GID) of the owner of the files respectively. 1639 1640When the C<exUnix2> option is present it will trigger the creation of a 1641Unix2 extra field (ID is "Ux") in the local zip header. This will be populated 1642with C<$uid> and C<$gid>. An empty Unix2 extra field will also 1643be created in the central zip header. 1644 1645Note - The UID & GID are stored as 16-bit 1646integers in the "Ux" field. Use C<< exUnixN >> if your UID or GID are 164732-bit. 1648 1649If the C<Minimal> option is set to true, this option will be ignored. 1650 1651By default no Unix2 extra field is created. 1652 1653=item C<< exUnixN => [$uid, $gid] >> 1654 1655This option expects an array reference with exactly two elements: C<$uid> 1656and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID 1657(GID) of the owner of the files respectively. 1658 1659When the C<exUnixN> option is present it will trigger the creation of a 1660UnixN extra field (ID is "ux") in both the local and central zip headers. 1661This will be populated with C<$uid> and C<$gid>. 1662The UID & GID are stored as 32-bit integers. 1663 1664If the C<Minimal> option is set to true, this option will be ignored. 1665 1666By default no UnixN extra field is created. 1667 1668=item C<< Comment => $comment >> 1669 1670Stores the contents of C<$comment> in the Central File Header of 1671the zip file. 1672 1673Set the C<Efs> option to true if you want to store a UTF8 comment. 1674 1675By default, no comment field is written to the zip file. 1676 1677=item C<< ZipComment => $comment >> 1678 1679Stores the contents of C<$comment> in the End of Central Directory record 1680of the zip file. 1681 1682By default, no comment field is written to the zip file. 1683 1684=item C<< Method => $method >> 1685 1686Controls which compression method is used. At present four compression 1687methods are supported, namely Store (no compression at all), Deflate, 1688Bzip2 and Lzma. 1689 1690The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2 and ZIP_CM_LZMA 1691are used to select the compression method. 1692 1693These constants are not imported by C<IO::Compress::Zip> by default. 1694 1695 use IO::Compress::Zip qw(:zip_method); 1696 use IO::Compress::Zip qw(:constants); 1697 use IO::Compress::Zip qw(:all); 1698 1699Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must 1700be installed. A fatal error will be thrown if you attempt to create Bzip2 1701content when C<IO::Compress::Bzip2> is not available. 1702 1703Note that to create Lzma content, the module C<IO::Compress::Lzma> must 1704be installed. A fatal error will be thrown if you attempt to create Lzma 1705content when C<IO::Compress::Lzma> is not available. 1706 1707The default method is ZIP_CM_DEFLATE. 1708 1709=item C<< TextFlag => 0|1 >> 1710 1711This parameter controls the setting of a bit in the zip central header. It 1712is used to signal that the data stored in the zip file/buffer is probably 1713text. 1714 1715In one-shot mode this flag will be set to true if the Perl C<-T> operator thinks 1716the file contains text. 1717 1718The default is 0. 1719 1720=item C<< ExtraFieldLocal => $data >> 1721 1722=item C<< ExtraFieldCentral => $data >> 1723 1724The C<ExtraFieldLocal> option is used to store additional metadata in the 1725local header for the zip file/buffer. The C<ExtraFieldCentral> does the 1726same for the matching central header. 1727 1728An extra field consists of zero or more subfields. Each subfield consists 1729of a two byte header followed by the subfield data. 1730 1731The list of subfields can be supplied in any of the following formats 1732 1733 ExtraFieldLocal => [$id1, $data1, 1734 $id2, $data2, 1735 ... 1736 ] 1737 1738 ExtraFieldLocal => [ [$id1 => $data1], 1739 [$id2 => $data2], 1740 ... 1741 ] 1742 1743 ExtraFieldLocal => { $id1 => $data1, 1744 $id2 => $data2, 1745 ... 1746 } 1747 1748Where C<$id1>, C<$id2> are two byte subfield ID's. 1749 1750If you use the hash syntax, you have no control over the order in which 1751the ExtraSubFields are stored, plus you cannot have SubFields with 1752duplicate ID. 1753 1754Alternatively the list of subfields can by supplied as a scalar, thus 1755 1756 ExtraField => $rawdata 1757 1758In this case C<IO::Compress::Zip> will check that C<$rawdata> consists of 1759zero or more conformant sub-fields. 1760 1761The Extended Time field (ID "UT"), set using the C<exTime> option, and the 1762Unix2 extra field (ID "Ux), set using the C<exUnix2> option, are examples 1763of extra fields. 1764 1765If the C<Minimal> option is set to true, this option will be ignored. 1766 1767The maximum size of an extra field 65535 bytes. 1768 1769=item C<< Strict => 0|1 >> 1770 1771This is a placeholder option. 1772 1773=back 1774 1775=head2 Examples 1776 1777TODO 1778 1779=head1 Methods 1780 1781=head2 print 1782 1783Usage is 1784 1785 $z->print($data) 1786 print $z $data 1787 1788Compresses and outputs the contents of the C<$data> parameter. This 1789has the same behaviour as the C<print> built-in. 1790 1791Returns true if successful. 1792 1793=head2 printf 1794 1795Usage is 1796 1797 $z->printf($format, $data) 1798 printf $z $format, $data 1799 1800Compresses and outputs the contents of the C<$data> parameter. 1801 1802Returns true if successful. 1803 1804=head2 syswrite 1805 1806Usage is 1807 1808 $z->syswrite $data 1809 $z->syswrite $data, $length 1810 $z->syswrite $data, $length, $offset 1811 1812Compresses and outputs the contents of the C<$data> parameter. 1813 1814Returns the number of uncompressed bytes written, or C<undef> if 1815unsuccessful. 1816 1817=head2 write 1818 1819Usage is 1820 1821 $z->write $data 1822 $z->write $data, $length 1823 $z->write $data, $length, $offset 1824 1825Compresses and outputs the contents of the C<$data> parameter. 1826 1827Returns the number of uncompressed bytes written, or C<undef> if 1828unsuccessful. 1829 1830=head2 flush 1831 1832Usage is 1833 1834 $z->flush; 1835 $z->flush($flush_type); 1836 1837Flushes any pending compressed data to the output file/buffer. 1838 1839This method takes an optional parameter, C<$flush_type>, that controls 1840how the flushing will be carried out. By default the C<$flush_type> 1841used is C<Z_FINISH>. Other valid values for C<$flush_type> are 1842C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is 1843strongly recommended that you only set the C<flush_type> parameter if 1844you fully understand the implications of what it does - overuse of C<flush> 1845can seriously degrade the level of compression achieved. See the C<zlib> 1846documentation for details. 1847 1848Returns true on success. 1849 1850=head2 tell 1851 1852Usage is 1853 1854 $z->tell() 1855 tell $z 1856 1857Returns the uncompressed file offset. 1858 1859=head2 eof 1860 1861Usage is 1862 1863 $z->eof(); 1864 eof($z); 1865 1866Returns true if the C<close> method has been called. 1867 1868=head2 seek 1869 1870 $z->seek($position, $whence); 1871 seek($z, $position, $whence); 1872 1873Provides a sub-set of the C<seek> functionality, with the restriction 1874that it is only legal to seek forward in the output file/buffer. 1875It is a fatal error to attempt to seek backward. 1876 1877Empty parts of the file/buffer will have NULL (0x00) bytes written to them. 1878 1879The C<$whence> parameter takes one the usual values, namely SEEK_SET, 1880SEEK_CUR or SEEK_END. 1881 1882Returns 1 on success, 0 on failure. 1883 1884=head2 binmode 1885 1886Usage is 1887 1888 $z->binmode 1889 binmode $z ; 1890 1891This is a noop provided for completeness. 1892 1893=head2 opened 1894 1895 $z->opened() 1896 1897Returns true if the object currently refers to a opened file/buffer. 1898 1899=head2 autoflush 1900 1901 my $prev = $z->autoflush() 1902 my $prev = $z->autoflush(EXPR) 1903 1904If the C<$z> object is associated with a file or a filehandle, this method 1905returns the current autoflush setting for the underlying filehandle. If 1906C<EXPR> is present, and is non-zero, it will enable flushing after every 1907write/print operation. 1908 1909If C<$z> is associated with a buffer, this method has no effect and always 1910returns C<undef>. 1911 1912B<Note> that the special variable C<$|> B<cannot> be used to set or 1913retrieve the autoflush setting. 1914 1915=head2 input_line_number 1916 1917 $z->input_line_number() 1918 $z->input_line_number(EXPR) 1919 1920This method always returns C<undef> when compressing. 1921 1922=head2 fileno 1923 1924 $z->fileno() 1925 fileno($z) 1926 1927If the C<$z> object is associated with a file or a filehandle, C<fileno> 1928will return the underlying file descriptor. Once the C<close> method is 1929called C<fileno> will return C<undef>. 1930 1931If the C<$z> object is associated with a buffer, this method will return 1932C<undef>. 1933 1934=head2 close 1935 1936 $z->close() ; 1937 close $z ; 1938 1939Flushes any pending compressed data and then closes the output file/buffer. 1940 1941For most versions of Perl this method will be automatically invoked if 1942the IO::Compress::Zip object is destroyed (either explicitly or by the 1943variable with the reference to the object going out of scope). The 1944exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In 1945these cases, the C<close> method will be called automatically, but 1946not until global destruction of all live objects when the program is 1947terminating. 1948 1949Therefore, if you want your scripts to be able to run on all versions 1950of Perl, you should call C<close> explicitly and not rely on automatic 1951closing. 1952 1953Returns true on success, otherwise 0. 1954 1955If the C<AutoClose> option has been enabled when the IO::Compress::Zip 1956object was created, and the object is associated with a file, the 1957underlying file will also be closed. 1958 1959=head2 newStream([OPTS]) 1960 1961Usage is 1962 1963 $z->newStream( [OPTS] ) 1964 1965Closes the current compressed data stream and starts a new one. 1966 1967OPTS consists of any of the options that are available when creating 1968the C<$z> object. 1969 1970See the L</"Constructor Options"> section for more details. 1971 1972=head2 deflateParams 1973 1974Usage is 1975 1976 $z->deflateParams 1977 1978TODO 1979 1980=head1 Importing 1981 1982A number of symbolic constants are required by some methods in 1983C<IO::Compress::Zip>. None are imported by default. 1984 1985=over 5 1986 1987=item :all 1988 1989Imports C<zip>, C<$ZipError> and all symbolic 1990constants that can be used by C<IO::Compress::Zip>. Same as doing this 1991 1992 use IO::Compress::Zip qw(zip $ZipError :constants) ; 1993 1994=item :constants 1995 1996Import all symbolic constants. Same as doing this 1997 1998 use IO::Compress::Zip qw(:flush :level :strategy :zip_method) ; 1999 2000=item :flush 2001 2002These symbolic constants are used by the C<flush> method. 2003 2004 Z_NO_FLUSH 2005 Z_PARTIAL_FLUSH 2006 Z_SYNC_FLUSH 2007 Z_FULL_FLUSH 2008 Z_FINISH 2009 Z_BLOCK 2010 2011=item :level 2012 2013These symbolic constants are used by the C<Level> option in the constructor. 2014 2015 Z_NO_COMPRESSION 2016 Z_BEST_SPEED 2017 Z_BEST_COMPRESSION 2018 Z_DEFAULT_COMPRESSION 2019 2020=item :strategy 2021 2022These symbolic constants are used by the C<Strategy> option in the constructor. 2023 2024 Z_FILTERED 2025 Z_HUFFMAN_ONLY 2026 Z_RLE 2027 Z_FIXED 2028 Z_DEFAULT_STRATEGY 2029 2030=item :zip_method 2031 2032These symbolic constants are used by the C<Method> option in the 2033constructor. 2034 2035 ZIP_CM_STORE 2036 ZIP_CM_DEFLATE 2037 ZIP_CM_BZIP2 2038 2039=back 2040 2041=head1 EXAMPLES 2042 2043=head2 Apache::GZip Revisited 2044 2045See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> 2046 2047=head2 Working with Net::FTP 2048 2049See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> 2050 2051=head1 SUPPORT 2052 2053General feedback/questions/bug reports should be sent to 2054L<https://github.com/pmqs/IO-Compress/issues> (preferred) or 2055L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress>. 2056 2057=head1 SEE ALSO 2058 2059L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzip>, L<IO::Uncompress::UnLzip>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Compress::Zstd>, L<IO::Uncompress::UnZstd>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> 2060 2061L<IO::Compress::FAQ|IO::Compress::FAQ> 2062 2063L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, 2064L<Archive::Tar|Archive::Tar>, 2065L<IO::Zlib|IO::Zlib> 2066 2067For RFC 1950, 1951 and 1952 see 2068L<http://www.faqs.org/rfcs/rfc1950.html>, 2069L<http://www.faqs.org/rfcs/rfc1951.html> and 2070L<http://www.faqs.org/rfcs/rfc1952.html> 2071 2072The I<zlib> compression library was written by Jean-loup Gailly 2073C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>. 2074 2075The primary site for the I<zlib> compression library is 2076L<http://www.zlib.org>. 2077 2078The primary site for gzip is L<http://www.gzip.org>. 2079 2080=head1 AUTHOR 2081 2082This module was written by Paul Marquess, C<pmqs@cpan.org>. 2083 2084=head1 MODIFICATION HISTORY 2085 2086See the Changes file. 2087 2088=head1 COPYRIGHT AND LICENSE 2089 2090Copyright (c) 2005-2019 Paul Marquess. All rights reserved. 2091 2092This program is free software; you can redistribute it and/or 2093modify it under the same terms as Perl itself. 2094 2095