IO::Compress* 2.000_12
[p5sagit/p5-mst-13.2.git] / ext / Compress / IO / Zlib / lib / IO / Compress / Zip.pm
CommitLineData
25f0751f 1package IO::Compress::Zip ;
2
3use strict ;
4use warnings;
5use bytes;
6
2b4e0969 7use IO::Compress::Base::Common qw(:Status createSelfTiedObject);
25f0751f 8use IO::Compress::RawDeflate;
9use IO::Compress::Adapter::Deflate;
10use IO::Compress::Adapter::Identity;
c70c1701 11use IO::Compress::Zip::Constants;
12
25f0751f 13
2b4e0969 14use Compress::Raw::Zlib qw(crc32) ;
15BEGIN
16{
17 eval { require IO::Compress::Adapter::Bzip2;
c70c1701 18 import IO::Compress::Adapter::Bzip2;
2b4e0969 19 require IO::Compress::Bzip2;
c70c1701 20 import IO::Compress::Bzip2;
2b4e0969 21 } ;
22}
23
24
25f0751f 25require Exporter ;
26
27our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError);
28
c70c1701 29$VERSION = '2.000_12';
25f0751f 30$ZipError = '';
31
32@ISA = qw(Exporter IO::Compress::RawDeflate);
33@EXPORT_OK = qw( $ZipError zip ) ;
34%EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
35push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
2b4e0969 36
37$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 )];
38push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };
39
25f0751f 40Exporter::export_ok_tags('all');
41
25f0751f 42sub new
43{
44 my $class = shift ;
45
46 my $obj = createSelfTiedObject($class, \$ZipError);
47 $obj->_create(undef, @_);
48}
49
50sub zip
51{
52 my $obj = createSelfTiedObject(undef, \$ZipError);
53 return $obj->_def(@_);
54}
55
56sub mkComp
57{
58 my $self = shift ;
59 my $class = shift ;
60 my $got = shift ;
61
62 my ($obj, $errstr, $errno) ;
63
2b4e0969 64 if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
25f0751f 65 ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
25f0751f 66 $got->value('Level'),
67 $got->value('Strategy')
68 );
69 }
2b4e0969 70 elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
25f0751f 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 }
2b4e0969 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 }
25f0751f 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
2b4e0969 97sub 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
107sub filterUncompressed
108{
109 my $self = shift ;
25f0751f 110
2b4e0969 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}
25f0751f 119
120sub mkHeader
121{
122 my $self = shift;
123 my $param = shift ;
124
c70c1701 125 *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} ;
126
25f0751f 127 my $filename = '';
128 $filename = $param->value('Name') || '';
129
130 my $comment = '';
131 $comment = $param->value('Comment') || '';
132
25f0751f 133 my $hdr = '';
134
135 my $time = _unixToDosTime($param->value('Time'));
25f0751f 136
c70c1701 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
2b4e0969 171 my $method = *$self->{ZipData}{Method} ;
172
173 # deflate is 20
174 # bzip2 is 46
c70c1701 175 my $madeBy = ($param->value('OS_Code') << 8) +
2b4e0969 176 $ZIP_CM_MIN_VERSIONS{$method};
c70c1701 177 my $extract = $ZIP_CM_MIN_VERSIONS{$method};
178
179 my $ifa = 0;
180 $ifa |= ZIP_IFA_TEXT_MASK
181 if $param->value('TextFlag');
25f0751f 182
2b4e0969 183 $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
25f0751f 184 $hdr .= pack 'v', $extract ; # extract Version & OS
c70c1701 185 $hdr .= pack 'v', $gpFlag ; # general purpose flag (set streaming mode)
25f0751f 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
c70c1701 192 $hdr .= pack 'v', length $extra ; # extra length
25f0751f 193
194 $hdr .= $filename ;
c70c1701 195 $hdr .= $extra ;
25f0751f 196
197
198 my $ctl = '';
199
2b4e0969 200 $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
c70c1701 201 $ctl .= pack 'v', $madeBy ; # version made by
25f0751f 202 $ctl .= pack 'v', $extract ; # extract Version
c70c1701 203 $ctl .= pack 'v', $gpFlag ; # general purpose flag (streaming mode)
25f0751f 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
c70c1701 210 $ctl .= pack 'v', length $ctlExtra ; # extra length
25f0751f 211 $ctl .= pack 'v', length $comment ; # file comment length
212 $ctl .= pack 'v', 0 ; # disk number start
c70c1701 213 $ctl .= pack 'v', $ifa ; # internal file attributes
214 $ctl .= pack 'V', $extAttr ; # external file attributes
25f0751f 215 $ctl .= pack 'V', *$self->{ZipData}{Offset} ; # offset to local header
216
217 $ctl .= $filename ;
c70c1701 218 $ctl .= $ctlExtra ;
25f0751f 219 $ctl .= $comment ;
220
221 *$self->{ZipData}{Offset} += length $hdr ;
222
223 *$self->{ZipData}{CentralHeader} = $ctl;
224
225 return $hdr;
226}
227
228sub mkTrailer
229{
230 my $self = shift ;
231
2b4e0969 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
25f0751f 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}) {
2b4e0969 251 $hdr = pack "V", ZIP_DATA_HDR_SIG ; # signature
25f0751f 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 ;
25f0751f 261
262 *$self->{ZipData}{Offset} += length($hdr) + $compressedBytes;
263 push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
264
265 return $hdr;
266}
267
268sub 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 = '';
2b4e0969 279 $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
25f0751f 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
292sub 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
c70c1701 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
25f0751f 316 *$self->{ZipData}{Stream} = $got->value('Stream');
2b4e0969 317
318 my $method = $got->value('Method');
2b4e0969 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
25f0751f 328 *$self->{ZipData}{ZipComment} = $got->value('ZipComment') ;
329
c70c1701 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
2b4e0969 342 return undef
343 if defined $IO::Compress::Bzip2::VERSION
344 and ! IO::Compress::Bzip2::ckParams($self, $got);
25f0751f 345
346 return 1 ;
347}
348
349#sub newHeader
350#{
351# my $self = shift ;
352#
353# return $self->mkHeader(*$self->{Got});
354#}
355
356sub 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
2b4e0969 363 my @Bzip2 = ();
364
365 @Bzip2 = IO::Compress::Bzip2::getExtraParams($self)
366 if defined $IO::Compress::Bzip2::VERSION;
25f0751f 367
368 return (
369 # zlib behaviour
370 $self->getZlibParams(),
371
372 'Stream' => [1, 1, Parse_boolean, 1],
2b4e0969 373 #'Store' => [0, 1, Parse_boolean, 0],
374 'Method' => [0, 1, Parse_unsigned, ZIP_CM_DEFLATE],
25f0751f 375
376# # Zip header fields
c70c1701 377 'Minimal' => [0, 1, Parse_boolean, 0],
25f0751f 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],
c70c1701 382 'exTime' => [0, 1, Parse_any, undef],
25f0751f 383 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
384
c70c1701 385 'TextFlag' => [0, 1, Parse_boolean, 0],
386 'ExtraFieldLocal' => [0, 1, Parse_any, undef],
387 'ExtraFieldCentral'=> [0, 1, Parse_any, undef],
2b4e0969 388
389 @Bzip2,
25f0751f 390 );
391}
392
393sub getInverseClass
394{
395 return ('IO::Uncompress::Unzip',
396 \$IO::Uncompress::Unzip::UnzipError);
397}
398
399sub getFileInfo
400{
401 my $self = shift ;
402 my $params = shift;
403 my $filename = shift ;
404
c70c1701 405 my ($mode, $uid, $gid, $atime, $mtime, $ctime)
406 = (stat($filename))[2, 4,5, 8,9,10] ;
25f0751f 407
408 $params->value('Name' => $filename)
409 if ! $params->parsed('Name') ;
410
c70c1701 411 $params->value('Time' => $mtime)
25f0751f 412 if ! $params->parsed('Time') ;
413
c70c1701 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) ;
25f0751f 425
426}
427
c70c1701 428sub 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
452sub 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
25f0751f 465# from Archive::Zip
466sub _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
4811;
482
483__END__
484
485=head1 NAME
486
487
cb7abd7f 488
489IO::Compress::Zip - Write zip files/buffers
490
25f0751f 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
541B<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
558This module provides a Perl interface that allows writing zip
559compressed data to files or buffer.
560
561
562
563
564
565
566
cb7abd7f 567Note that IO::Compress::Zip is not intended to be a replacement for the module
25f0751f 568C<Archive::Zip>.
cb7abd7f 569
25f0751f 570The primary aim of this module is not as an archiver, but to provide
571streaming write access to zip file files and buffers.
572
573
574
575For reading zip files/buffers, see the companion module
576L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>.
577
578
579=head1 Functional Interface
580
581A top-level function, C<zip>, is provided to carry out
582"one-shot" compression between buffers and/or files. For finer
583control over the compression process, see the L</"OO Interface">
584section.
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
593The functional interface needs Perl5.005 or better.
594
595
596=head2 zip $input => $output [, OPTS]
597
598
599C<zip> expects at least two parameters, C<$input> and C<$output>.
600
601=head3 The C<$input> parameter
602
603The parameter, C<$input>, is used to define the source of
604the uncompressed data.
605
606It can take one of the following forms:
607
608=over 5
609
610=item A filename
611
612If the C<$input> parameter is a simple scalar, it is assumed to be a
613filename. This file will be opened for reading and the input data
614will be read from it.
615
616=item A filehandle
617
618If the C<$input> parameter is a filehandle, the input data will be
619read from it.
620The string '-' can be used as an alias for standard input.
621
622=item A scalar reference
623
624If C<$input> is a scalar reference, the input data will be read
625from C<$$input>.
626
627=item An array reference
628
629If C<$input> is an array reference, each element in the array must be a
630filename.
631
632The input data will be read from each file in turn.
633
634The complete array will be walked to ensure that it only
635contains valid filenames before any data is compressed.
636
637
638
639=item An Input FileGlob string
640
641If C<$input> is a string that is delimited by the characters "<" and ">"
642C<zip> will assume that it is an I<input fileglob string>. The
643input is the list of files that match the fileglob.
644
645If the fileglob does not match any files ...
646
647See L<File::GlobMapper|File::GlobMapper> for more details.
648
649
650=back
651
652If the C<$input> parameter is any other type, C<undef> will be returned.
653
654
25f0751f 655In addition, if C<$input> is a simple filename, the default values for
c70c1701 656the C<Name>, C<Time> and C<exTime> options will be sourced from that file.
25f0751f 657
658If you do not want to use these defaults they can be overridden by
c70c1701 659explicitly setting the C<Name>, C<Time> and C<exTime> options or by setting the
25f0751f 660C<Minimal> parameter.
661
662
663
664=head3 The C<$output> parameter
665
666The parameter C<$output> is used to control the destination of the
667compressed data. This parameter can take one of these forms.
668
669=over 5
670
671=item A filename
672
673If the C<$output> parameter is a simple scalar, it is assumed to be a
674filename. This file will be opened for writing and the compressed
675data will be written to it.
676
677=item A filehandle
678
679If the C<$output> parameter is a filehandle, the compressed data
680will be written to it.
681The string '-' can be used as an alias for standard output.
682
683
684=item A scalar reference
685
686If C<$output> is a scalar reference, the compressed data will be
687stored in C<$$output>.
688
689
690
691=item An Array Reference
692
693If C<$output> is an array reference, the compressed data will be
694pushed onto the array.
695
696=item An Output FileGlob
697
698If C<$output> is a string that is delimited by the characters "<" and ">"
699C<zip> will assume that it is an I<output fileglob string>. The
700output is the list of files that match the fileglob.
701
702When C<$output> is an fileglob string, C<$input> must also be a fileglob
703string. Anything else is an error.
704
705=back
706
707If the C<$output> parameter is any other type, C<undef> will be returned.
708
709
710
711=head2 Notes
712
c70c1701 713
714
25f0751f 715When C<$input> maps to multiple files/buffers and C<$output> is a single
c70c1701 716file/buffer the input files/buffers will each be stored
717in C<$output> as a distinct entry.
718
719
720
25f0751f 721
722
723
724=head2 Optional Parameters
725
726Unless specified below, the optional parameters for C<zip>,
727C<OPTS>, are the same as those used with the OO interface defined in the
728L</"Constructor Options"> section below.
729
730=over 5
731
732=item AutoClose =E<gt> 0|1
733
734This option applies to any input or output data streams to
735C<zip> that are filehandles.
736
737If C<AutoClose> is specified, and the value is true, it will result in all
738input and/or output filehandles being closed once C<zip> has
739completed.
740
741This parameter defaults to 0.
742
743
744
745=item BinModeIn =E<gt> 0|1
746
747When reading from a file or filehandle, set C<binmode> before reading.
748
749Defaults to 0.
750
751
752
753
754
755=item -Append =E<gt> 0|1
756
757TODO
758
759
760=back
761
762
763
764=head2 Examples
765
766To read the contents of the file C<file1.txt> and write the compressed
767data 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
778To read from an existing Perl filehandle, C<$input>, and write the
779compressed 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
792To compress all files in the directory "/my/home" that match "*.txt"
793and 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
802and 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
820The 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
825It returns an C<IO::Compress::Zip> object on success and undef on failure.
826The variable C<$ZipError> will contain an error message on failure.
827
828If you are running Perl 5.005 or better the object, C<$z>, returned from
829IO::Compress::Zip can be used exactly like an L<IO::File|IO::File> filehandle.
830This means that all normal output file operations can be carried out
831with C<$z>.
832For example, to write to a compressed file/buffer you can use either of
833these forms
834
835 $z->print("hello world\n");
836 print $z "hello world\n";
837
838The mandatory parameter C<$output> is used to control the destination
839of the compressed data. This parameter can take one of these forms.
840
841=over 5
842
843=item A filename
844
845If the C<$output> parameter is a simple scalar, it is assumed to be a
846filename. This file will be opened for writing and the compressed data
847will be written to it.
848
849=item A filehandle
850
851If the C<$output> parameter is a filehandle, the compressed data will be
852written to it.
853The string '-' can be used as an alias for standard output.
854
855
856=item A scalar reference
857
858If C<$output> is a scalar reference, the compressed data will be stored
859in C<$$output>.
860
861=back
862
863If the C<$output> parameter is any other type, C<IO::Compress::Zip>::new will
864return undef.
865
866=head2 Constructor Options
867
868C<OPTS> is any combination of the following options:
869
870=over 5
871
872=item AutoClose =E<gt> 0|1
873
874This option is only valid when the C<$output> parameter is a filehandle. If
875specified, and the value is true, it will result in the C<$output> being
876closed once either the C<close> method is called or the C<IO::Compress::Zip>
877object is destroyed.
878
879This parameter defaults to 0.
880
881=item Append =E<gt> 0|1
882
883Opens C<$output> in append mode.
884
885The behaviour of this option is dependent on the type of C<$output>.
886
887=over 5
888
889=item * A Buffer
890
891If C<$output> is a buffer and C<Append> is enabled, all compressed data
892will be append to the end if C<$output>. Otherwise C<$output> will be
893cleared before any data is written to it.
894
895=item * A Filename
896
897If C<$output> is a filename and C<Append> is enabled, the file will be
898opened in append mode. Otherwise the contents of the file, if any, will be
899truncated before any compressed data is written to it.
900
901=item * A Filehandle
902
903If C<$output> is a filehandle, the file pointer will be positioned to the
904end of the file via a call to C<seek> before any compressed data is written
905to it. Otherwise the file pointer will not be moved.
906
907=back
908
909This parameter defaults to 0.
910
911
912
2b4e0969 913=item -Name =E<gt> $string
914
915Stores the contents of C<$string> in the zip filename header field. If
916C<Name> is not specified, no zip filename field will be created.
917
918=item -Time =E<gt> $number
919
920Sets the last modified time field in the zip header to $number.
921
922This field defaults to the time the C<IO::Compress::Zip> object was created
923if this option is not specified.
924
c70c1701 925=item -exTime =E<gt> [$atime, $mtime, $ctime]
926
927This option expects an array reference with exactly three elements:
928C<$atime>, C<mtime> and C<$ctime>. These correspond to the last access
929time, last modification time and creation time respectively.
930
931It uses these values to set the extended timestamp field in the local zip
932header to the three values, $atime, $mtime, $ctime and sets the extended
933timestamp field in the central zip header to C<$mtime>.
934
935If the C<Minimal> option is set to true, this option will be ignored.
936
937By default no extended time field is created.
938
939=item -Comment =E<gt> $comment
940
941Stores the contents of C<$comment> in the Central File Header of
942the zip file.
943
944By default, no comment field is written to the zip file.
945
946=item -ZipComment =E<gt> $comment
947
948Stores the contents of C<$comment> in the End of Central Directory record
949of the zip file.
950
951By default, no comment field is written to the zip file.
952
2b4e0969 953=item Method =E<gt> $method
954
955Controls which compression method is used. At present three compression
956methods are supported, namely Store (no compression at all), Deflate and
957Bzip2.
958
959The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 are used to
960select the compression method.
961
962These 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
968Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must
969be installed. A fatal error will be thrown if you attempt to create Bzip2
970content when C<IO::Compress::Bzip2> is not available.
971
972The default method is ZIP_CM_DEFLATE.
973
c70c1701 974=item Stream =E<gt> 0|1
2b4e0969 975
976This option controls whether the zip file/buffer output is created in
977streaming mode.
978
c70c1701 979Note that when outputting to a file with streaming mode disabled (C<Stream>
980is 0), the output file must be seekable.
981
2b4e0969 982The default is 1.
983
c70c1701 984=item -TextFlag =E<gt> 0|1
985
986This parameter controls the setting of a bit in the zip central header. It
987is used to signal that the data stored in the zip file/buffer is probably
988text.
989
990The default is 0.
991
992=item ExtraFieldLocal =E<gt> $data
993=item ExtraFieldCentral =E<gt> $data
994
995These options allows additional metadata to be stored in the local and
996central headers in the zip file/buffer.
997
998An extra field consists of zero or more subfields. Each subfield consists
999of a two byte header followed by the subfield data.
1000
1001The 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
1018Where C<$id1>, C<$id2> are two byte subfield ID's.
1019
1020If you use the hash syntax, you have no control over the order in which
1021the ExtraSubFields are stored, plus you cannot have SubFields with
1022duplicate ID.
1023
1024Alternatively the list of subfields can by supplied as a scalar, thus
1025
1026 ExtraField => $rawdata
1027
1028
1029
1030If the C<Minimal> option is set to true, this option will be ignored.
1031
1032The maximum size of an extra field 65535 bytes.
1033
1034=item Minimal =E<gt> 1|0
1035
1036If specified, this option will disable the creation of all extended fields
1037in the zip local and central headers.
1038
1039This parameter defaults to 0.
1040
2b4e0969 1041=item BlockSize100K =E<gt> number
1042
1043Specify the number of 100K blocks bzip2 uses during compression.
1044
1045Valid values are from 1 to 9, where 9 is best compression.
1046
1047This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
1048otherwise.
1049
1050The default is 1.
1051
1052=item WorkFactor =E<gt> number
1053
1054Specifies how much effort bzip2 should take before resorting to a slower
1055fallback compression algorithm.
1056
1057Valid values range from 0 to 250, where 0 means use the default value 30.
1058
1059This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
1060otherwise.
1061
1062The default is 0.
1063
25f0751f 1064
1065
1066
1067=item -Level
1068
1069Defines the compression level used by zlib. The value should either be
1070a number between 0 and 9 (0 means no compression and 9 is maximum
1071compression), 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
1078The default is Z_DEFAULT_COMPRESSION.
1079
1080Note, 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
1088Defines the strategy used to tune the compression. Use one of the symbolic
1089constants defined below.
1090
1091 Z_FILTERED
1092 Z_HUFFMAN_ONLY
1093 Z_RLE
1094 Z_FIXED
1095 Z_DEFAULT_STRATEGY
1096
1097The default is Z_DEFAULT_STRATEGY.
1098
1099
1100
1101
1102
1103
1104=item -Strict =E<gt> 0|1
1105
1106
1107
1108This is a placeholder option.
1109
1110
1111
1112=back
1113
1114=head2 Examples
1115
1116TODO
1117
1118=head1 Methods
1119
1120=head2 print
1121
1122Usage is
1123
1124 $z->print($data)
1125 print $z $data
1126
1127Compresses and outputs the contents of the C<$data> parameter. This
1128has the same behaviour as the C<print> built-in.
1129
1130Returns true if successful.
1131
1132=head2 printf
1133
1134Usage is
1135
1136 $z->printf($format, $data)
1137 printf $z $format, $data
1138
1139Compresses and outputs the contents of the C<$data> parameter.
1140
1141Returns true if successful.
1142
1143=head2 syswrite
1144
1145Usage is
1146
1147 $z->syswrite $data
1148 $z->syswrite $data, $length
1149 $z->syswrite $data, $length, $offset
1150
1151Compresses and outputs the contents of the C<$data> parameter.
1152
1153Returns the number of uncompressed bytes written, or C<undef> if
1154unsuccessful.
1155
1156=head2 write
1157
1158Usage is
1159
1160 $z->write $data
1161 $z->write $data, $length
1162 $z->write $data, $length, $offset
1163
1164Compresses and outputs the contents of the C<$data> parameter.
1165
1166Returns the number of uncompressed bytes written, or C<undef> if
1167unsuccessful.
1168
1169=head2 flush
1170
1171Usage is
1172
1173
1174 $z->flush;
1175 $z->flush($flush_type);
1176
1177
1178Flushes any pending compressed data to the output file/buffer.
1179
1180
1181This method takes an optional parameter, C<$flush_type>, that controls
1182how the flushing will be carried out. By default the C<$flush_type>
1183used is C<Z_FINISH>. Other valid values for C<$flush_type> are
1184C<Z_NO_FLUSH>, C<Z_SYNC_FLUSH>, C<Z_FULL_FLUSH> and C<Z_BLOCK>. It is
1185strongly recommended that you only set the C<flush_type> parameter if
1186you fully understand the implications of what it does - overuse of C<flush>
1187can seriously degrade the level of compression achieved. See the C<zlib>
1188documentation for details.
1189
1190
1191Returns true on success.
1192
1193
1194=head2 tell
1195
1196Usage is
1197
1198 $z->tell()
1199 tell $z
1200
1201Returns the uncompressed file offset.
1202
1203=head2 eof
1204
1205Usage is
1206
1207 $z->eof();
1208 eof($z);
1209
1210
1211
1212Returns 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
1224Provides a sub-set of the C<seek> functionality, with the restriction
1225that it is only legal to seek forward in the output file/buffer.
1226It is a fatal error to attempt to seek backward.
1227
1228Empty parts of the file/buffer will have NULL (0x00) bytes written to them.
1229
1230
1231
1232The C<$whence> parameter takes one the usual values, namely SEEK_SET,
1233SEEK_CUR or SEEK_END.
1234
1235Returns 1 on success, 0 on failure.
1236
1237=head2 binmode
1238
1239Usage is
1240
1241 $z->binmode
1242 binmode $z ;
1243
1244This is a noop provided for completeness.
1245
1246=head2 opened
1247
1248 $z->opened()
1249
1250Returns 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
1257If the C<$z> object is associated with a file or a filehandle, this method
1258returns the current autoflush setting for the underlying filehandle. If
1259C<EXPR> is present, and is non-zero, it will enable flushing after every
1260write/print operation.
1261
1262If C<$z> is associated with a buffer, this method has no effect and always
1263returns C<undef>.
1264
1265B<Note> that the special variable C<$|> B<cannot> be used to set or
1266retrieve the autoflush setting.
1267
1268=head2 input_line_number
1269
1270 $z->input_line_number()
1271 $z->input_line_number(EXPR)
1272
1273
1274This method always returns C<undef> when compressing.
1275
1276
1277
1278=head2 fileno
1279
1280 $z->fileno()
1281 fileno($z)
1282
1283If the C<$z> object is associated with a file or a filehandle, this method
1284will return the underlying file descriptor.
1285
1286If the C<$z> object is is associated with a buffer, this method will
1287return undef.
1288
1289=head2 close
1290
1291 $z->close() ;
1292 close $z ;
1293
1294
1295
1296Flushes any pending compressed data and then closes the output file/buffer.
1297
1298
1299
1300For most versions of Perl this method will be automatically invoked if
1301the IO::Compress::Zip object is destroyed (either explicitly or by the
1302variable with the reference to the object going out of scope). The
1303exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In
1304these cases, the C<close> method will be called automatically, but
1305not until global destruction of all live objects when the program is
1306terminating.
1307
1308Therefore, if you want your scripts to be able to run on all versions
1309of Perl, you should call C<close> explicitly and not rely on automatic
1310closing.
1311
1312Returns true on success, otherwise 0.
1313
1314If the C<AutoClose> option has been enabled when the IO::Compress::Zip
1315object was created, and the object is associated with a file, the
1316underlying file will also be closed.
1317
1318
1319
1320
1321=head2 newStream([OPTS])
1322
1323Usage is
1324
1325 $z->newStream( [OPTS] )
1326
1327Closes the current compressed data stream and starts a new one.
1328
1329OPTS consists of the following sub-set of the the options that are
1330available 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
1345Usage is
1346
1347 $z->deflateParams
1348
1349TODO
1350
1351
1352=head1 Importing
1353
1354
1355A number of symbolic constants are required by some methods in
1356C<IO::Compress::Zip>. None are imported by default.
1357
1358
1359
1360=over 5
1361
1362=item :all
1363
1364
1365Imports C<zip>, C<$ZipError> and all symbolic
1366constants 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
1372Import all symbolic constants. Same as doing this
1373
2b4e0969 1374
1375 use IO::Compress::Zip qw(:flush :level :strategy :zip_method) ;
1376
25f0751f 1377
1378=item :flush
1379
1380These 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
1391These 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
1401These 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
2b4e0969 1408
1409
1410=item :zip_method
1411
1412These symbolic constants are used by the C<Method> option in the
1413constructor.
1414
1415 ZIP_CM_STORE
1416 ZIP_CM_DEFLATE
1417 ZIP_CM_BZIP2
1418
1419
25f0751f 1420
1421
1422=back
1423
1424For
1425
1426=head1 EXAMPLES
1427
1428TODO
1429
1430
1431
1432
1433
1434
1435=head1 SEE ALSO
1436
1437L<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
1439L<Compress::Zlib::FAQ|Compress::Zlib::FAQ>
1440
1441L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>,
1442L<Archive::Tar|Archive::Tar>,
1443L<IO::Zlib|IO::Zlib>
1444
1445
1446For RFC 1950, 1951 and 1952 see
1447F<http://www.faqs.org/rfcs/rfc1950.html>,
1448F<http://www.faqs.org/rfcs/rfc1951.html> and
1449F<http://www.faqs.org/rfcs/rfc1952.html>
1450
1451The I<zlib> compression library was written by Jean-loup Gailly
1452F<gzip@prep.ai.mit.edu> and Mark Adler F<madler@alumni.caltech.edu>.
1453
1454The primary site for the I<zlib> compression library is
1455F<http://www.zlib.org>.
1456
1457The primary site for gzip is F<http://www.gzip.org>.
1458
1459
1460
1461
25f0751f 1462=head1 AUTHOR
1463
cb7abd7f 1464This module was written by Paul Marquess, F<pmqs@cpan.org>.
25f0751f 1465
1466
1467
1468=head1 MODIFICATION HISTORY
1469
1470See the Changes file.
1471
1472=head1 COPYRIGHT AND LICENSE
25f0751f 1473
1474Copyright (c) 2005-2006 Paul Marquess. All rights reserved.
1475
1476This program is free software; you can redistribute it and/or
1477modify it under the same terms as Perl itself.
1478
1479