This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
IO::Compress::*
authorPaul Marquess <paul.marquess@btinternet.com>
Fri, 14 Apr 2006 09:05:39 +0000 (10:05 +0100)
committerSteve Peters <steve@fisharerojo.org>
Fri, 14 Apr 2006 12:16:01 +0000 (12:16 +0000)
Message-ID: <004f01c65f9a$3871eb30$2405140a@myopwv.com>

p4raw-id: //depot/perl@27799

29 files changed:
ext/Compress/IO/Base/Changes
ext/Compress/IO/Base/lib/IO/Compress/Base.pm
ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm
ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm
ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm
ext/Compress/IO/Zlib/Changes
ext/Compress/IO/Zlib/README
ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm
ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm
ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm
ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm
ext/Compress/IO/Zlib/t/105oneshot-zip-only.t
ext/Compress/Raw/Zlib/README
ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm
ext/Compress/Zlib/README
ext/Compress/Zlib/lib/Compress/Zlib.pm
t/lib/compress/generic.pl

index fa0d479..7bff5f5 100644 (file)
@@ -1,6 +1,11 @@
 CHANGES
 -------
 
+  2.000_11 10 April 2006
+
+      * Transparent + InputLength made more robust where input data is not
+        compressed.
+
   2.000_10 13 March 2006
 
       * AnyUncompress doesn't assume  that IO-Compress-Zlib is installed any
index 567ed0b..14363bc 100644 (file)
@@ -20,7 +20,7 @@ use bytes;
 our (@ISA, $VERSION, $got_encode);
 #@ISA    = qw(Exporter IO::File);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.
 
@@ -548,6 +548,10 @@ sub DESTROY
 
 
 
+sub filterUncompressed
+{
+}
+
 sub syswrite
 {
     my $self = shift ;
@@ -596,6 +600,8 @@ sub syswrite
         *$self->{UnCompSize_32bit} += $buffer_length ;
     }
 
+    $self->filterUncompressed($buffer);
+
 #    if (*$self->{Encoding}) {
 #        $$buffer = *$self->{Encoding}->encode($$buffer);
 #    }
@@ -695,7 +701,8 @@ sub newStream
         ${ *$self->{Buffer} } = '' ;
     }
     
-    my $status = *$self->{Compress}->reset() ;
+    #my $status = *$self->{Compress}->reset() ;
+    my $status = $self->reset() ;
     return $self->saveErrorString(0, *$self->{Compress}{Error}, 
                                   *$self->{Compress}{ErrorNo})
         if $status == STATUS_ERROR;
@@ -706,6 +713,12 @@ sub newStream
     return 1 ;
 }
 
+sub reset
+{
+    my $self = shift ;
+    return *$self->{Compress}->reset() ;
+}
+
 sub _writeTrailer
 {
     my $self = shift ;
index d35a9e0..f17fe47 100644 (file)
@@ -11,7 +11,7 @@ use File::GlobMapper;
 require Exporter;
 our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS);
 @ISA = qw(Exporter);
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 @EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput 
               isaFileGlobString cleanFileGlobString oneTarget
index e39f1e8..b733965 100644 (file)
@@ -26,7 +26,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $AnyUncompressError = '';
 
 @ISA = qw( Exporter IO::Uncompress::Base );
index dab3b51..2580191 100644 (file)
@@ -10,7 +10,7 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
 @ISA    = qw(Exporter );
 
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 use constant G_EOF => 0 ;
 use constant G_ERR => -1 ;
@@ -39,12 +39,17 @@ sub smartRead
     my $offset = 0 ;
 
 
