ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm

   1 package IO::Compress::Zip ;
   2
   3 use strict ;
   4 use warnings;
   5 use bytes;
   6
   7 use IO::Compress::Base::Common qw(:Status createSelfTiedObject);
   8 use IO::Compress::RawDeflate;
   9 use IO::Compress::Adapter::Deflate;
  10 use IO::Compress::Adapter::Identity;
  11 use IO::Compress::Zip::Constants;
  12
  13
  14 use Compress::Raw::Zlib qw(crc32) ;
  15 BEGIN
  16 {
  17     eval { require IO::Compress::Adapter::Bzip2;
  18            import  IO::Compress::Adapter::Bzip2;
  19            require IO::Compress::Bzip2;
  20            import  IO::Compress::Bzip2;
  21          } ;
  22 }
  23
  24
  25 require Exporter ;
  26
  27 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError);
  28
  29 $VERSION = '2.000_12';
  30 $ZipError = '';
  31
  32 @ISA = qw(Exporter IO::Compress::RawDeflate);
  33 @EXPORT_OK = qw( $ZipError zip ) ;
  34 %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
  35 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  36
  37 $EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 )];
  38 push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };
  39
  40 Exporter::export_ok_tags('all');
  41
  42 sub new
  43 {
  44     my $class = shift ;
  45
  46     my $obj = createSelfTiedObject($class, \$ZipError);
  47     $obj->_create(undef, @_);
  48 }
  49
  50 sub zip
  51 {
  52     my $obj = createSelfTiedObject(undef, \$ZipError);
  53     return $obj->_def(@_);
  54 }
  55
  56 sub mkComp
  57 {
  58     my $self = shift ;
  59     my $class = shift ;
  60     my $got = shift ;
  61
  62     my ($obj, $errstr, $errno) ;
  63
  64     if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
  65         ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
  66                                                  $got->value('Level'),
  67                                                  $got->value('Strategy')
  68                                                  );
  69     }
  70     elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
  71         ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
  72                                                  $got->value('CRC32'),
  73                                                  $got->value('Adler32'),
  74                                                  $got->value('Level'),
  75                                                  $got->value('Strategy')
  76                                                  );
  77     }
  78     elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
  79         ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
  80                                                 $got->value('BlockSize100K'),
  81                                                 $got->value('WorkFactor'),
  82                                                 $got->value('Verbosity')
  83                                                );
  84         *$self->{ZipData}{CRC32} = crc32(undef);
  85     }
  86
  87     return $self->saveErrorString(undef, $errstr, $errno)
  88        if ! defined $obj;
  89
  90     if (! defined *$self->{ZipData}{StartOffset}) {
  91         *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} = 0;
  92     }
  93
  94     return $obj;
  95 }
  96
  97 sub reset
  98 {
  99     my $self = shift ;
 100
 101     *$self->{Compress}->reset();
 102     *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32('');
 103
 104     return STATUS_OK;
 105 }
 106
 107 sub filterUncompressed
 108 {
 109     my $self = shift ;
 110
 111     if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
 112         *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
 113     }
 114     else {
 115         *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32});
 116
 117     }
 118 }
 119
 120 sub mkHeader
 121 {
 122     my $self  = shift;
 123     my $param = shift ;
 124
 125     *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} ;
 126
 127     my $filename = '';
 128     $filename = $param->value('Name') || '';
 129
 130     my $comment = '';
 131     $comment = $param->value('Comment') || '';
 132
 133     my $hdr = '';
 134
 135     my $time = _unixToDosTime($param->value('Time'));
 136
 137     my $extra = '';
 138     my $ctlExtra = '';
 139
 140     if (! $param->value('Minimal')) {
 141         if (defined $param->value('exTime'))
 142         {
 143             $extra .= mkExtendedTime($param->value('MTime'),
 144                                     $param->value('ATime'),
 145                                     $param->value('CTime'));
 146
 147             $ctlExtra .= mkExtendedTime($param->value('MTime'));
 148         }
 149
 150     #    if ( $param->value('UID'))
 151     #    {
 152     #        $extra    .= mkUnixExtra( $param->value('UID'), $param->value('GID'));
 153     #        $ctlExtra .= mkUnixExtra();
 154     #    }
 155
 156         $extra .= $param->value('ExtraFieldLocal')
 157             if defined $param->value('ExtraFieldLocal');
 158
 159         $ctlExtra .= $param->value('ExtraFieldCentral')
 160             if defined $param->value('ExtraFieldCentral');
 161     }
 162
 163     my $extAttr = 0;
 164     $extAttr = $param->value('Mode') << 16
 165         if defined $param->value('Mode') ;
 166
 167     my $gpFlag = 0 ;
 168     $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK
 169         if *$self->{ZipData}{Stream} ;
 170
 171     my $method = *$self->{ZipData}{Method} ;
 172
 173     # deflate is 20
 174     # bzip2 is 46
 175     my $madeBy = ($param->value('OS_Code') << 8) +
 176                     $ZIP_CM_MIN_VERSIONS{$method};
 177     my $extract = $ZIP_CM_MIN_VERSIONS{$method};
 178
 179     my $ifa = 0;
 180     $ifa |= ZIP_IFA_TEXT_MASK
 181         if $param->value('TextFlag');
 182
 183     $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
 184     $hdr .= pack 'v', $extract   ; # extract Version & OS
 185     $hdr .= pack 'v', $gpFlag    ; # general purpose flag (set streaming mode)
 186     $hdr .= pack 'v', $method    ; # compression method (deflate)
 187     $hdr .= pack 'V', $time      ; # last mod date/time
 188     $hdr .= pack 'V', 0          ; # crc32               - 0 when streaming
 189     $hdr .= pack 'V', 0          ; # compressed length   - 0 when streaming
 190     $hdr .= pack 'V', 0          ; # uncompressed length - 0 when streaming
 191     $hdr .= pack 'v', length $filename ; # filename length
 192     $hdr .= pack 'v', length $extra ; # extra length
 193
 194     $hdr .= $filename ;
 195     $hdr .= $extra ;
 196
 197
 198     my $ctl = '';
 199
 200     $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
 201     $ctl .= pack 'v', $madeBy    ; # version made by
 202     $ctl .= pack 'v', $extract   ; # extract Version
 203     $ctl .= pack 'v', $gpFlag    ; # general purpose flag (streaming mode)
 204     $ctl .= pack 'v', $method    ; # compression method (deflate)
 205     $ctl .= pack 'V', $time      ; # last mod date/time
 206     $ctl .= pack 'V', 0          ; # crc32
 207     $ctl .= pack 'V', 0          ; # compressed length
 208     $ctl .= pack 'V', 0          ; # uncompressed length
 209     $ctl .= pack 'v', length $filename ; # filename length
 210     $ctl .= pack 'v', length $ctlExtra ; # extra length
 211     $ctl .= pack 'v', length $comment ;  # file comment length
 212     $ctl .= pack 'v', 0          ; # disk number start
 213     $ctl .= pack 'v', $ifa       ; # internal file attributes
 214     $ctl .= pack 'V', $extAttr   ; # external file attributes
 215     $ctl .= pack 'V', *$self->{ZipData}{Offset}  ; # offset to local header
 216
 217     $ctl .= $filename ;
 218     $ctl .= $ctlExtra ;
 219     $ctl .= $comment ;
 220
 221     *$self->{ZipData}{Offset} += length $hdr ;
 222
 223     *$self->{ZipData}{CentralHeader} = $ctl;
 224
 225     return $hdr;
 226 }
 227
 228 sub mkTrailer
 229 {
 230     my $self = shift ;
 231
 232     my $crc32 ;
 233     if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
 234         $crc32 = *$self->{Compress}->crc32();
 235     }
 236     else {
 237         $crc32 = *$self->{ZipData}{CRC32};
 238     }
 239
 240     my $compressedBytes   = *$self->{Compress}->compressedBytes();
 241     my $uncompressedBytes = *$self->{Compress}->uncompressedBytes();
 242
 243     my $data ;
 244     $data .= pack "V", $crc32 ;                           # CRC32
 245     $data .= pack "V", $compressedBytes   ;               # Compressed Size
 246     $data .= pack "V", $uncompressedBytes;                # Uncompressed Size
 247
 248     my $hdr = '';
 249
 250     if (*$self->{ZipData}{Stream}) {
 251         $hdr  = pack "V", ZIP_DATA_HDR_SIG ;                       # signature
 252         $hdr .= $data ;
 253     }
 254     else {
 255         $self->writeAt(*$self->{ZipData}{StartOffset} + 14, $data)
 256             or return undef;
 257     }
 258
 259     my $ctl = *$self->{ZipData}{CentralHeader} ;
 260     substr($ctl, 16, 12) = $data ;
 261
 262     *$self->{ZipData}{Offset} += length($hdr) + $compressedBytes;
 263     push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
 264
 265     return $hdr;
 266 }
 267
 268 sub mkFinalTrailer
 269 {
 270     my $self = shift ;
 271
 272     my $comment = '';
 273     $comment = *$self->{ZipData}{ZipComment} ;
 274
 275     my $entries = @{ *$self->{ZipData}{CentralDir} };
 276     my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
 277
 278     my $ecd = '';
 279     $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
 280     $ecd .= pack 'v', 0          ; # number of disk
 281     $ecd .= pack 'v', 0          ; # number if disk with central dir
 282     $ecd .= pack 'v', $entries   ; # entries in central dir on this disk
 283     $ecd .= pack 'v', $entries   ; # entries in central dir
 284     $ecd .= pack 'V', length $cd ; # size of central dir
 285     $ecd .= pack 'V', *$self->{ZipData}{Offset} ; # offset to start central dir
 286     $ecd .= pack 'v', length $comment ; # zipfile comment length
 287     $ecd .= $comment;
 288
 289     return $cd . $ecd ;
 290 }
 291
 292 sub ckParams
 293 {
 294     my $self = shift ;
 295     my $got = shift;
 296
 297     $got->value('CRC32' => 1);
 298
 299     if (! $got->parsed('Time') ) {
 300         # Modification time defaults to now.
 301         $got->value('Time' => time) ;
 302     }
 303
 304     if (! $got->parsed('exTime') ) {
 305         my $timeRef = $got->value('exTime');
 306         if ( defined $timeRef) {
 307             return $self->saveErrorString(undef, "exTime not a 3-element array ref")
 308                 if ref $timeRef ne 'ARRAY' || @$timeRef != 3;
 309         }
 310
 311         $got->value("MTime", $timeRef->[1]);
 312         $got->value("ATime", $timeRef->[0]);
 313         $got->value("CTime", $timeRef->[2]);
 314     }
 315
 316     *$self->{ZipData}{Stream} = $got->value('Stream');
 317
 318     my $method = $got->value('Method');
 319     return $self->saveErrorString(undef, "Unknown Method '$method'")
 320         if ! defined $ZIP_CM_MIN_VERSIONS{$method};
 321
 322     return $self->saveErrorString(undef, "Bzip2 not available")
 323         if $method == ZIP_CM_BZIP2 and
 324            ! defined $IO::Compress::Adapter::Bzip2::VERSION;
 325
 326     *$self->{ZipData}{Method} = $method;
 327
 328     *$self->{ZipData}{ZipComment} = $got->value('ZipComment') ;
 329
 330     for my $name (qw( ExtraFieldLocal ExtraFieldCentral ))
 331     {
 332         my $data = $got->value($name) ;
 333         if (defined $data) {
 334             my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ;
 335             return $self->saveErrorString(undef, "Error with $name Parameter: $bad")
 336                 if $bad ;
 337
 338             $got->value($name, $data) ;
 339         }
 340     }
 341
 342     return undef
 343         if defined $IO::Compress::Bzip2::VERSION
 344             and ! IO::Compress::Bzip2::ckParams($self, $got);
 345
 346     return 1 ;
 347 }
 348
 349 #sub newHeader
 350 #{
 351 #    my $self = shift ;
 352 #
 353 #    return $self->mkHeader(*$self->{Got});
 354 #}
 355
 356 sub getExtraParams
 357 {
 358     my $self = shift ;
 359
 360     use IO::Compress::Base::Common qw(:Parse);
 361     use Compress::Raw::Zlib qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
 362
 363     my @Bzip2 = ();
 364
 365     @Bzip2 = IO::Compress::Bzip2::getExtraParams($self)
 366         if defined $IO::Compress::Bzip2::VERSION;
 367
 368     return (
 369             # zlib behaviour
 370             $self->getZlibParams(),
 371
 372             'Stream'    => [1, 1, Parse_boolean,   1],
 373            #'Store'     => [0, 1, Parse_boolean,   0],
 374             'Method'    => [0, 1, Parse_unsigned,  ZIP_CM_DEFLATE],
 375
 376 #            # Zip header fields
 377             'Minimal'   => [0, 1, Parse_boolean,   0],
 378             'Comment'   => [0, 1, Parse_any,       ''],
 379             'ZipComment'=> [0, 1, Parse_any,       ''],
 380             'Name'      => [0, 1, Parse_any,       ''],
 381             'Time'      => [0, 1, Parse_any,       undef],
 382             'exTime'    => [0, 1, Parse_any,       undef],
 383             'OS_Code'   => [0, 1, Parse_unsigned,  $Compress::Raw::Zlib::gzip_os_code],
 384
 385            'TextFlag'  => [0, 1, Parse_boolean,   0],
 386            'ExtraFieldLocal'  => [0, 1, Parse_any,    undef],
 387            'ExtraFieldCentral'=> [0, 1, Parse_any,    undef],
 388
 389             @Bzip2,
 390         );
 391 }
 392
 393 sub getInverseClass
 394 {
 395     return ('IO::Uncompress::Unzip',
 396                 \$IO::Uncompress::Unzip::UnzipError);
 397 }
 398
 399 sub getFileInfo
 400 {
 401     my $self = shift ;
 402     my $params = shift;
 403     my $filename = shift ;
 404
 405     my ($mode, $uid, $gid, $atime, $mtime, $ctime)
 406                 = (stat($filename))[2, 4,5, 8,9,10] ;
 407
 408     $params->value('Name' => $filename)
 409         if ! $params->parsed('Name') ;
 410
 411     $params->value('Time' => $mtime)
 412         if ! $params->parsed('Time') ;
 413
 414     if ( ! $params->parsed('exTime'))
 415     {
 416         $params->value('MTime' => $mtime) ;
 417         $params->value('ATime' => $atime) ;
 418         $params->value('CTime' => $ctime) ;
 419     }
 420
 421     $params->value('Mode' => $mode) ;
 422
 423     $params->value('UID' => $uid) ;
 424     $params->value('GID' => $gid) ;
 425
 426 }
 427
 428 sub mkExtendedTime
 429 {
 430     # order expected is m, a, c
 431
 432     my $times = '';
 433     my $bit = 1 ;
 434     my $flags = 0;
 435
 436     for my $time (@_)
 437     {
 438         if (defined $time)
 439         {
 440             $flags |= $bit;
 441             $times .= pack("V", $time);
 442         }
 443
 444         $bit <<= 1 ;
 445     }
 446
 447     #return "UT" . pack("v C", length($times) + 1, $flags) . $times;
 448     return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_EXT_TIMESTAMP,
 449                                                  pack("C", $flags) .  $times);
 450 }
 451
 452 sub mkUnixExtra
 453 {
 454     my $ids = '';
 455     for my $id (@_)
 456     {
 457         $ids .= pack("v", $id);
 458     }
 459
 460     #return "Ux" . pack("v", length $ids) . $ids;
 461     return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIX, $ids);
 462 }
 463
 464
 465 # from Archive::Zip
 466 sub _unixToDosTime    # Archive::Zip::Member
 467 {
 468         my $time_t = shift;
 469     # TODO - add something to cope with unix time < 1980
 470         my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t);
 471         my $dt = 0;
 472         $dt += ( $sec >> 1 );
 473         $dt += ( $min << 5 );
 474         $dt += ( $hour << 11 );
 475         $dt += ( $mday << 16 );
 476         $dt += ( ( $mon + 1 ) << 21 );
 477         $dt += ( ( $year - 80 ) << 25 );
 478         return $dt;
 479 }
 480
 481 1;
 482
 483 __END__
 484
 485 =head1 NAME
 486
 487
 488
 489 IO::Compress::Zip - Write zip files/buffers
 490
 491
 492
 493 =head1 SYNOPSIS
 494
 495     use IO::Compress::Zip qw(zip $ZipError) ;
 496
 497
 498     my $status = zip $input => $output [,OPTS]
 499         or die "zip failed: $ZipError\n";
 500
 501     my $z = new IO::Compress::Zip $output [,OPTS]
 502         or die "zip failed: $ZipError\n";
 503
 504     $z->print($string);
 505     $z->printf($format, $string);
 506     $z->write($string);
 507     $z->syswrite($string [, $length, $offset]);
 508     $z->flush();
 509     $z->tell();
 510     $z->eof();
 511     $z->seek($position, $whence);
 512     $z->binmode();
 513     $z->fileno();
 514     $z->opened();
 515     $z->autoflush();
 516     $z->input_line_number();
 517     $z->newStream( [OPTS] );
 518
 519     $z->deflateParams();
 520
 521     $z->close() ;
 522
 523     $ZipError ;
 524
 525     # IO::File mode
 526
 527     print $z $string;
 528     printf $z $format, $string;
 529     tell $z
 530     eof $z
 531     seek $z, $position, $whence
 532     binmode $z
 533     fileno $z
 534     close $z ;
 535
 536
 537 =head1 DESCRIPTION
 538
 539
 540
 541 B<WARNING -- This is a Beta release>.
 542
 543 =over 5
 544
 545 =item * DO NOT use in production code.
 546
 547 =item * The documentation is incomplete in places.
 548
 549 =item * Parts of the interface defined here are tentative.
 550
 551 =item * Please report any problems you find.
 552
 553 =back
 554
 555
 556
 557
 558 This module provides a Perl interface that allows writing zip
 559 compressed data to files or buffer.
 560
 561
 562
 563
 564
 565
 566
 567 Note that IO::Compress::Zip is not intended to be a replacement for the module
 568 C<Archive::Zip>.
 569
 570 The primary aim of this module is not as an archiver, but to provide
 571 streaming write access to zip file files and buffers.
 572
 573
 574
 575 For reading zip files/buffers, see the companion module
 576 L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>.
 577
 578
 579 =head1 Functional Interface
 580
 581 A top-level function, C<zip>, is provided to carry out
 582 "one-shot" compression between buffers and/or files. For finer
 583 control over the compression process, see the L</"OO Interface">
 584 section.
 585
 586     use IO::Compress::Zip qw(zip $ZipError) ;
 587
 588     zip $input => $output [,OPTS]
 589         or die "zip failed: $ZipError\n";
 590
 591
 592
 593 The functional interface needs Perl5.005 or better.
 594
 595
 596 =head2 zip $input => $output [, OPTS]
 597
 598
 599 C<zip> expects at least two parameters, C<$input> and C<$output>.
 600
 601 =head3 The C<$input> parameter
 602
 603 The parameter, C<$input>, is used to define the source of
 604 the uncompressed data.
 605
 606 It can take one of the following forms:
 607
 608 =over 5
 609
 610 =item A filename
 611
 612 If the C<$input> parameter is a simple scalar, it is assumed to be a
 613 filename. This file will be opened for reading and the input data
 614 will be read from it.
 615
 616 =item A filehandle
 617
 618 If the C<$input> parameter is a filehandle, the input data will be
 619 read from it.
 620 The string '-' can be used as an alias for standard input.
 621
 622 =item A scalar reference
 623
 624 If C<$input> is a scalar reference, the input data will be read
 625 from C<$$input>.
 626
 627 =item An array reference
 628
 629 If C<$input> is an array reference, each element in the array must be a
 630 filename.
 631
 632 The input data will be read from each file in turn.
 633
 634 The complete array will be walked to ensure that it only
 635 contains valid filenames before any data is compressed.
 636
 637
 638
 639 =item An Input FileGlob string
 640
 641 If C<$input> is a string that is delimited by the characters "<" and ">"
 642 C<zip> will assume that it is an I<input fileglob string>. The
 643 input is the list of files that match the fileglob.
 644
 645 If the fileglob does not match any files ...
 646
 647 See L<File::GlobMapper|File::GlobMapper> for more details.
 648
 649
 650 =back
 651
 652 If the C<$input> parameter is any other type, C<undef> will be returned.
 653
 654
 655 In addition, if C<$input> is a simple filename, the default values for
 656 the C<Name>, C<Time> and C<exTime> options will be sourced from that file.
 657
 658 If you do not want to use these defaults they can be overridden by
 659 explicitly setting the C<Name>, C<Time> and C<exTime> options or by setting the
 660 C<Minimal> parameter.
 661
 662
 663
 664 =head3 The C<$output> parameter
 665
 666 The parameter C<$output> is used to control the destination of the
 667 compressed data. This parameter can take one of these forms.
 668
 669 =over 5
 670
 671 =item A filename
 672
 673 If the C<$output> parameter is a simple scalar, it is assumed to be a
 674 filename.  This file will be opened for writing and the compressed
 675 data will be written to it.
 676
 677 =item A filehandle
 678
 679 If the C<$output> parameter is a filehandle, the compressed data
 680 will be written to it.
 681 The string '-' can be used as an alias for standard output.
 682
 683
 684 =item A scalar reference
 685
 686 If C<$output> is a scalar reference, the compressed data will be
 687 stored in C<$$output>.
 688
 689
 690
 691 =item An Array Reference
 692
 693 If C<$output> is an array reference, the compressed data will be
 694 pushed onto the array.
 695
 696 =item An Output FileGlob
 697
 698 If C<$output> is a string that is delimited by the characters "<" and ">"
 699 C<zip> will assume that it is an I<output fileglob string>. The
 700 output is the list of files that match the fileglob.
 701
 702 When C<$output> is an fileglob string, C<$input> must also be a fileglob
 703 string. Anything else is an error.
 704
 705 =back
 706
 707 If the C<$output> parameter is any other type, C<undef> will be returned.
 708
 709
 710
 711 =head2 Notes
 712
 713
 714
 715 When C<$input> maps to multiple files/buffers and C<$output> is a single
 716 file/buffer the input files/buffers will each be stored
 717 in C<$output> as a distinct entry.
 718
 719
 720
 721
 722
 723
 724 =head2 Optional Parameters
 725
 726 Unless specified below, the optional parameters for C<zip>,
 727 C<OPTS>, are the same as those used with the OO interface defined in the
 728 L</"Constructor Options"> section below.
 729
 730 =over 5
 731
 732 =item AutoClose =E<gt> 0|1
 733
 734 This option applies to any input or output data streams to
 735 C<zip> that are filehandles.
 736
 737 If C<AutoClose> is specified, and the value is true, it will result in all
 738 input and/or output filehandles being closed once C<zip> has
 739 completed.
 740
 741 This parameter defaults to 0.
 742
 743
 744
 745 =item BinModeIn =E<gt> 0|1
 746
 747 When reading from a file or filehandle, set C<binmode> before reading.
 748
 749 Defaults to 0.
 750
 751
 752
 753
 754
 755 =item -Append =E<gt> 0|1
 756
 757 TODO
 758
 759
 760 =back
 761
 762
 763
 764 =head2 Examples
 765
 766 To read the contents of the file C<file1.txt> and write the compressed
 767 data to the file C<file1.txt.zip>.
 768
 769     use strict ;
 770     use warnings ;
 771     use IO::Compress::Zip qw(zip $ZipError) ;
 772
 773     my $input = "file1.txt";
 774     zip $input => "$input.zip"
 775         or die "zip failed: $ZipError\n";
 776
 777
 778 To read from an existing Perl filehandle, C<$input>, and write the
 779 compressed data to a buffer, C<$buffer>.
 780
 781     use strict ;
 782     use warnings ;
 783     use IO::Compress::Zip qw(zip $ZipError) ;
 784     use IO::File ;
 785
 786     my $input = new IO::File "<file1.txt"
 787         or die "Cannot open 'file1.txt': $!\n" ;
 788     my $buffer ;
 789     zip $input => \$buffer
 790         or die "zip failed: $ZipError\n";
 791
 792 To compress all files in the directory "/my/home" that match "*.txt"
 793 and store the compressed data in the same directory
 794
 795     use strict ;
 796     use warnings ;
 797     use IO::Compress::Zip qw(zip $ZipError) ;
 798
 799     zip '</my/home/*.txt>' => '<*.zip>'
 800         or die "zip failed: $ZipError\n";
 801
 802 and if you want to compress each file one at a time, this will do the trick
 803
 804     use strict ;
 805     use warnings ;
 806     use IO::Compress::Zip qw(zip $ZipError) ;
 807
 808     for my $input ( glob "/my/home/*.txt" )
 809     {
 810         my $output = "$input.zip" ;
 811         zip $input => $output
 812             or die "Error compressing '$input': $ZipError\n";
 813     }
 814
 815
 816 =head1 OO Interface
 817
 818 =head2 Constructor
 819
 820 The format of the constructor for C<IO::Compress::Zip> is shown below
 821
 822     my $z = new IO::Compress::Zip $output [,OPTS]
 823         or die "IO::Compress::Zip failed: $ZipError\n";
 824
 825 It returns an C<IO::Compress::Zip> object on success and undef on failure.
 826 The variable C<$ZipError> will contain an error message on failure.
 827
 828 If you are running Perl 5.005 or better the object, C<$z>, returned from
 829 IO::Compress::Zip can be used exactly like an L<IO::File|IO::File> filehandle.
 830 This means that all normal output file operations can be carried out
 831 with C<$z>.
 832 For example, to write to a compressed file/buffer you can use either of
 833 these forms
 834
 835     $z->print("hello world\n");
 836     print $z "hello world\n";
 837
 838 The mandatory parameter C<$output> is used to control the destination
 839 of the compressed data. This parameter can take one of these forms.
 840
 841 =over 5
 842
 843 =item A filename
 844
 845 If the C<$output> parameter is a simple scalar, it is assumed to be a
 846 filename. This file will be opened for writing and the compressed data
 847 will be written to it.
 848
 849 =item A filehandle
 850
 851 If the C<$output> parameter is a filehandle, the compressed data will be
 852 written to it.
 853 The string '-' can be used as an alias for standard output.
 854
 855
 856 =item A scalar reference
 857
 858 If C<$output> is a scalar reference, the compressed data will be stored
 859 in C<$$output>.
 860
 861 =back
 862
 863 If the C<$output> parameter is any other type, C<IO::Compress::Zip>::new will
 864 return undef.
 865
 866 =head2 Constructor Options
 867
 868 C<OPTS> is any combination of the following options:
 869
 870 =over 5
 871
 872 =item AutoClose =E<gt> 0|1
 873
 874 This option is only valid when the C<$output> parameter is a filehandle. If
 875 specified, and the value is true, it will result in the C<$output> being
 876 closed once either the C<close> method is called or the C<IO::Compress::Zip>
 877 object is destroyed.
 878
 879 This parameter defaults to 0.
 880
 881 =item Append =E<gt> 0|1
 882
 883 Opens C<$output> in append mode.
 884
 885 The behaviour of this option is dependent on the type of C<$output>.
 886
 887 =over 5
 888
 889 =item * A Buffer
 890
 891 If C<$output> is a buffer and C<Append> is enabled, all compressed data
 892 will be append to the end if C<$output>. Otherwise C<$output> will be
 893 cleared before any data is written to it.
 894
 895 =item * A Filename
 896
 897 If C<$output> is a filename and C<Append> is enabled, the file will be
 898 opened in append mode. Otherwise the contents of the file, if any, will be
 899 truncated before any compressed data is written to it.
 900
 901 =item * A Filehandle
 902
 903 If C<$output> is a filehandle, the file pointer will be positioned to the
 904 end of the file via a call to C<seek> before any compressed data is written
 905 to it.  Otherwise the file pointer will not be moved.
 906
 907 =back
 908
 909 This parameter defaults to 0.
 910
 911
 912
 913 =item -Name =E<gt> $string
 914
 915 Stores the contents of C<$string> in the zip filename header field. If
 916 C<Name> is not specified, no zip filename field will be created.
 917
 918 =item -Time =E<gt> $number
 919
 920 Sets the last modified time field in the zip header to $number.
 921
 922 This field defaults to the time the C<IO::Compress::Zip> object was created
 923 if this option is not specified.
 924
 925 =item -exTime =E<gt> [$atime, $mtime, $ctime]
 926
 927 This option expects an array reference with exactly three elements:
 928 C<$atime>, C<mtime> and C<$ctime>. These correspond to the last access
 929 time, last modification time and creation time respectively.
 930
 931 It uses these values to set the extended timestamp field in the local zip
 932 header to the three values, $atime, $mtime, $ctime and sets the extended
 933 timestamp field in the central zip header to C<$mtime>.
 934
 935 If the C<Minimal> option is set to true, this option will be ignored.
 936
 937 By default no extended time field is created.
 938
 939 =item -Comment =E<gt> $comment
 940
 941 Stores the contents of C<$comment> in the Central File Header of
 942 the zip file.
 943
 944 By default, no comment field is written to the zip file.
 945
 946 =item -ZipComment =E<gt> $comment
 947
 948 Stores the contents of C<$comment> in the End of Central Directory record
 949 of the zip file.
 950
 951 By default, no comment field is written to the zip file.
 952
 953 =item Method =E<gt> $method
 954
 955 Controls which compression method is used. At present three compression
 956 methods are supported, namely Store (no compression at all), Deflate and
 957 Bzip2.
 958
 959 The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 are used to
 960 select the compression method.
 961
 962 These constants are not imported by C<IO::Compress::Zip> by default.
 963
 964     use IO::Compress::Zip qw(:zip_method);
 965     use IO::Compress::Zip qw(:constants);
 966     use IO::Compress::Zip qw(:all);
 967
 968 Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must
 969 be installed. A fatal error will be thrown if you attempt to create Bzip2
 970 content when C<IO::Compress::Bzip2> is not available.
 971
 972 The default method is ZIP_CM_DEFLATE.
 973
 974 =item Stream =E<gt> 0|1
 975
 976 This option controls whether the zip file/buffer output is created in
 977 streaming mode.
 978
 979 Note that when outputting to a file with streaming mode disabled (C<Stream>
 980 is 0), the output file must be seekable.
 981
 982 The default is 1.
 983
 984 =item -TextFlag =E<gt> 0|1
 985
 986 This parameter controls the setting of a bit in the zip central header. It
 987 is used to signal that the data stored in the zip file/buffer is probably
 988 text.
 989
 990 The default is 0.
 991
 992 =item ExtraFieldLocal =E<gt> $data
 993 =item ExtraFieldCentral =E<gt> $data
 994
 995 These options allows additional metadata to be stored in the local and
 996 central headers in the zip file/buffer.
 997
 998 An extra field consists of zero or more subfields. Each subfield consists
 999 of a two byte header followed by the subfield data.
