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