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