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