+    if (defined *$self->{InputLength} && 
+                *$self->{InputLengthRemaining} <= 0) {
+        return 0 ;
+    }
+
     if ( length *$self->{Prime} ) {
         #$$out = substr(*$self->{Prime}, 0, $size, '') ;
         $$out = substr(*$self->{Prime}, 0, $size) ;
         substr(*$self->{Prime}, 0, $size) =  '' ;
-        if (length $$out == $size) {
-            #*$self->{InputLengthRemaining} -= length $$out;
+        if (length $$out == $size || defined *$self->{InputLength}) {
+            *$self->{InputLengthRemaining} -= length $$out;
             return length $$out ;
         }
         $offset = length $$out ;
@@ -53,9 +58,6 @@ sub smartRead
     my $get_size = $size - $offset ;
 
     if ( defined *$self->{InputLength} ) {
-        #*$self->{InputLengthRemaining} += length *$self->{Prime} ;
-        #*$self->{InputLengthRemaining} = *$self->{InputLength}
-        #    if *$self->{InputLengthRemaining} > *$self->{InputLength};
         $get_size = min($get_size, *$self->{InputLengthRemaining});
     }
 
@@ -100,6 +102,7 @@ sub pushBack
 
     if (defined *$self->{FH} || defined *$self->{InputEvent} ) {
         *$self->{Prime} = $_[0] . *$self->{Prime} ;
+        *$self->{InputLengthRemaining} += length($_[0]);
     }
     else {
         my $len = length $_[0];
@@ -262,6 +265,12 @@ sub TruncatedHeader
     return $self->HeaderError("Truncated in $_[0] Section");
 }
 
+sub TruncatedTrailer
+{
+    my ($self) = shift;
+    return $self->TrailerError("Truncated in $_[0] Section");
+}
+
 sub checkParams
 {
     my $self = shift ;
@@ -721,7 +730,7 @@ sub _raw_read
 
         *$self->{NewStream} = 0 ;
         *$self->{EndStream} = 0 ;
-        *$self->{Uncomp}->reset();
+        $self->reset();
 
         return G_ERR
             unless  my $magic = $self->ckMagic();
@@ -761,6 +770,8 @@ sub _raw_read
         $self->postBlockChk($buffer) == STATUS_OK
             or return G_ERR;
 
+        $self->filterUncompressed($buffer);
+
         #$buf_len = *$self->{Uncomp}->count();
         $buf_len = length($$buffer) - $before_len;
 
@@ -815,6 +826,17 @@ sub _raw_read
     return $buf_len ;
 }
 
+sub reset
+{
+    my $self = shift ;
+
+    return *$self->{Uncomp}->reset();
+}
+
+sub filterUncompressed
+{
+}
+
 #sub isEndStream
 #{
 #    my $self = shift ;
@@ -1271,10 +1293,6 @@ sub _notAvailable
 #}
 #
 #
-#sub reset
-#{
-#    return STATUS_OK ;
-#}
 
 
 package IO::Uncompress::Base ;
index 81fa6db..cc27f44 100644 (file)
@@ -1,6 +1,25 @@
 CHANGES
 -------
 
+  2.000_11 10 April 2006
+
+      * Updated Documentation for zip modules.
+
+      * Changed IO::Compress::Zip 'Store' option to 'Method' and added
+        symbolic constants ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 to
+        allow the compression method to be picked by the user.
+
+      * Added support to allow bzip2 compressed data to be written/read
+        with IO::Compress::Zip and IO::Uncompress::Unzip.
+
+      * Beefed up 050interop-gzip.t to check that the external gzip command
+        works as expected before starting the tests. This means that
+        this test harness will just be skipped on problematic systems.
+
+      * Merged core patch 27565 from Steve Peters. This works around a
+        problem with gzip on OpenBSD where it doesn't seem to like
+        compressing files < 10 bytes long.
+
   2.000_10 13 March 2006
 
       * Documentation updates.
index 15fe35a..6d323cb 100644 (file)
@@ -1,9 +1,9 @@
 
                              IO::Compress::Zlib
 
-                             Version 2.000_10
+                             Version 2.000_11
 
-                                13 Mar 2006 
+                               10 April 2006
 
 
        Copyright (c) 2005-2006 Paul Marquess. All rights reserved.
index 4521f17..454689e 100644 (file)
@@ -9,7 +9,7 @@ use IO::Compress::Base::Common qw(:Status);
 use Compress::Raw::Zlib qw(Z_OK Z_FINISH MAX_WBITS) ;
 our ($VERSION);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 sub mkCompObject
 {
index 10315aa..72f6efc 100644 (file)
@@ -5,15 +5,12 @@ use warnings;
 use bytes;
 
 use IO::Compress::Base::Common qw(:Status);
-use Compress::Raw::Zlib () ;
 our ($VERSION);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 sub mkCompObject
 {
-    my $crc32    = shift ;
-    my $adler32  = shift ;
     my $level    = shift ;
     my $strategy = shift ;
 
@@ -22,10 +19,6 @@ sub mkCompObject
                   'UnCompSize' => 0,
                   'Error'      => '',
                   'ErrorNo'    => 0,
-                  'wantCRC32'  => $crc32,
-                  'CRC32'      => Compress::Raw::Zlib::crc32(''),
-                  'wantADLER32'=> $adler32,
-                  'ADLER32'    => Compress::Raw::Zlib::adler32(''),                  
                  } ;     
 }
 
@@ -37,12 +30,6 @@ sub compr
         $self->{CompSize} += length ${ $_[0] } ;
         $self->{UnCompSize} = $self->{CompSize} ;
 
-        $self->{CRC32} = Compress::Raw::Zlib::crc32($_[0],  $self->{CRC32})
-            if $self->{wantCRC32};
-
-        $self->{ADLER32} = Compress::Raw::Zlib::adler32($_[0],  $self->{ADLER32})
-            if $self->{wantADLER32};
-
         ${ $_[1] } .= ${ $_[0] };
     }
 
@@ -69,8 +56,6 @@ sub reset
 
     $self->{CompSize}   = 0;
     $self->{UnCompSize} = 0;
-    $self->{CRC32}      = Compress::Raw::Zlib::crc32('');
-    $self->{ADLER32}    = Compress::Raw::Zlib::adler32('');                  
 
     return STATUS_OK;    
 }
