From: Paul Marquess Date: Fri, 14 Apr 2006 09:05:39 +0000 (+0100) Subject: IO::Compress::* X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2b4e0969009806e4e03a23b007570fa5279be8e0;p=p5sagit%2Fp5-mst-13.2.git IO::Compress::* Message-ID: <004f01c65f9a$3871eb30$2405140a@myopwv.com> p4raw-id: //depot/perl@27799 --- diff --git a/ext/Compress/IO/Base/Changes b/ext/Compress/IO/Base/Changes index fa0d479..7bff5f5 100644 --- a/ext/Compress/IO/Base/Changes +++ b/ext/Compress/IO/Base/Changes @@ -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 diff --git a/ext/Compress/IO/Base/lib/IO/Compress/Base.pm b/ext/Compress/IO/Base/lib/IO/Compress/Base.pm index 567ed0b..14363bc 100644 --- a/ext/Compress/IO/Base/lib/IO/Compress/Base.pm +++ b/ext/Compress/IO/Base/lib/IO/Compress/Base.pm @@ -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 ; diff --git a/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm b/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm index d35a9e0..f17fe47 100644 --- a/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm +++ b/ext/Compress/IO/Base/lib/IO/Compress/Base/Common.pm @@ -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 diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm index e39f1e8..b733965 100644 --- a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm +++ b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm @@ -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 ); diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm index dab3b51..2580191 100644 --- a/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm +++ b/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm @@ -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 ; diff --git a/ext/Compress/IO/Zlib/Changes b/ext/Compress/IO/Zlib/Changes index 81fa6db..cc27f44 100644 --- a/ext/Compress/IO/Zlib/Changes +++ b/ext/Compress/IO/Zlib/Changes @@ -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. diff --git a/ext/Compress/IO/Zlib/README b/ext/Compress/IO/Zlib/README index 15fe35a..6d323cb 100644 --- a/ext/Compress/IO/Zlib/README +++ b/ext/Compress/IO/Zlib/README @@ -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. diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm index 4521f17..454689e 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Deflate.pm @@ -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 { diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm index 10315aa..72f6efc 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm @@ -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; diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm index ebc200a..df4af0c 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm @@ -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. 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 method. @@ -948,6 +950,8 @@ These symbolic constants are used by the C option in the constructor. Z_RLE Z_FIXED Z_DEFAULT_STRATEGY + + =back diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm index 5732a30..4d4c2d2 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm @@ -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. 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 method. @@ -1417,6 +1419,8 @@ These symbolic constants are used by the C option in the constructor. Z_RLE Z_FIXED Z_DEFAULT_STRATEGY + + =back diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm index 496b8ca..024c443 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip/Constants.pm @@ -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); diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm index 1dcd650..fc195e7 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/RawDeflate.pm @@ -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. 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 method. @@ -1032,6 +1034,8 @@ These symbolic constants are used by the C option in the constructor. Z_RLE Z_FIXED Z_DEFAULT_STRATEGY + + =back diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm index c714341..4441809 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm @@ -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 $string + +Stores the contents of C<$string> in the zip filename header field. If +C is not specified, no zip filename field will be created. + +=item -Time =E $number + +Sets the last modified time field in the zip header to $number. + +This field defaults to the time the C object was created +if this option is not specified. + +=item Method =E $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 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 must +be installed. A fatal error will be thrown if you attempt to create Bzip2 +content when C is not available. + +The default method is ZIP_CM_DEFLATE. + +=item -Stream =E 0|1 + +This option controls whether the zip file/buffer output is created in +streaming mode. + +The default is 1. + +=item BlockSize100K =E 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 is ZIP_CM_BZIP2. It is ignored +otherwise. + +The default is 1. + +=item WorkFactor =E 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 is ZIP_CM_BZIP2. It is ignored +otherwise. + +The default is 0. + @@ -1029,7 +1184,9 @@ constants that can be used by C. 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 option in the constructor. Z_RLE Z_FIXED Z_DEFAULT_STRATEGY + + +=item :zip_method + +These symbolic constants are used by the C option in the +constructor. + + ZIP_CM_STORE + ZIP_CM_DEFLATE + ZIP_CM_BZIP2 + + =back diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm index 336bea9..9761b82 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip/Constants.pm @@ -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; diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm index 33df33c..a06b6fb 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.000_10'; +$VERSION = '2.000_11'; @ISA = qw(Exporter); diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm index 11f325b..288bf58 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Identity.pm @@ -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 (); diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm index 3b15e49..20f4e70 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Adapter/Inflate.pm @@ -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'; diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm index 38dd36a..99dcd33 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm @@ -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 ); diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm index 9ebc03b..fbb3af8 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm @@ -27,7 +27,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.000_10'; +$VERSION = '2.000_11'; sub new { diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm index f250e8a..d3efef6 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm @@ -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 ); diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm index c463704..5977c9b 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm @@ -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 ); diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm index 01e81e7..4c9d882 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm @@ -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 { diff --git a/ext/Compress/IO/Zlib/t/105oneshot-zip-only.t b/ext/Compress/IO/Zlib/t/105oneshot-zip-only.t index aaf5bfc..6ad67b7 100644 --- a/ext/Compress/IO/Zlib/t/105oneshot-zip-only.t +++ b/ext/Compress/IO/Zlib/t/105oneshot-zip-only.t @@ -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/", diff --git a/ext/Compress/Raw/Zlib/README b/ext/Compress/Raw/Zlib/README index 0d6e868..59b0133 100644 --- a/ext/Compress/Raw/Zlib/README +++ b/ext/Compress/Raw/Zlib/README @@ -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. diff --git a/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm b/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm index d282bad..d216bd2 100644 --- a/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm +++ b/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm @@ -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; diff --git a/ext/Compress/Zlib/README b/ext/Compress/Zlib/README index 003d535..d94463f 100644 --- a/ext/Compress/Zlib/README +++ b/ext/Compress/Zlib/README @@ -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. diff --git a/ext/Compress/Zlib/lib/Compress/Zlib.pm b/ext/Compress/Zlib/lib/Compress/Zlib.pm index 00f8244..797e90a 100644 --- a/ext/Compress/Zlib/lib/Compress/Zlib.pm +++ b/ext/Compress/Zlib/lib/Compress/Zlib.pm @@ -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; diff --git a/t/lib/compress/generic.pl b/t/lib/compress/generic.pl index 884c416..04132fe 100644 --- a/t/lib/compress/generic.pl +++ b/t/lib/compress/generic.pl @@ -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; + } }