1000
1001 The list of subfields can be supplied in any of the following formats
1002
1003     ExtraFieldLocal => [$id1, $data1,
1004                         $id2, $data2,
1005                          ...
1006                        ]
1007
1008     ExtraFieldLocal => [ [$id1 => $data1],
1009                          [$id2 => $data2],
1010                          ...
1011                        ]
1012
1013     ExtraFieldLocal => { $id1 => $data1,
1014                          $id2 => $data2,
1015                          ...
1016                        }
1017
1018 Where C<$id1>, C<$id2> are two byte subfield ID's.
1019
1020 If you use the hash syntax, you have no control over the order in which
1021 the ExtraSubFields are stored, plus you cannot have SubFields with
1022 duplicate ID.
1023
1024 Alternatively the list of subfields can by supplied as a scalar, thus
1025
1026     ExtraField => $rawdata
1027
1028
1029
1030 If the C<Minimal> option is set to true, this option will be ignored.
1031
1032 The maximum size of an extra field 65535 bytes.
1033
1034 =item Minimal =E<gt> 1|0
1035
1036 If specified, this option will disable the creation of all extended fields
1037 in the zip local and central headers.
1038
1039 This parameter defaults to 0.
1040
1041 =item BlockSize100K =E<gt> number
1042
1043 Specify the number of 100K blocks bzip2 uses during compression.
1044
1045 Valid values are from 1 to 9, where 9 is best compression.
1046
1047 This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
1048 otherwise.
1049
1050 The default is 1.
1051
1052 =item WorkFactor =E<gt> number
1053
1054 Specifies how much effort bzip2 should take before resorting to a slower
1055 fallback compression algorithm.
1056
1057 Valid values range from 0 to 250, where 0 means use the default value 30.
1058
1059 This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
1060 otherwise.
1061
1062 The default is 0.
1063
1064
1065
1066
1067 =item -Level
1068
1069 Defines the compression level used by zlib. The value should either be
1070 a number between 0 and 9 (0 means no compression and 9 is maximum
1071 compression), or one of the symbolic constants defined below.
1072
1073    Z_NO_COMPRESSION
1074    Z_BEST_SPEED
1075    Z_BEST_COMPRESSION
1076    Z_DEFAULT_COMPRESSION
1077
1078 The default is Z_DEFAULT_COMPRESSION.
1079
1080 Note, these constants are not imported by C<IO::Compress::Zip> by default.
1081
1082     use IO::Compress::Zip qw(:strategy);
1083     use IO::Compress::Zip qw(:constants);
1084     use IO::Compress::Zip qw(:all);
1085
1086 =item -Strategy
1087
1088 Defines the strategy used to tune the compression. Use one of the symbolic
1089 constants defined below.
1090
1091    Z_FILTERED
1092    Z_HUFFMAN_ONLY
1093    Z_RLE
1094    Z_FIXED
1095    Z_DEFAULT_STRATEGY
1096
1097 The default is Z_DEFAULT_STRATEGY.
1098
1099
1100
1101
1102
1103
1104 =item -Strict =E<gt> 0|1
1105
1106
1107
1108 This is a placeholder option.
1109
1110
1111
1112 =back
1113
1114 =head2 Examples
1115
1116 TODO
1117
1118 =head1 Methods
1119
1120 =head2 print
1121
1122 Usage is
1123
1124     $z->print($data)
1125     print $z $data
1126
1127 Compresses and outputs the contents of the C<$data> parameter. This
1128 has the same behaviour as the C<print> built-in.
1129
1130 Returns true if successful.
1131
1132 =head2 printf
1133
1134 Usage is
1135
1136     $z->printf($format, $data)
1137     printf $z $format, $data
1138
1139 Compresses and outputs the contents of the C<$data> parameter.
1140
1141 Returns true if successful.
1142
1143 =head2 syswrite
1144
1145 Usage is
1146
1147     $z->syswrite $data
1148     $z->syswrite $data, $length
1149     $z->syswrite $data, $length, $offset
1150
1151 Compresses and outputs the contents of the C<$data> parameter.
1152
1153 Returns the number of uncompressed bytes written, or C<undef> if
1154 unsuccessful.
1155
1156 =head2 write
1157
1158 Usage is
1159
1160     $z->write $data
1161     $z->write $data, $length
1162     $z->write $data, $length, $offset
1163
1164 Compresses and outputs the contents of the C<$data> parameter.
1165
1166 Returns the number of uncompressed bytes written, or C<undef> if
1167 unsuccessful.
1168
1169 =head2 flush
1170
1171 Usage is
1172
1173
1174     $z->flush;
1175     $z->flush($flush_type);
1176
1177
1178 Flushes any pending compressed data to the output file/buffer.
1179
1180
1181 This method takes an optional parameter, C<$flush_type>, that controls
1182 how the flushing will be carried out. By default the C<$flush_type>
1183 used is C<Z_FINISH>. Other valid values for C<$flush_type> are
1184 C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
1185 strongly recommended that you only set the C<flush_type> parameter if
1186 you fully understand the implications of what it does - overuse of C<flush>
1187 can seriously degrade the level of compression achieved. See the C<zlib>
1188 documentation for details.
1189
1190
1191 Returns true on success.
1192
1193
1194 =head2 tell
1195
1196 Usage is
1197
1198     $z->tell()
1199     tell $z
1200
1201 Returns the uncompressed file offset.
1202
1203 =head2 eof
1204
1205 Usage is
1206
1207     $z->eof();
1208     eof($z);
1209
1210
1211
1212 Returns true if the C<close> method has been called.
1213
1214
1215
1216 =head2 seek
1217
1218     $z->seek($position, $whence);
1219     seek($z, $position, $whence);
1220
1221
1222
1223
1224 Provides a sub-set of the C<seek> functionality, with the restriction
1225 that it is only legal to seek forward in the output file/buffer.
1226 It is a fatal error to attempt to seek backward.
1227
1228 Empty parts of the file/buffer will have NULL (0x00) bytes written to them.
1229
1230
1231
1232 The C<$whence> parameter takes one the usual values, namely SEEK_SET,
1233 SEEK_CUR or SEEK_END.
1234
1235 Returns 1 on success, 0 on failure.
1236
1237 =head2 binmode
1238
1239 Usage is
1240
1241     $z->binmode
1242     binmode $z ;
1243
1244 This is a noop provided for completeness.
1245
1246 =head2 opened
1247
1248     $z->opened()
1249
1250 Returns true if the object currently refers to a opened file/buffer.
1251
1252 =head2 autoflush
1253
1254     my $prev = $z->autoflush()
1255     my $prev = $z->autoflush(EXPR)
1256
1257 If the C<$z> object is associated with a file or a filehandle, this method
1258 returns the current autoflush setting for the underlying filehandle. If
1259 C<EXPR> is present, and is non-zero, it will enable flushing after every
1260 write/print operation.
1261
1262 If C<$z> is associated with a buffer, this method has no effect and always
1263 returns C<undef>.
1264
1265 B<Note> that the special variable C<$|> B<cannot> be used to set or
1266 retrieve the autoflush setting.
1267
1268 =head2 input_line_number
1269
1270     $z->input_line_number()
1271     $z->input_line_number(EXPR)
1272
1273
1274 This method always returns C<undef> when compressing.
1275
1276
1277
1278 =head2 fileno
1279
1280     $z->fileno()
1281     fileno($z)
1282
1283 If the C<$z> object is associated with a file or a filehandle, this method
1284 will return the underlying file descriptor.
1285
1286 If the C<$z> object is is associated with a buffer, this method will
1287 return undef.
1288
1289 =head2 close
1290
1291     $z->close() ;
1292     close $z ;
1293
1294
1295
1296 Flushes any pending compressed data and then closes the output file/buffer.
1297
1298
1299
1300 For most versions of Perl this method will be automatically invoked if
1301 the IO::Compress::Zip object is destroyed (either explicitly or by the
1302 variable with the reference to the object going out of scope). The
1303 exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
1304 these cases, the C<close> method will be called automatically, but
1305 not until global destruction of all live objects when the program is
1306 terminating.
1307
1308 Therefore, if you want your scripts to be able to run on all versions
1309 of Perl, you should call C<close> explicitly and not rely on automatic
1310 closing.
1311
1312 Returns true on success, otherwise 0.
1313
1314 If the C<AutoClose> option has been enabled when the IO::Compress::Zip
1315 object was created, and the object is associated with a file, the
1316 underlying file will also be closed.
1317
1318
1319
1320
1321 =head2 newStream([OPTS])
1322
1323 Usage is
1324
1325     $z->newStream( [OPTS] )
1326
1327 Closes the current compressed data stream and starts a new one.
1328
1329 OPTS consists of the following sub-set of the the options that are
1330 available when creating the C<$z> object,
1331
1332 =over 5
1333
1334
1335
1336 =item * Level
1337
1338
1339
1340 =back
1341
1342
1343 =head2 deflateParams
1344
1345 Usage is
1346
1347     $z->deflateParams
1348
1349 TODO
1350
1351
1352 =head1 Importing
1353
1354
1355 A number of symbolic constants are required by some methods in
1356 C<IO::Compress::Zip>. None are imported by default.
1357
1358
1359
1360 =over 5
1361
1362 =item :all
1363
1364
1365 Imports C<zip>, C<$ZipError> and all symbolic
1366 constants that can be used by C<IO::Compress::Zip>. Same as doing this
1367
1368     use IO::Compress::Zip qw(zip $ZipError :constants) ;
1369
1370 =item :constants
1371
1372 Import all symbolic constants. Same as doing this
1373
1374
1375     use IO::Compress::Zip qw(:flush :level :strategy :zip_method) ;
1376
1377
1378 =item :flush
1379
1380 These symbolic constants are used by the C<flush> method.
1381
1382     Z_NO_FLUSH
1383     Z_PARTIAL_FLUSH
1384     Z_SYNC_FLUSH
1385     Z_FULL_FLUSH
1386     Z_FINISH
1387     Z_BLOCK
1388
1389 =item :level
1390
1391 These symbolic constants are used by the C<Level> option in the constructor.
1392
1393     Z_NO_COMPRESSION
1394     Z_BEST_SPEED
1395     Z_BEST_COMPRESSION
1396     Z_DEFAULT_COMPRESSION
1397
1398
1399 =item :strategy
1400
1401 These symbolic constants are used by the C<Strategy> option in the constructor.
1402
1403     Z_FILTERED
1404     Z_HUFFMAN_ONLY
1405     Z_RLE
1406     Z_FIXED
1407     Z_DEFAULT_STRATEGY
1408
1409
1410 =item :zip_method
1411
1412 These symbolic constants are used by the C<Method> option in the
1413 constructor.
1414
1415     ZIP_CM_STORE
1416     ZIP_CM_DEFLATE
1417     ZIP_CM_BZIP2
1418
1419
1420
1421
1422 =back
1423
1424 For
1425
1426 =head1 EXAMPLES
1427
1428 TODO
1429
1430
1431
1432
1433
1434
1435 =head1 SEE ALSO
1436
1437 L<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::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress>
1438
1439 L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
1440
1441 L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
1442 L<Archive::Tar|Archive::Tar>,
1443 L<IO::Zlib|IO::Zlib>
1444
1445
1446 For RFC 1950, 1951 and 1952 see
1447 F<http://www.faqs.org/rfcs/rfc1950.html>,
1448 F<http://www.faqs.org/rfcs/rfc1951.html> and
1449 F<http://www.faqs.org/rfcs/rfc1952.html>
1450
1451 The I<zlib> compression library was written by Jean-loup Gailly
1452 F<gzip@prep.ai.mit.edu> and Mark Adler F<madler@alumni.caltech.edu>.
1453
1454 The primary site for the I<zlib> compression library is
1455 F<http://www.zlib.org>.
1456
1457 The primary site for gzip is F<http://www.gzip.org>.
1458
1459
1460
1461
1462 =head1 AUTHOR
1463
1464 This module was written by Paul Marquess, F<pmqs@cpan.org>.
1465
1466
1467
1468 =head1 MODIFICATION HISTORY
1469
1470 See the Changes file.
1471
1472 =head1 COPYRIGHT AND LICENSE
1473
1474 Copyright (c) 2005-2006 Paul Marquess. All rights reserved.
1475
1476 This program is free software; you can redistribute it and/or
1477 modify it under the same terms as Perl itself.
1478
1479