@@ -106,20 +91,6 @@ sub uncompressedBytes
     return $self->{UnCompSize} ;
 }
 
-sub crc32
-{
-    my $self = shift ;
-    return $self->{CRC32};
-}
-
-sub adler32
-{
-    my $self = shift ;
-    return $self->{ADLER32};
-}
-
-
-
 1;
 
 
index ebc200a..df4af0c 100644 (file)
@@ -15,7 +15,7 @@ use IO::Compress::Base::Common qw(createSelfTiedObject);
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $DeflateError = '';
 
 @ISA    = qw(Exporter IO::Compress::RawDeflate);
@@ -916,8 +916,10 @@ constants that can be used by C<IO::Compress::Deflate>. Same as doing this
 
 Import all symbolic constants. Same as doing this
 
+
     use IO::Compress::Deflate qw(:flush :level :strategy) ;
 
+
 =item :flush
 
 These symbolic constants are used by the C<flush> method.
@@ -948,6 +950,8 @@ These symbolic constants are used by the C<Strategy> option in the constructor.
     Z_RLE
     Z_FIXED
     Z_DEFAULT_STRATEGY
+
+    
     
 
 =back
index 5732a30..4d4c2d2 100644 (file)
@@ -26,7 +26,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $GzipError = '' ;
 
 @ISA    = qw(Exporter IO::Compress::RawDeflate);
@@ -1385,8 +1385,10 @@ constants that can be used by C<IO::Compress::Gzip>. Same as doing this
 
 Import all symbolic constants. Same as doing this
 
+
     use IO::Compress::Gzip qw(:flush :level :strategy) ;
 
+
 =item :flush
 
 These symbolic constants are used by the C<flush> method.
@@ -1417,6 +1419,8 @@ These symbolic constants are used by the C<Strategy> option in the constructor.
     Z_RLE
     Z_FIXED
     Z_DEFAULT_STRATEGY
+
+    
     
 
 =back
index 496b8ca..024c443 100644 (file)
@@ -9,7 +9,7 @@ require Exporter;
 our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
 our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 @ISA = qw(Exporter);
 
index 1dcd650..fc195e7 100644 (file)
@@ -16,7 +16,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $RawDeflateError = '';
 
 @ISA = qw(Exporter IO::Compress::Base);
@@ -1000,8 +1000,10 @@ constants that can be used by C<IO::Compress::RawDeflate>. Same as doing this
 
 Import all symbolic constants. Same as doing this
 
+
     use IO::Compress::RawDeflate qw(:flush :level :strategy) ;
 
+
 =item :flush
 
 These symbolic constants are used by the C<flush> method.
@@ -1032,6 +1034,8 @@ These symbolic constants are used by the C<Strategy> option in the constructor.
     Z_RLE
     Z_FIXED
     Z_DEFAULT_STRATEGY
+
+    
     
 
 =back
index c714341..4441809 100644 (file)
@@ -4,24 +4,55 @@ use strict ;
 use warnings;
 use bytes;
 
-use IO::Compress::Base::Common qw(createSelfTiedObject);
+use IO::Compress::Base::Common qw(:Status createSelfTiedObject);
 use IO::Compress::RawDeflate;
 use IO::Compress::Adapter::Deflate;
 use IO::Compress::Adapter::Identity;
 
+use Compress::Raw::Zlib qw(crc32) ;
+BEGIN
+{
+    eval { require IO::Compress::Adapter::Bzip2; 
+           import IO::Compress::Adapter::Bzip2; 
+           require IO::Compress::Bzip2; 
+           import IO::Compress::Bzip2; 
+         } ;
+}
+
+
 require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $ZipError = '';
 
 @ISA = qw(Exporter IO::Compress::RawDeflate);
 @EXPORT_OK = qw( $ZipError zip ) ;
 %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ;
 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
+
+$EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 )];
+push @{ $EXPORT_TAGS{all} }, @{ $EXPORT_TAGS{zip_method} };
+
 Exporter::export_ok_tags('all');
 
+use constant ZIP_CM_STORE                      => 0 ;
+use constant ZIP_CM_DEFLATE                    => 8 ;
+use constant ZIP_CM_BZIP2                      => 12 ;
+
+use constant ZIP_LOCAL_HDR_SIG                 => 0x04034b50;
+use constant ZIP_DATA_HDR_SIG                  => 0x08074b50;
+use constant ZIP_CENTRAL_HDR_SIG               => 0x02014b50;
+use constant ZIP_END_CENTRAL_HDR_SIG           => 0x06054b50;
+
+
+our (%ZIP_CM_MIN_VERSIONS);
+%ZIP_CM_MIN_VERSIONS = (
+            ZIP_CM_STORE()                      => 20,
+            ZIP_CM_DEFLATE()                    => 20,
+            ZIP_CM_BZIP2()                      => 46,
+            );
 
 sub new
 {
@@ -45,15 +76,13 @@ sub mkComp
 
     my ($obj, $errstr, $errno) ;
 
-    if (*$self->{ZipData}{Store}) {
+    if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
         ($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
-                                                 $got->value('CRC32'),
-                                                 $got->value('Adler32'),
                                                  $got->value('Level'),
                                                  $got->value('Strategy')
                                                  );
     }
-    else {
+    elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
         ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
                                                  $got->value('CRC32'),
                                                  $got->value('Adler32'),
@@ -61,6 +90,14 @@ sub mkComp
                                                  $got->value('Strategy')
                                                  );
     }
+    elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
+        ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
+                                                $got->value('BlockSize100K'),
+                                                $got->value('WorkFactor'),
+                                                $got->value('Verbosity')
+                                               );
+        *$self->{ZipData}{CRC32} = crc32(undef);
+    }
 
     return $self->saveErrorString(undef, $errstr, $errno)
        if ! defined $obj;
@@ -72,7 +109,28 @@ sub mkComp
     return $obj;    
 }
 
+sub reset
+{
+    my $self = shift ;
+
+    *$self->{Compress}->reset();
+    *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32('');
+
+    return STATUS_OK;    
+}
+
+sub filterUncompressed
+{
+    my $self = shift ;
 
+    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
+        *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32();
+    }
+    else {
+        *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32});
+
+    }
+}
 
 sub mkHeader
 {
@@ -85,16 +143,21 @@ sub mkHeader
     my $comment = '';
     $comment = $param->value('Comment') || '';
 
-    my $extract = $param->value('OS_Code') << 8 + 20 ;
     my $hdr = '';
 
     my $time = _unixToDosTime($param->value('Time'));
     *$self->{ZipData}{StartOffset} = *$self->{ZipData}{Offset} ;
 
     my $strm = *$self->{ZipData}{Stream} ? 8 : 0 ;
-    my $method = *$self->{ZipData}{Store} ? 0 : 8 ;
+    # bzip2 is 12, deflate is 8
+    my $method = *$self->{ZipData}{Method} ;
+
+    # deflate is 20
+    # bzip2 is 46
+    my $extract = $param->value('OS_Code') << 8 +
+                    $ZIP_CM_MIN_VERSIONS{$method};
 
-    $hdr .= pack "V", 0x04034b50 ; # signature
+    $hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
     $hdr .= pack 'v', $extract   ; # extract Version & OS
     $hdr .= pack 'v', $strm      ; # general purpose flag (set streaming mode)
     $hdr .= pack 'v', $method    ; # compression method (deflate)
@@ -110,7 +173,7 @@ sub mkHeader
 
     my $ctl = '';
 
-    $ctl .= pack "V", 0x02014b50 ; # signature
+    $ctl .= pack "V", ZIP_CENTRAL_HDR_SIG ; # signature
     $ctl .= pack 'v', $extract   ; # version made by
     $ctl .= pack 'v', $extract   ; # extract Version
     $ctl .= pack 'v', $strm      ; # general purpose flag (streaming mode)
@@ -142,7 +205,14 @@ sub mkTrailer
 {
     my $self = shift ;
 
-    my $crc32             = *$self->{Compress}->crc32();
+    my $crc32 ;
+    if (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
+        $crc32 = *$self->{Compress}->crc32();
+    }
+    else {
+        $crc32 = *$self->{ZipData}{CRC32};
+    }
+
     my $compressedBytes   = *$self->{Compress}->compressedBytes();
     my $uncompressedBytes = *$self->{Compress}->uncompressedBytes();
 
@@ -154,7 +224,7 @@ sub mkTrailer
     my $hdr = '';
 
     if (*$self->{ZipData}{Stream}) {
-        $hdr  = pack "V", 0x08074b50 ;                       # signature
+        $hdr  = pack "V", ZIP_DATA_HDR_SIG ;                       # signature
         $hdr .= $data ;
     }
     else {
@@ -185,7 +255,7 @@ sub mkFinalTrailer
     my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
 
     my $ecd = '';
-    $ecd .= pack "V", 0x06054b50 ; # signature
+    $ecd .= pack "V", ZIP_END_CENTRAL_HDR_SIG ; # signature
     $ecd .= pack 'v', 0          ; # number of disk
     $ecd .= pack 'v', 0          ; # number if disk with central dir
     $ecd .= pack 'v', $entries   ; # entries in central dir on this disk
@@ -211,9 +281,24 @@ sub ckParams
     }
 
     *$self->{ZipData}{Stream} = $got->value('Stream');
-    *$self->{ZipData}{Store} = $got->value('Store');
+    #*$self->{ZipData}{Store} = $got->value('Store');
+
+    my $method = $got->value('Method');
+    #if ($method != 0 && $method != 8 && $method != 12) {
+    return $self->saveErrorString(undef, "Unknown Method '$method'")   
+        if ! defined $ZIP_CM_MIN_VERSIONS{$method};
+
+    return $self->saveErrorString(undef, "Bzip2 not available")
+        if $method == ZIP_CM_BZIP2 and 
+           ! defined $IO::Compress::Adapter::Bzip2::VERSION;
+
+    *$self->{ZipData}{Method} = $method;
+
     *$self->{ZipData}{ZipComment} = $got->value('ZipComment') ;
 
+    return undef
+        if defined $IO::Compress::Bzip2::VERSION
+            and ! IO::Compress::Bzip2::ckParams($self, $got);
 
     return 1 ;
 }
@@ -232,13 +317,18 @@ sub getExtraParams
     use IO::Compress::Base::Common qw(:Parse);
     use Compress::Raw::Zlib qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
 
+    my @Bzip2 = ();
+    
+    @Bzip2 = IO::Compress::Bzip2::getExtraParams($self)
+        if defined $IO::Compress::Bzip2::VERSION;
     
     return (
             # zlib behaviour
             $self->getZlibParams(),
 
             'Stream'    => [1, 1, Parse_boolean,   1],
-            'Store'     => [0, 1, Parse_boolean,   0],
+           #'Store'     => [0, 1, Parse_boolean,   0],
+            'Method'    => [0, 1, Parse_unsigned,  ZIP_CM_DEFLATE],
             
 #            # Zip header fields
 #           'Minimal'   => [0, 1, Parse_boolean,   0],
@@ -250,6 +340,8 @@ sub getExtraParams
             
 #           'TextFlag'  => [0, 1, Parse_boolean,   0],
 #           'ExtraField'=> [0, 1, Parse_string,    ''],
+
+            @Bzip2,
         );
 }
 
@@ -719,6 +811,69 @@ This parameter defaults to 0.
 
 
 
+=item -Name =E<gt> $string
+
+Stores the contents of C<$string> in the zip filename header field. If
+C<Name> is not specified, no zip filename field will be created.
+
+=item -Time =E<gt> $number
+
+Sets the last modified time field in the zip header to $number.
+
+This field defaults to the time the C<IO::Compress::Zip> object was created
+if this option is not specified.
+
+=item Method =E<gt> $method
+
+Controls which compression method is used. At present three compression
+methods are supported, namely Store (no compression at all), Deflate and
+Bzip2.
+
+The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 are used to
+select the compression method.
+
+These constants are not imported by C<IO::Compress::Zip> by default.
+
+    use IO::Compress::Zip qw(:zip_method);
+    use IO::Compress::Zip qw(:constants);
+    use IO::Compress::Zip qw(:all);
+
+Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must
+be installed. A fatal error will be thrown if you attempt to create Bzip2
+content when C<IO::Compress::Bzip2> is not available.
+
+The default method is ZIP_CM_DEFLATE.
+
+=item -Stream =E<gt> 0|1
+
+This option controls whether the zip file/buffer output is created in
+streaming mode.
+
+The default is 1.
+
+=item BlockSize100K =E<gt> number
+
+Specify the number of 100K blocks bzip2 uses during compression. 
+
+Valid values are from 1 to 9, where 9 is best compression.
+
+This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
+otherwise.
+
+The default is 1.
+
+=item WorkFactor =E<gt> number
+
+Specifies how much effort bzip2 should take before resorting to a slower
+fallback compression algorithm.
+
+Valid values range from 0 to 250, where 0 means use the default value 30.
+
+This option is only valid if the C<Method> is ZIP_CM_BZIP2. It is ignored
+otherwise.
+
+The default is 0.
+
 
 
 
@@ -1029,7 +1184,9 @@ constants that can be used by C<IO::Compress::Zip>. Same as doing this
 
 Import all symbolic constants. Same as doing this
 
-    use IO::Compress::Zip qw(:flush :level :strategy) ;
+
+    use IO::Compress::Zip qw(:flush :level :strategy :zip_method) ;
+
 
 =item :flush
 
@@ -1061,6 +1218,18 @@ These symbolic constants are used by the C<Strategy> option in the constructor.
     Z_RLE
     Z_FIXED
     Z_DEFAULT_STRATEGY
+
+
+=item :zip_method
+
+These symbolic constants are used by the C<Method> option in the
+constructor.
+
+    ZIP_CM_STORE
+    ZIP_CM_DEFLATE
+    ZIP_CM_BZIP2
+
+    
     
 
 =back
index 336bea9..9761b82 100644 (file)
@@ -7,7 +7,7 @@ require Exporter;
 
 our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 @ISA = qw(Exporter);
 
@@ -25,7 +25,9 @@ $VERSION = '2.000_10';
     GZIP_FLG_FCOMMENT
     GZIP_FLG_RESERVED
 
-    GZIP_CM_DEFLATED
+    ZIP_CM_STORE
+    ZIP_CM_DEFLATED
+    ZIP_CM_BZIP2
 
     GZIP_MIN_HEADER_SIZE
     GZIP_TRAILER_SIZE
@@ -95,7 +97,9 @@ use constant GZIP_FCOMMENT_INVALID_CHAR_RE      => qr/[\x00-\x09\x11-\x1F\x7F-\x
 
 use constant GZIP_FHCRC_SIZE                    => 2 ; # aka CONTINUATION in gzip
 
-use constant GZIP_CM_DEFLATED                   => 8 ;
+use constant ZIP_CM_STORE                      => 0 ;
+use constant ZIP_CM_DEFLATE                    => 8 ;
+use constant ZIP_CM_BZIP2                      => 12 ;
 
 use constant GZIP_NULL_BYTE                     => "\x00";
 use constant GZIP_ISIZE_MAX                     => 0xFFFFFFFF ;
@@ -127,9 +131,4 @@ use constant GZIP_OS_DEFAULT=> 0xFF ;
     GZIP_OS_DEFAULT => 'Unknown',
     ) ;
 
-use constant GZIP_MINIMUM_HEADER =>   pack("C4 V C C",  
-    GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT,
-    GZIP_MTIME_DEFAULT, GZIP_FEXTRA_DEFAULT, GZIP_OS_DEFAULT) ;
-
-
 1;
index 33df33c..a06b6fb 100644 (file)
@@ -9,7 +9,7 @@ require Exporter;
 
 our ($VERSION, @ISA, @EXPORT);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 @ISA = qw(Exporter);
 
index 11f325b..288bf58 100644 (file)
@@ -8,7 +8,7 @@ use IO::Compress::Base::Common qw(:Status);
 
 our ($VERSION);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 use Compress::Raw::Zlib ();
 
index 3b15e49..20f4e70 100644 (file)
@@ -8,7 +8,7 @@ use IO::Compress::Base::Common qw(:Status);
 use Compress::Raw::Zlib qw(Z_OK Z_DATA_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
 
 our ($VERSION);
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 
 
index 38dd36a..99dcd33 100644 (file)
@@ -21,7 +21,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $AnyInflateError = '';
 
 @ISA = qw( Exporter IO::Uncompress::Base );
index 9ebc03b..fbb3af8 100644 (file)
@@ -27,7 +27,7 @@ Exporter::export_ok_tags('all');
 
 $GunzipError = '';
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 
 sub new
 {
index f250e8a..d3efef6 100644 (file)
@@ -13,7 +13,7 @@ use IO::Uncompress::RawInflate ;
 require Exporter ;
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $InflateError = '';
 
 @ISA    = qw( Exporter IO::Uncompress::RawInflate );
index c463704..5977c9b 100644 (file)
@@ -17,7 +17,7 @@ use IO::Uncompress::Adapter::Inflate ;
 require Exporter ;
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $RawInflateError = '';
 
 @ISA    = qw( Exporter IO::Uncompress::Base );
index 01e81e7..4c9d882 100644 (file)
@@ -12,11 +12,19 @@ use IO::Uncompress::RawInflate ;
 use IO::Compress::Base::Common qw(:Status createSelfTiedObject);
 use IO::Uncompress::Adapter::Identity;
 
+use Compress::Raw::Zlib qw(crc32) ;
+BEGIN
+{
+    eval { require IO::Uncompress::Adapter::Bunzip2  ;
+           import IO::Uncompress::Adapter::Bunzip2 } ;
+}
+
+
 require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $UnzipError = '';
 
 @ISA    = qw(Exporter IO::Uncompress::RawInflate);
@@ -172,8 +180,8 @@ sub chkTrailer
     }
 
     if (*$self->{Strict}) {
-        #return $self->TrailerError("CRC mismatch")
-        #    if $CRC32  != *$self->{Uncomp}->crc32() ;
+        return $self->TrailerError("CRC mismatch")
+            if $CRC32  != *$self->{ZipData}{CRC32} ;
 
         my $exp_isize = *$self->{Uncomp}->compressedBytes();
         return $self->TrailerError("CSIZE mismatch. Got $cSize"
@@ -288,21 +296,21 @@ sub skipCentralDirectory
     if ($filename_length)
     {
         $self->smartReadExact(\$filename, $filename_length)
-            or return $self->TrailerError("xxx");
+            or return $self->TruncatedTrailer("filename");
         $keep .= $filename ;
     }
 
     if ($extra_length)
     {
         $self->smartReadExact(\$extraField, $extra_length)
-            or return $self->TrailerError("xxx");
+            or return $self->TruncatedTrailer("extra");
         $keep .= $extraField ;
     }
 
     if ($comment_length)
     {
         $self->smartReadExact(\$comment, $comment_length)
-            or return $self->TrailerError("xxx");
+            or return $self->TruncatedTrailer("comment");
         $keep .= $comment ;
     }
 
@@ -335,7 +343,7 @@ sub skipEndCentralDirectory
     if ($comment_length)
     {
         $self->smartReadExact(\$comment, $comment_length)
-            or return $self->TrailerError("xxx");
+            or return $self->TruncatedTrailer("comment");
         $keep .= $comment ;
     }
 
@@ -432,15 +440,29 @@ sub _readZipHeader($)
         $keep .= $extraField ;
     }
 
+    *$self->{ZipData}{Method} = $compressedMethod;
     if ($compressedMethod == 8)
     {
-        *$self->{Type} = 'zip';
+        *$self->{Type} = 'zip-deflate';
+    }
+    elsif ($compressedMethod == 12)
+    {
+    #if (! defined $IO::Uncompress::Adapter::Bunzip2::VERSION)
+        
+        *$self->{Type} = 'zip-bzip2';
+        
+        my $obj = IO::Uncompress::Adapter::Bunzip2::mkUncompObject(
+                                                              );
+
+        *$self->{Uncomp} = $obj;
+        *$self->{ZipData}{CRC32} = crc32(undef);
+
     }
     elsif ($compressedMethod == 0)
     {
         # TODO -- add support for reading uncompressed
 
-        *$self->{Type} = 'zipStored';
+        *$self->{Type} = 'zip-stored';
         
         my $obj = IO::Uncompress::Adapter::Identity::mkUncompObject(# $got->value('CRC32'),
                                                              # $got->value('ADLER32'),
@@ -494,6 +516,19 @@ sub _readZipHeader($)
       }
 }
 
+sub filterUncompressed
+{
+    my $self = shift ;
+
+    if (*$self->{ZipData}{Method} == 12) {
+        *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32});
+    }
+    else {
+        *$self->{ZipData}{CRC32} = *$self->{Uncomp}->crc32() ;
+    }
+}    
+
+
 # from Archive::Zip
 sub _dosToUnixTime
 {
index aaf5bfc..6ad67b7 100644 (file)
@@ -25,7 +25,8 @@ BEGIN {
 
     plan tests => 119 + $extra ;
 
-    use_ok('IO::Compress::Zip', qw(zip $ZipError)) ;
+    #use_ok('IO::Compress::Zip', qw(zip $ZipError :zip_method)) ;
+    use_ok('IO::Compress::Zip', qw(:all)) ;
     use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
 
 
@@ -134,20 +135,20 @@ sub zipGetHeader
 
 for my $stream (0, 1)
 {
-    for my $store (0, 8)
+    for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
     {
-        title "Stream $stream, Store $store";
+        title "Stream $stream, Method $method";
 
         my $lex = new LexFile my $file1;
 
         my $content = "hello ";
         #writeFile($file1, $content);
 
-        ok zip(\$content => $file1 , Store => !$store, Stream => $stream), " zip ok" 
+        ok zip(\$content => $file1 , Method => $method, Stream => $stream), " zip ok" 
             or diag $ZipError ;
 
         my $got ;
-        if ($stream && ! $store) {
+        if ($stream && $method == ZIP_CM_STORE ) {
             #eval ' unzip($file1 => \$got) ';
             ok ! unzip($file1 => \$got), "  unzip fails"; 
             like $UnzipError, "/Streamed Stored content not supported/",
@@ -167,15 +168,15 @@ for my $stream (0, 1)
         ok $hdr, "  got header";
 
         is $hdr->{Stream}, $stream, "  stream is $stream" ;
-        is $hdr->{MethodID}, $store, "  MethodID is $store" ;
+        is $hdr->{MethodID}, $method, "  MethodID is $method" ;
     }
 }
 
 for my $stream (0, 1)
 {
-    for my $store (0, 1)
+    for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
     {
-        title "Stream $stream, Store $store";
+        title "Stream $stream, Method $method";
 
         my $file1;
         my $file2;
@@ -192,13 +193,13 @@ for my $stream (0, 1)
                         $file2 => $content2,
                       );
 
-        ok zip([$file1, $file2] => $zipfile , Store => !$store, Stream => $stream), " zip ok" 
+        ok zip([$file1, $file2] => $zipfile , Method => $method, Stream => $stream), " zip ok" 
             or diag $ZipError ;
 
         for my $file ($file1, $file2)
         {
             my $got ;
-            if ($stream && ! $store) {
+            if ($stream &&  $method == ZIP_CM_STORE ) {
                 #eval ' unzip($zipfile => \$got) ';
                 ok ! unzip($zipfile => \$got, Name => $file), "  unzip fails"; 
                 like $UnzipError, "/Streamed Stored content not supported/",
index 0d6e868..59b0133 100644 (file)
@@ -1,9 +1,9 @@
 
                              Compress::Raw::Zlib
 
-                             Version 2.000_10
+                             Version 2.000_11
 
-                                13 Mar 2006 
+                               10 April 2006
 
 
        Copyright (c) 2005-2006 Paul Marquess. All rights reserved.
index d282bad..d216bd2 100644 (file)
@@ -13,7 +13,7 @@ use warnings ;
 use bytes ;
 our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $XS_VERSION = $VERSION; 
 $VERSION = eval $VERSION;
 
index 003d535..d94463f 100644 (file)
@@ -1,9 +1,9 @@
 
                              Compress::Zlib
 
-                             Version 2.000_10
+                             Version 2.000_11
 
-                                13 Mar 2006 
+                               10 April 2006
 
 
        Copyright (c) 1995-2006 Paul Marquess. All rights reserved.
index 00f8244..797e90a 100644 (file)
@@ -18,7 +18,7 @@ use warnings ;
 use bytes ;
 our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
 
-$VERSION = '2.000_10';
+$VERSION = '2.000_11';
 $XS_VERSION = $VERSION; 
 $VERSION = eval $VERSION;
 
index 884c416..04132fe 100644 (file)
@@ -18,7 +18,7 @@ BEGIN
     $extra = 1
         if $st ;
 
-    plan(tests => 601 + $extra) ;
+    plan(tests => 615 + $extra) ;
 }
 
 sub myGZreadFile
@@ -1110,51 +1110,65 @@ EOT
 
         foreach my $type (qw(buffer filename filehandle))
         {
-            title "$UncompressClass -- InputLength, read from $type";
+            foreach my $good (0, 1)
+            {
+                title "$UncompressClass -- InputLength, read from $type, good data => $good";
 
-            my $compressed ; 
-            my $string = "some data";
-            my $c = new $CompressClass(\$compressed);
-            $c->write($string);
-            $c->close();
+                my $compressed ; 
+                my $string = "some data";
+                my $appended = "append";
 
-            my $appended = "append";
-            my $comp_len = length $compressed;
-            $compressed .= $appended;
+                if ($good)
+                {
+                    my $c = new $CompressClass(\$compressed);
+                    $c->write($string);
+                    $c->close();
+                }
+                else
+                {
+                    $compressed = $string ;
+                }
 
-            my $lex = new LexFile my $name ;
-            my $input ;
-            writeFile ($name, $compressed);
+                my $comp_len = length $compressed;
+                $compressed .= $appended;
 
-            if ($type eq 'buffer')
-            {
-                $input = \$compressed;
-            }
-            if ($type eq 'filename')
-            {
-                $input = $name;
-            }
-            elsif ($type eq 'filehandle')
-            {
-                my $fh = new IO::File "<$name" ;
-                ok $fh, "opened file $name ok";
-                $input = $fh ;
-            }
+                my $lex = new LexFile my $name ;
+                my $input ;
+                writeFile ($name, $compressed);
 
-            my $x = new $UncompressClass($input, InputLength => $comp_len)  ;
-            ok $x, "  created $UncompressClass";
+                if ($type eq 'buffer')
+                {
+                    $input = \$compressed;
+                }
+                if ($type eq 'filename')
+                {
+                    $input = $name;
+                }
+                elsif ($type eq 'filehandle')
+                {
+                    my $fh = new IO::File "<$name" ;
+                    ok $fh, "opened file $name ok";
+                    $input = $fh ;
+                }
 
-            my $len ;
-            my $output;
-            $len = $x->read($output, 100);
-            is $len, length($string);
-            is $output, $string;
+                my $x = new $UncompressClass($input, 
+                                             InputLength => $comp_len,
+                                             Transparent => 1)  ;
+                ok $x, "  created $UncompressClass";
 
-            if ($type eq 'filehandle')
-            {
-                my $rest ;
-                $input->read($rest, 1000);
-                is $rest, $appended;
+                my $len ;
+                my $output;
+                $len = $x->read($output, 100);
+
+                is $len, length($string);
+                is $output, $string;
+
+                if ($type eq 'filehandle')
+                {
+                    my $rest ;
+                    $input->read($rest, 1000);
+                    is $rest, $appended;
+                }
             }