From: Paul Marquess Date: Thu, 26 Oct 2006 15:29:43 +0000 (+0100) Subject: IO::Compress modules X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=258133d1989d727199a2ae29d4f498d5d7e9a2f9;p=p5sagit%2Fp5-mst-13.2.git IO::Compress modules From: "Paul Marquess" Message-ID: <028201c6f90b$2de7a4b0$4e3c140a@myopwv.com> p4raw-id: //depot/perl@29117 --- diff --git a/ext/Compress/IO/Base/Changes b/ext/Compress/IO/Base/Changes index 8ab7daf..86d751f 100644 --- a/ext/Compress/IO/Base/Changes +++ b/ext/Compress/IO/Base/Changes @@ -1,6 +1,38 @@ CHANGES ------- + 2.000_14 26 October 2006 + + * IO::Uncompress::Base + Added support for $/ in record mode + + * IO::Uncompress::Base + The readline interface was substantially slower than the 1.x + equivalent. This has now been sorted. + Thanks to Andreas J. Koenig for spotting the problem. + + * IO::Uncompress::AnyUncompress + Added IO::Uncompress::Lzf to the list of supported uncompresors. + + * IO::Uncompress::Base + Added TrailingData to one-shot interface. + + * IO::Uncompress::AnyUncompress + Remove raw-deflate (RFC1951) from the default list of compressors + to check. + It can still be included if the new RawInflate parameter is + supplied. + This change was made because the only way to tell if content is + raw-deflate is to attempt to uncompress it - a few false positives + have popped up recently, which suggests that auto-detecting raw + deflate is far from perfect. + The equivalent change has been made to IO::Uncompress::AnyInflate. + [Core patch #28445] + + * Don't check that filehandles are writable. It would seem that + "-w *STDOUT" on windows returns false. + [Core Patch #28415] + 2.000_13 20 June 2006 * Store compress & uncompressed sizes as 64-bit. diff --git a/ext/Compress/IO/Base/Makefile.PL b/ext/Compress/IO/Base/Makefile.PL index 2aaecb5..3b5518f 100644 --- a/ext/Compress/IO/Base/Makefile.PL +++ b/ext/Compress/IO/Base/Makefile.PL @@ -39,3 +39,4 @@ WriteMakefile( # end of file Makefile.PL + diff --git a/ext/Compress/IO/Base/README b/ext/Compress/IO/Base/README index 4a041a3..66f5105 100644 --- a/ext/Compress/IO/Base/README +++ b/ext/Compress/IO/Base/README @@ -1,9 +1,9 @@ IO::Compress::Base - Version 2.000_13 + Version 2.000_14 - 20 June 2006 + 26th October 2006 Copyright (c) 2005-2006 Paul Marquess. All rights reserved. diff --git a/ext/Compress/IO/Base/lib/IO/Compress/Base.pm b/ext/Compress/IO/Base/lib/IO/Compress/Base.pm index 4bceb35..212b1fa 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_13'; +$VERSION = '2.000_14'; #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. @@ -545,6 +545,10 @@ sub addInterStream return 1 ; } +sub getFileInfo +{ +} + sub TIEHANDLE { return $_[0] if ref($_[0]); @@ -970,7 +974,7 @@ purpose if to to be sub-classed by IO::Compress modules. =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L 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 2c5da9e..307af4a 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_13'; +$VERSION = '2.000_14'; @EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput isaFileGlobString cleanFileGlobString oneTarget @@ -421,7 +421,7 @@ sub createSelfTiedObject $EXPORT_TAGS{Parse} = [qw( ParseParameters Parse_any Parse_unsigned Parse_signed Parse_boolean Parse_custom Parse_string - Parse_store_ref + Parse_multiple Parse_writable_scalar ) ]; @@ -434,7 +434,10 @@ use constant Parse_boolean => 0x08; use constant Parse_string => 0x10; use constant Parse_custom => 0x12; -use constant Parse_store_ref => 0x100 ; +#use constant Parse_store_ref => 0x100 ; +use constant Parse_multiple => 0x100 ; +use constant Parse_writable => 0x200 ; +use constant Parse_writable_scalar => 0x400 | Parse_writable ; use constant OFF_PARSED => 0 ; use constant OFF_TYPE => 1 ; @@ -544,12 +547,16 @@ sub IO::Compress::Base::Parameters::parse $key = lc $key; if ($firstTime || ! $sticky) { + $x = [ $x ] + if $type & Parse_multiple; + $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ; } $got->{$key}[OFF_PARSED] = 0 ; } + my %parsed = (); for my $i (0.. @entered / 2 - 1) { my $key = $entered[2* $i] ; my $value = $entered[2* $i+1] ; @@ -564,12 +571,24 @@ sub IO::Compress::Base::Parameters::parse ! $got->{$canonkey}[OFF_FIRST_ONLY] )) { my $type = $got->{$canonkey}[OFF_TYPE] ; + my $parsed = $parsed{$canonkey}; + ++ $parsed{$canonkey}; + + return $self->setError("Muliple instances of '$key' found") + if $parsed && $type & Parse_multiple == 0 ; + my $s ; $self->_checkType($key, $value, $type, 1, \$s) or return undef ; - #$value = $$value unless $type & Parse_store_ref ; + $value = $$value ; - $got->{$canonkey} = [1, $type, $value, $s] ; + if ($type & Parse_multiple) { + $got->{$canonkey}[OFF_PARSED] = 1; + push @{ $got->{$canonkey}[OFF_FIXED] }, $s ; + } + else { + $got->{$canonkey} = [1, $type, $value, $s] ; + } } else { push (@Bad, $key) } @@ -595,15 +614,39 @@ sub IO::Compress::Base::Parameters::_checkType #local $Carp::CarpLevel = $level ; #print "PARSE $type $key $value $validate $sub\n" ; - if ( $type & Parse_store_ref) + + if ($type & Parse_writable_scalar) { - #$value = $$value - # if ref ${ $value } ; + return $self->setError("Parameter '$key' not writable") + if $validate && readonly $$value ; + + if (ref $$value) + { + return $self->setError("Parameter '$key' not a scalar reference") + if $validate && ref $$value ne 'SCALAR' ; + + $$output = $$value ; + } + else + { + return $self->setError("Parameter '$key' not a scalar") + if $validate && ref $value ne 'SCALAR' ; + + $$output = $value ; + } - $$output = $value ; return 1; } +# if ($type & Parse_store_ref) +# { +# #$value = $$value +# # if ref ${ $value } ; +# +# $$output = $value ; +# return 1; +# } + $value = $$value ; if ($type & Parse_any) diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm index 3c30c52..3ed346a 100644 --- a/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm +++ b/ext/Compress/IO/Base/lib/IO/Uncompress/AnyUncompress.pm @@ -8,25 +8,12 @@ use IO::Compress::Base::Common qw(createSelfTiedObject); use IO::Uncompress::Base ; -BEGIN -{ - eval { require IO::Uncompress::Adapter::Inflate; import IO::Uncompress::Adapter::Inflate }; - eval { require IO::Uncompress::Adapter::Bunzip2; import IO::Uncompress::Adapter::Bunzip2 }; - eval { require IO::Uncompress::Adapter::LZO; import IO::Uncompress::Adapter::LZO }; - - eval { require IO::Uncompress::Bunzip2; import IO::Uncompress::Bunzip2 }; - eval { require IO::Uncompress::UnLzop; import IO::Uncompress::UnLzop }; - eval { require IO::Uncompress::Gunzip; import IO::Uncompress::Gunzip }; - eval { require IO::Uncompress::Inflate; import IO::Uncompress::Inflate }; - eval { require IO::Uncompress::RawInflate; import IO::Uncompress::RawInflate }; - eval { require IO::Uncompress::Unzip; import IO::Uncompress::Unzip }; -} require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; $AnyUncompressError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -38,6 +25,22 @@ Exporter::export_ok_tags('all'); # TODO - allow the user to pick a set of the three formats to allow # or just assume want to auto-detect any of the three formats. +BEGIN +{ + eval ' use IO::Uncompress::Adapter::Inflate '; + eval ' use IO::Uncompress::Adapter::Bunzip2 '; + eval ' use IO::Uncompress::Adapter::LZO '; + eval ' use IO::Uncompress::Adapter::Lzf '; + + eval ' use IO::Uncompress::Bunzip2 '; + eval ' use IO::Uncompress::UnLzop '; + eval ' use IO::Uncompress::Gunzip '; + eval ' use IO::Uncompress::Inflate '; + eval ' use IO::Uncompress::RawInflate '; + eval ' use IO::Uncompress::Unzip '; + eval ' use IO::Uncompress::UnLzf '; +} + sub new { my $class = shift ; @@ -132,6 +135,22 @@ sub mkUncomp return 1; } + if (defined $IO::Uncompress::UnLzf::VERSION and + $magic = $self->ckMagic('UnLzf')) { + + *$self->{Info} = $self->readHeader($magic) + or return undef ; + + my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Lzf::mkUncompObject(); + + return $self->saveErrorString(undef, $errstr, $errno) + if ! defined $obj; + + *$self->{Uncomp} = $obj; + + return 1; + } + return 0 ; } @@ -248,7 +267,7 @@ The formats supported are: =item RFC 1950 -=item RFC 1951 +=item RFC 1951 (optionally) =item gzip (RFC 1952) @@ -258,6 +277,8 @@ The formats supported are: =item lzop +=item lzf + =back The module will auto-detect which, if any, of the supported @@ -266,7 +287,6 @@ compression formats is being used. - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -440,6 +460,7 @@ TODO =item C<< MultiStream => 0|1 >> + If the input file/buffer contains multiple compressed data streams, this option will uncompress the whole lot as a single data stream. @@ -447,6 +468,35 @@ Defaults to 0. + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. + + + =back @@ -660,6 +710,19 @@ The default for this option is off. +=item C<< RawInflate => 0|1 >> + +When auto-detecting the compressed format, try to test for raw-deflate (RFC +1951) content using the C module. + +The reason this is not default behaviour is because RFC 1951 content can +only be detected by attempting to uncompress it. This process is error +prone and can result is false positives. + +Defaults to 0. + + + @@ -716,10 +779,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -891,8 +954,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -903,7 +966,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -927,7 +1013,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm b/ext/Compress/IO/Base/lib/IO/Uncompress/Base.pm index 038feb2..0073291 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_13'; +$VERSION = '2.000_14'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; @@ -278,6 +278,11 @@ sub TruncatedTrailer return $self->TrailerError("Truncated in $_[0] Section"); } +sub postCheckParams +{ + return 1; +} + sub checkParams { my $self = shift ; @@ -289,7 +294,6 @@ sub checkParams 'BlockSize' => [1, 1, Parse_unsigned, 16 * 1024], 'AutoClose' => [1, 1, Parse_boolean, 0], 'Strict' => [1, 1, Parse_boolean, 0], - #'Lax' => [1, 1, Parse_boolean, 1], 'Append' => [1, 1, Parse_boolean, 0], 'Prime' => [1, 1, Parse_any, undef], 'MultiStream' => [1, 1, Parse_boolean, 0], @@ -301,15 +305,18 @@ sub checkParams $self->getExtraParams(), - #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0, # ContinueAfterEof } ; + $Valid->{TrailingData} = [1, 1, Parse_writable_scalar, undef] + if *$self->{OneShot} ; $got->parse($Valid, @_ ) or $self->croakError("${class}: $got->{Error}") ; + $self->postCheckParams($got) + or $self->croakError("${class}: " . $self->error()) ; return $got; } @@ -326,6 +333,8 @@ sub _create my $inValue = shift ; + *$obj->{OneShot} = 0 ; + if (! $got) { $got = $obj->checkParams($class, undef, @_) @@ -340,7 +349,7 @@ sub _create *$obj->{InNew} = 1; $obj->ckParams($got) - or $obj->croakError("${class}: $obj->{Error}"); + or $obj->croakError("${class}: " . *$obj->{Error}); if ($inType eq 'buffer' || $inType eq 'code') { *$obj->{Buffer} = $inValue ; @@ -351,9 +360,10 @@ sub _create if ($inType eq 'handle') { *$obj->{FH} = $inValue ; *$obj->{Handle} = 1 ; + # Need to rewind for Scan - #seek(*$obj->{FH}, 0, SEEK_SET) if $got->value('Scan'); - *$obj->{FH}->seek(0, SEEK_SET) if $got->value('Scan'); + *$obj->{FH}->seek(0, SEEK_SET) + if $got->value('Scan'); } else { my $mode = '<'; @@ -478,10 +488,17 @@ sub _inf or return undef ; push @_, $output if $haveOut && $x->{Hash}; + + *$obj->{OneShot} = 1 ; my $got = $obj->checkParams($name, undef, @_) or return undef ; + if ($got->parsed('TrailingData')) + { + *$obj->{TrailingData} = $got->value('TrailingData'); + } + *$obj->{MultiStream} = $got->value('MultiStream'); $got->value('MultiStream', 0); @@ -661,6 +678,9 @@ sub _rd2 return $z->closeError(undef) if $status < 0 ; + ${ *$self->{TrailingData} } = $z->trailingData() + if defined *$self->{TrailingData} ; + $z->close() or return undef ; @@ -773,7 +793,6 @@ sub _raw_read return G_ERR if $status == STATUS_ERROR ; - my $buf_len = 0; if ($status == STATUS_OK) { my $beforeC_len = length $temp_buf; @@ -785,11 +804,14 @@ sub _raw_read return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo}) if $self->saveStatus($status) == STATUS_ERROR; - $self->postBlockChk($buffer) == STATUS_OK + $self->postBlockChk($buffer, $before_len) == STATUS_OK or return G_ERR; $self->filterUncompressed($buffer); + # TODO uncompress filter goes here + + $buf_len = length($$buffer) - $before_len; @@ -825,6 +847,8 @@ sub _raw_read $self->pushBack($trailer) ; } + # TODO - if want to file file pointer, do it here + if (! $self->smartEof()) { *$self->{NewStream} = 1 ; @@ -999,6 +1023,9 @@ sub read $length = length $$out_buffer if length($$out_buffer) < $length ; + return 0 + if $length == 0 ; + if ($offset) { $$buffer .= "\x00" x ($offset - length($$buffer)) if $offset > length($$buffer) ; @@ -1023,7 +1050,14 @@ sub _getline if ( ! defined $/ ) { my $data ; 1 while $self->read($data) > 0 ; - $. = ++ *$self->{LineNo} if defined($data); + return \$data ; + } + + # Record Mode + if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) { + my $reclen = ${$/} ; + my $data ; + $self->read($data, $reclen) ; return \$data ; } @@ -1034,27 +1068,35 @@ sub _getline if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; my $par = $1 ; - $. = ++ *$self->{LineNo} ; return \$par ; } } - $. = ++ *$self->{LineNo} if defined($paragraph); return \$paragraph; } - # Line Mode + # $/ isn't empty, or a reference, so it's Line Mode. { my $line ; - my $endl = quotemeta($/); # quote in case $/ contains RE meta chars + my $offset; + my $p = \*$self->{Pending} ; + + if (length(*$self->{Pending}) && + ($offset = index(*$self->{Pending}, $/)) >=0) { + my $l = substr(*$self->{Pending}, 0, $offset + length $/ ); + substr(*$self->{Pending}, 0, $offset + length $/) = ''; + return \$l; + } + while ($self->read($line) > 0 ) { - if ($line =~ s/^(.*?$endl)//s) { - *$self->{Pending} = $line ; - $. = ++ *$self->{LineNo} ; - my $l = $1 ; - return \$l ; + my $offset = index($line, $/); + if ($offset >= 0) { + my $l = substr($line, 0, $offset + length $/ ); + substr($line, 0, $offset + length $/) = ''; + $$p = $line; + return \$l; } } - $. = ++ *$self->{LineNo} if defined($line); + return \$line; } } @@ -1065,6 +1107,7 @@ sub getline my $current_append = *$self->{AppendOutput} ; *$self->{AppendOutput} = 1; my $lineref = $self->_getline(); + $. = ++ *$self->{LineNo} if defined $$lineref ; *$self->{AppendOutput} = $current_append; return $$lineref ; } @@ -1075,7 +1118,8 @@ sub getlines $self->croakError(*$self->{ClassName} . "::getlines: called in scalar context\n") unless wantarray; my($line, @lines); - push(@lines, $line) while defined($line = $self->getline); + push(@lines, $line) + while defined($line = $self->getline); return @lines; } @@ -1104,8 +1148,6 @@ sub ungetc sub trailingData { my $self = shift ; - #return \"" if ! defined *$self->{Trailing} ; - #return \*$self->{Trailing} ; if (defined *$self->{FH} || defined *$self->{InputEvent} ) { return *$self->{Prime} ; @@ -1113,7 +1155,7 @@ sub trailingData else { my $buf = *$self->{Buffer} ; my $offset = *$self->{BufferOffset} ; - return substr($$buf, $offset, -1) ; + return substr($$buf, $offset) ; } } @@ -1319,7 +1361,7 @@ purpose if to to be sub-classed by IO::Unompress modules. =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Base/private/MakeUtil.pm b/ext/Compress/IO/Base/private/MakeUtil.pm index a2cce29..af86677 100644 --- a/ext/Compress/IO/Base/private/MakeUtil.pm +++ b/ext/Compress/IO/Base/private/MakeUtil.pm @@ -123,6 +123,7 @@ sub UpDowngrade my $upgrade ; my $downgrade ; + my $do_downgrade ; my $caller = (caller(1))[3] || ''; @@ -134,6 +135,12 @@ sub UpDowngrade { $upgrade = 1; } + else + { + $do_downgrade = 1 + if $] < 5.006001 ; + } + # else # { # my $opt = shift @ARGV || '' ; @@ -142,7 +149,8 @@ sub UpDowngrade # push @ARGV, $opt unless $downgrade || $upgrade; # } - if ($downgrade) { + + if ($downgrade || $do_downgrade) { # From: use|no warnings "blah" # To: local ($^W) = 1; # use|no warnings "blah" $warn_sub = sub { @@ -150,7 +158,8 @@ sub UpDowngrade s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; }; } - elsif ($] >= 5.006001 || $upgrade) { + #elsif ($] >= 5.006001 || $upgrade) { + elsif ($upgrade) { # From: local ($^W) = 1; # use|no warnings "blah" # To: use|no warnings "blah" $warn_sub = sub { @@ -158,7 +167,7 @@ sub UpDowngrade }; } - if ($downgrade) { + if ($downgrade || $do_downgrade) { $our_sub = sub { if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { my $indent = $1; @@ -171,7 +180,8 @@ sub UpDowngrade } }; } - elsif ($] >= 5.006000 || $upgrade) { + #elsif ($] >= 5.006000 || $upgrade) { + elsif ($upgrade) { $our_sub = sub { if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { my $indent = $1; diff --git a/ext/Compress/IO/Base/t/01misc.t b/ext/Compress/IO/Base/t/01misc.t index ea40978..29b2a76 100644 --- a/ext/Compress/IO/Base/t/01misc.t +++ b/ext/Compress/IO/Base/t/01misc.t @@ -19,16 +19,11 @@ BEGIN { $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 69 + $extra ; - + plan tests => 76 + $extra ; use_ok('IO::Compress::Base::Common'); - - #use_ok('Compress::Zlib::ParseParameters'); - } - # Compress::Zlib::Common; sub My::testParseParameters() @@ -61,10 +56,27 @@ sub My::testParseParameters() like $@, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"), "wanted signed, got 'abc'"; - my $got = ParseParameters(1, {'Fred' => [1, 1, Parse_store_ref, 0]}, Fred => 'abc') ; - is ${ $got->value('Fred') }, "abc", "Parse_store_ref" ; + eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => 'abc') ; }; + like $@, mkErr("Parameter 'Fred' not writable"), + "wanted writable, got readonly"; + + my @xx; + eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => \@xx) ; }; + like $@, mkErr("Parameter 'Fred' not a scalar reference"), + "wanted scalar reference"; + + local *ABC; + eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => *ABC) ; }; + like $@, mkErr("Parameter 'Fred' not a scalar"), + "wanted scalar"; - $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ; + #eval { ParseParameters(1, {'Fred' => [1, 1, Parse_any|Parse_multiple, 0]}, Fred => 1, Fred => 2) ; }; + #like $@, mkErr("Muliple instances of 'Fred' found"), + #"wanted scalar"; + + ok 1; + + my $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ; is $got->value('Fred'), "abc", "other" ; $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred => @@ -77,6 +89,21 @@ undef) ; ok $got->parsed('Fred'), "undef" ; is $got->value('Fred'), "", "empty string" ; + my $xx; + $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => $xx) ; + + ok $got->parsed('Fred'), "parsed" ; + my $xx_ref = $got->value('Fred'); + $$xx_ref = 77 ; + is $xx, 77; + + $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => \$xx) ; + + ok $got->parsed('Fred'), "parsed" ; + $xx_ref = $got->value('Fred'); + $$xx_ref = 666 ; + is $xx, 666; + } My::testParseParameters(); diff --git a/ext/Compress/IO/Zlib/Changes b/ext/Compress/IO/Zlib/Changes index d052abe..b73b591 100644 --- a/ext/Compress/IO/Zlib/Changes +++ b/ext/Compress/IO/Zlib/Changes @@ -1,6 +1,28 @@ CHANGES ------- + 2.000_14 26 October 2006 + + * IO::Uncompress::Deflate + Beefed up the magic signature check. Means less false positives + when auto-detecting the compression type. + + * IO::Uncompress::UnZip + Tighten up the zip64 extra field processing to cope with the case + wheere only some of the local header fields are superceeded. + + * IO::Uncompress::AnyInflate + Remove raw-deflate (RFC 1951) from the default list of compressors + to check. + It can still be included if the new RawInflate parameter is + supplied. + This change was made because the only way to tell if content is + raw-deflate is to attempt to uncompress it - a few false positives + have popped up recently, which suggests that auto-detecting raw + deflate is far from perfect. + The equivalent change has been made to IO::Uncompress::AnyUncompress. + [Core patch #28445] + 2.000_13 20 June 2006 * Preliminary support for reading zip files with zip64 members. diff --git a/ext/Compress/IO/Zlib/README b/ext/Compress/IO/Zlib/README index 3812a7e..0dd5175 100644 --- a/ext/Compress/IO/Zlib/README +++ b/ext/Compress/IO/Zlib/README @@ -1,9 +1,9 @@ IO::Compress::Zlib - Version 2.000_13 + Version 2.000_14 - 20 June 2006 + 26th October 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 644920e..e728100 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_13'; +$VERSION = '2.000_14'; 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 0c8a60c..9c3f1e7 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Adapter/Identity.pm @@ -7,7 +7,7 @@ use bytes; use IO::Compress::Base::Common qw(:Status); our ($VERSION); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; sub mkCompObject { diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Deflate.pm index c9d0aac..d304fbd 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_13'; +$VERSION = '2.000_14'; $DeflateError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -248,6 +248,8 @@ data to files or buffer as defined in RFC 1950. + + For reading RFC 1950 files/buffers, see the companion module L. @@ -424,6 +426,7 @@ Defaults to 0. TODO + =back @@ -970,7 +973,7 @@ TODO =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm index 9e706d2..5d17194 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Gzip.pm @@ -27,7 +27,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; $GzipError = '' ; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -350,6 +350,8 @@ data to files or buffer as defined in RFC 1952. + + All the gzip headers defined in RFC 1952 can be created using this module. @@ -543,6 +545,7 @@ Defaults to 0. TODO + =back @@ -1285,7 +1288,7 @@ TODO =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L 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 0b1a7c1..3598b10 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_13'; +$VERSION = '2.000_14'; @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 3ad280b..0a916e2 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_13'; +$VERSION = '2.000_14'; $RawDeflateError = ''; @ISA = qw(Exporter IO::Compress::Base); @@ -327,6 +327,8 @@ data to files or buffer as defined in RFC 1951. + + Note that RFC 1951 data is not a good choice of compression format to use in isolation, especially if you want to auto-detect it. @@ -510,6 +512,7 @@ Defaults to 0. TODO + =back @@ -1056,7 +1059,7 @@ TODO =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm index adbdf23..908a4c3 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zip.pm @@ -27,7 +27,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; $ZipError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @@ -178,6 +178,7 @@ sub mkHeader } + # TODO - this code assumes Unix. my $extAttr = 0; $extAttr = $param->value('Mode') << 16 if defined $param->value('Mode') ; @@ -645,11 +646,13 @@ compressed data to files or buffer. -Note that IO::Compress::Zip is not intended to be a replacement for the module -C. -The primary aim of this module is not as an archiver, but to provide -streaming write access to zip file files and buffers. + + +The primary purpose of this module is to provide streaming write access to +zip files and buffers. It is not a general-purpose file archiver. If that +is what you want, check out C. + @@ -837,6 +840,7 @@ Defaults to 0. TODO + =back @@ -1061,6 +1065,8 @@ is 0), the output file must be seekable. The default is 1. + + =item C<< TextFlag => 0|1 >> This parameter controls the setting of a bit in the zip central header. It @@ -1511,7 +1517,7 @@ TODO =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L 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 f962b72..6e83a4a 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, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; @ISA = qw(Exporter); @@ -26,7 +26,10 @@ $VERSION = '2.000_13'; ZIP64_ARCHIVE_EXTRA_SIG ZIP64_DIGITAL_SIGNATURE_SIG + ZIP_GP_FLAG_ENCRYPTED_MASK ZIP_GP_FLAG_STREAMING_MASK + ZIP_GP_FLAG_PATCHED_MASK + ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK ZIP_EXTRA_ID_ZIP64 ZIP_EXTRA_ID_EXT_TIMESTAMP @@ -47,6 +50,8 @@ use constant ZIP_CM_BZIP2 => 12 ; # General Purpose Flag use constant ZIP_GP_FLAG_ENCRYPTED_MASK => 1 ; use constant ZIP_GP_FLAG_STREAMING_MASK => 8 ; +use constant ZIP_GP_FLAG_PATCHED_MASK => 32 ; +use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => 64 ; # Internal File Attributes use constant ZIP_IFA_TEXT_MASK => 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 7aa402b..96bced6 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_13'; +$VERSION = '2.000_14'; @ISA = qw(Exporter); @@ -24,6 +24,7 @@ $VERSION = '2.000_13'; ZLIB_CMF_CINFO_OFFSET ZLIB_CMF_CINFO_BITS + ZLIB_CMF_CINFO_MAX ZLIB_FLG_FCHECK_OFFSET ZLIB_FLG_FCHECK_BITS @@ -54,6 +55,7 @@ use constant ZLIB_CMF_CM_DEFLATED => 8; use constant ZLIB_CMF_CINFO_OFFSET => 4; use constant ZLIB_CMF_CINFO_BITS => 0xF ; # 0b1111; +use constant ZLIB_CMF_CINFO_MAX => 7; use constant ZLIB_FLG_FCHECK_OFFSET => 0; use constant ZLIB_FLG_FCHECK_BITS => 0x1F ; # 0b11111; diff --git a/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Extra.pm b/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Extra.pm index 8a9b9c4..4640829 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Extra.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Compress/Zlib/Extra.pm @@ -8,7 +8,7 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; use IO::Compress::Gzip::Constants; 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 628bfef..516e838 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_13'; +$VERSION = '2.000_14'; 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 99036a0..e313360 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_13'; +$VERSION = '2.000_14'; diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/AnyInflate.pm index d4a0882..915cd5f 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_13'; +$VERSION = '2.000_14'; $AnyInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -208,7 +208,7 @@ The formats supported are =item RFC 1950 -=item RFC 1951 +=item RFC 1951 (optionally) =item gzip (RFC 1952) @@ -223,7 +223,6 @@ compression formats is being used. - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -397,6 +396,7 @@ TODO =item C<< MultiStream => 0|1 >> + If the input file/buffer contains multiple compressed data streams, this option will uncompress the whole lot as a single data stream. @@ -404,6 +404,35 @@ Defaults to 0. + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. + + + =back @@ -675,9 +704,21 @@ uncompressed data actually read from the file. +=item C<< RawInflate => 0|1 >> -=item C<< ParseExtra => 0|1 >> +When auto-detecting the compressed format, try to test for raw-deflate (RFC +1951) content using the C module. +The reason this is not default behaviour is because RFC 1951 content can +only be detected by attempting to uncompress it. This process is error +prone and can result is false positives. + +Defaults to 0. + + + + +=item C<< ParseExtra => 0|1 >> If the gzip FEXTRA header field is present and this option is set, it will force the module to check that it conforms to the sub-field structure as defined in RFC 1952. @@ -689,7 +730,6 @@ Defaults to 0. - =back =head2 Examples @@ -743,10 +783,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -926,8 +966,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -938,7 +978,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -962,7 +1025,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm index 5eab533..e465bcb 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Gunzip.pm @@ -28,7 +28,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; sub new { @@ -361,7 +361,6 @@ For writing RFC 1952 files/buffers, see the companion module IO::Compress::Gzip. - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -535,6 +534,7 @@ TODO =item C<< MultiStream => 0|1 >> + If the input file/buffer contains multiple compressed data streams, this option will uncompress the whole lot as a single data stream. @@ -542,6 +542,35 @@ Defaults to 0. + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. + + + =back @@ -796,8 +825,8 @@ uncompressed data actually read from the file. -=item C<< ParseExtra => 0|1 >> +=item C<< ParseExtra => 0|1 >> If the gzip FEXTRA header field is present and this option is set, it will force the module to check that it conforms to the sub-field structure as defined in RFC 1952. @@ -809,7 +838,6 @@ Defaults to 0. - =back =head2 Examples @@ -863,10 +891,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -1064,8 +1092,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -1076,7 +1104,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -1100,7 +1151,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Inflate.pm index 1435321..2ec0a49 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_13'; +$VERSION = '2.000_14'; $InflateError = ''; @ISA = qw( Exporter IO::Uncompress::RawInflate ); @@ -66,8 +66,9 @@ sub ckMagic ZLIB_HEADER_SIZE . " bytes") if length $magic != ZLIB_HEADER_SIZE; - return $self->HeaderError("CRC mismatch.") - if ! isZlibMagic($magic) ; + #return $self->HeaderError("CRC mismatch.") + return undef + if ! $self->isZlibMagic($magic) ; *$self->{Type} = 'rfc1950'; return $magic; @@ -98,10 +99,31 @@ sub chkTrailer sub isZlibMagic { + my $self = shift; my $buffer = shift ; - return 0 if length $buffer < ZLIB_HEADER_SIZE ; + + return 0 + if length $buffer < ZLIB_HEADER_SIZE ; + my $hdr = unpack("n", $buffer) ; - return $hdr % 31 == 0 ; + #return 0 if $hdr % 31 != 0 ; + return $self->HeaderError("CRC mismatch.") + if $hdr % 31 != 0 ; + + my ($CMF, $FLG) = unpack "C C", $buffer; + my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; + + # Only Deflate supported + return $self->HeaderError("Not Deflate (CM is $cm)") + if $cm != ZLIB_CMF_CM_DEFLATED ; + + # Max window value is 7 for Deflate. + my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ; + return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . + " (CINFO is $cinfo)") + if $cinfo > ZLIB_CMF_CINFO_MAX ; + + return 1; } sub bits @@ -260,7 +282,6 @@ For writing RFC 1950 files/buffers, see the companion module IO::Compress::Defla - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -434,6 +455,7 @@ TODO =item C<< MultiStream => 0|1 >> + If the input file/buffer contains multiple compressed data streams, this option will uncompress the whole lot as a single data stream. @@ -441,6 +463,35 @@ Defaults to 0. + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. + + + =back @@ -671,6 +722,7 @@ uncompressed data actually contained in the file. + =back =head2 Examples @@ -724,10 +776,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -907,8 +959,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -919,7 +971,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -943,7 +1018,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/RawInflate.pm index 9fedb9c..53271ab 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_13'; +$VERSION = '2.000_14'; $RawInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -414,7 +414,6 @@ For writing RFC 1951 files/buffers, see the companion module IO::Compress::RawDe - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -588,10 +587,38 @@ TODO =item C<< MultiStream => 0|1 >> -If the input file/buffer contains multiple compressed data streams, this -option will uncompress the whole lot as a single data stream. -Defaults to 0. + +This option is a no-op. + + + + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. @@ -794,6 +821,7 @@ This option is a no-op. + =back =head2 Examples @@ -847,10 +875,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -1030,8 +1058,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -1042,7 +1070,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -1066,7 +1117,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm index ae123c9..67643ae 100644 --- a/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm +++ b/ext/Compress/IO/Zlib/lib/IO/Uncompress/Unzip.pm @@ -27,7 +27,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.000_13'; +$VERSION = '2.000_14'; $UnzipError = ''; @ISA = qw(Exporter IO::Uncompress::RawInflate); @@ -236,9 +236,10 @@ sub chkTrailer my $sig = unpack("V", $magic) ; - if ($headerLookup{$sig}) + my $hdr; + if ($hdr = $headerLookup{$sig}) { - if ($headerLookup{$sig}($self, $magic) != STATUS_OK ) { + if (&$hdr($self, $magic) != STATUS_OK ) { if (*$self->{Strict}) { return STATUS_ERROR ; } @@ -502,6 +503,12 @@ sub _readZipHeader($) return $self->HeaderError("Streamed Stored content not supported") if $streamingMode && $compressedMethod == 0 ; + return $self->HeaderError("Encrypted content not supported") + if $gpFlag & (ZIP_GP_FLAG_ENCRYPTED_MASK|ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK); + + return $self->HeaderError("Patch content not supported") + if $gpFlag & ZIP_GP_FLAG_PATCHED_MASK; + *$self->{ZipData}{Streaming} = $streamingMode; @@ -538,10 +545,28 @@ sub _readZipHeader($) my $buff = ${ $Extra{ZIP_EXTRA_ID_ZIP64()} }; - $uncompressedLength = U64::newUnpack_V64 substr($buff, 0, 8); - $compressedLength = U64::newUnpack_V64 substr($buff, 8, 8); - #my $cheaderOffset = U64::newUnpack_V64 substr($buff, 16, 8); - #my $diskNumber = unpack ("V", substr($buff, 24, 4)); + # TODO - This code assumes that all the fields in the Zip64 + # extra field aren't necessarily present. The spec says that + # they only exist if the equivalent local headers are -1. + # Need to check that info-zip fills out -1 in the local header + # correctly. + + if (! $streamingMode) { + my $offset = 0 ; + + $uncompressedLength = U64::newUnpack_V64 substr($buff, 0, 8) + if $uncompressedLength == 0xFFFF ; + + $offset += 8 ; + + $compressedLength = U64::newUnpack_V64 substr($buff, $offset, 8) + if $compressedLength == 0xFFFF ; + + $offset += 8 ; + + #my $cheaderOffset = U64::newUnpack_V64 substr($buff, 16, 8); + #my $diskNumber = unpack ("V", substr($buff, 24, 4)); + } } } @@ -763,7 +788,6 @@ For writing zip files/buffers, see the companion module IO::Compress::Zip. - =head1 Functional Interface A top-level function, C, is provided to carry out @@ -937,6 +961,7 @@ TODO =item C<< MultiStream => 0|1 >> + If the input file/buffer contains multiple compressed data streams, this option will uncompress the whole lot as a single data stream. @@ -944,6 +969,35 @@ Defaults to 0. + + +=item C<< TrailingData => $scalar >> + +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option. + + + =back @@ -1159,6 +1213,7 @@ The default for this option is off. + =back =head2 Examples @@ -1212,10 +1267,10 @@ Usage is Reads a single line. -This method fully supports the use of of the variable C<$/> -(or C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to -determine what constitutes an end of line. Both paragraph mode and file -slurp mode are supported. +This method fully supports the use of of the variable C<$/> (or +C<$INPUT_RECORD_SEPARATOR> or C<$RS> when C is in use) to +determine what constitutes an end of line. Paragraph mode, record mode and +file slurp mode are all supported. =head2 getc @@ -1395,8 +1450,8 @@ Usage is my $status = $z->nextStream(); Skips to the next compressed data stream in the input file/buffer. If a new -compressed data stream is found, the eof marker will be cleared, C<$.> will -be reset to 0. +compressed data stream is found, the eof marker will be cleared and C<$.> +will be reset to 0. Returns 1 if a new stream was found, 0 if none was found, and -1 if an error was encountered. @@ -1407,7 +1462,30 @@ Usage is my $data = $z->trailingData(); -Returns any data that +Returns the data, if any, that is present immediately after the compressed +data stream once uncompression is complete. It only makes sense to call +this method once the end of the compressed data stream has been +encountered. + +This option can be used when there is useful information immediately +following the compressed data stream, and you don't know the length of the +compressed data stream. + +If the input is a buffer, C will return everything from the +end of the compressed data stream to the end of the buffer. + +If the input is a filehandle, C will return the data that is +left in the filehandle input buffer once the end of the compressed data +stream has been reached. You can then use the filehandle to read the rest +of the input file. + +Don't bother using C if the input is a filename. + + + +If you know the length of the compressed data stream before you start +uncompressing, you can avoid having to use C by setting the +C option in the constructor. =head1 Importing @@ -1431,7 +1509,7 @@ Same as doing this =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/IO/Zlib/private/MakeUtil.pm b/ext/Compress/IO/Zlib/private/MakeUtil.pm index a2cce29..af86677 100644 --- a/ext/Compress/IO/Zlib/private/MakeUtil.pm +++ b/ext/Compress/IO/Zlib/private/MakeUtil.pm @@ -123,6 +123,7 @@ sub UpDowngrade my $upgrade ; my $downgrade ; + my $do_downgrade ; my $caller = (caller(1))[3] || ''; @@ -134,6 +135,12 @@ sub UpDowngrade { $upgrade = 1; } + else + { + $do_downgrade = 1 + if $] < 5.006001 ; + } + # else # { # my $opt = shift @ARGV || '' ; @@ -142,7 +149,8 @@ sub UpDowngrade # push @ARGV, $opt unless $downgrade || $upgrade; # } - if ($downgrade) { + + if ($downgrade || $do_downgrade) { # From: use|no warnings "blah" # To: local ($^W) = 1; # use|no warnings "blah" $warn_sub = sub { @@ -150,7 +158,8 @@ sub UpDowngrade s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; }; } - elsif ($] >= 5.006001 || $upgrade) { + #elsif ($] >= 5.006001 || $upgrade) { + elsif ($upgrade) { # From: local ($^W) = 1; # use|no warnings "blah" # To: use|no warnings "blah" $warn_sub = sub { @@ -158,7 +167,7 @@ sub UpDowngrade }; } - if ($downgrade) { + if ($downgrade || $do_downgrade) { $our_sub = sub { if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { my $indent = $1; @@ -171,7 +180,8 @@ sub UpDowngrade } }; } - elsif ($] >= 5.006000 || $upgrade) { + #elsif ($] >= 5.006000 || $upgrade) { + elsif ($upgrade) { $our_sub = sub { if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { my $indent = $1; diff --git a/ext/Compress/Raw/Zlib/Changes b/ext/Compress/Raw/Zlib/Changes index d48a762..fa4b7a8 100644 --- a/ext/Compress/Raw/Zlib/Changes +++ b/ext/Compress/Raw/Zlib/Changes @@ -1,6 +1,16 @@ CHANGES ------- + 2.000_14 26 October 2006 + + * Fixed memory leak on realloc. + + * Ticket #18986 says that ExtUtils::Install 1.39 fixes the in-use + issue on win32/cygwin, so make the code that checks whether trying + to install via the cpan shell conditional on the version of + ExtUtils::Install. + http://rt.cpan.org/Ticket/Display.html?id=18986 + 2.000_10 13 March 2006 * Fixed a potential NULL pointer dereference problem in diff --git a/ext/Compress/Raw/Zlib/Makefile.PL b/ext/Compress/Raw/Zlib/Makefile.PL index a5a89c5..294c87f 100644 --- a/ext/Compress/Raw/Zlib/Makefile.PL +++ b/ext/Compress/Raw/Zlib/Makefile.PL @@ -5,6 +5,7 @@ require 5.004 ; use private::MakeUtil; use ExtUtils::MakeMaker 5.16 ; +use ExtUtils::Install (); # only needed to check for version my $ZLIB_LIB ; my $ZLIB_INCLUDE ; @@ -16,15 +17,20 @@ my $GZIP_OS_CODE = -1 ; #$WALL = ' -pedantic ' if $Config{'cc'} =~ /gcc/ ; #$WALL = ' -Wall -Wno-comment ' if $Config{'cc'} =~ /gcc/ ; -# don't ask if MM_USE_DEFAULT is set -- enables perl core building on cygwin -if ($^O =~ /cygwin/i and not ($ENV{PERL_MM_USE_DEFAULT} or $ENV{PERL_CORE})) +# Ticket #18986 says that ExtUtils::Install 1.39 fixes the in-use issue +# on win32/cygwin, so make the code below conditional on the version of +# ExtUtils::Install. + +# Don't ask if MM_USE_DEFAULT is set -- enables perl core building on cygwin +if ($^O =~ /cygwin/i and $ExtUtils::Install::VERSION < 1.39 + and not ($ENV{PERL_MM_USE_DEFAULT} or $ENV{PERL_CORE})) { print <= 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 4 )) # define UTF8_AVAILABLE @@ -160,7 +105,6 @@ typedef struct di_stream { uLong adler32 ; z_stream stream; uLong bufsize; - uLong bufinc; SV * dictionary ; uLong dict_adler ; int last_error ; @@ -598,7 +542,6 @@ PostInitStream(s, flags, bufsize, windowBits) #endif { s->bufsize = bufsize ; - s->bufinc = bufsize ; s->compressedBytes = s->uncompressedBytes = s->last_error = 0 ; @@ -956,7 +899,9 @@ deflate (s, buf, output) uInt increment = NO_INIT uInt prefix = NO_INIT int RETVAL = 0; + uLong bufinc = NO_INIT CODE: + bufinc = s->bufsize; /* If the input buffer is a reference, dereference it */ buf = deRef(buf, "deflate") ; @@ -1022,12 +967,12 @@ deflate (s, buf, output) if (s->stream.avail_out == 0) { /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; + Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; + increment = bufinc ; s->stream.avail_out = increment; - s->bufinc *= 2 ; + bufinc *= 2 ; } RETVAL = deflate(&(s->stream), Z_NO_FLUSH); @@ -1070,7 +1015,9 @@ flush(s, output, f=Z_FINISH) uInt cur_length = NO_INIT uInt increment = NO_INIT uInt prefix = NO_INIT + uLong bufinc = NO_INIT CODE: + bufinc = s->bufsize; s->stream.avail_in = 0; /* should be zero already anyway */ @@ -1120,12 +1067,12 @@ flush(s, output, f=Z_FINISH) for (;;) { if (s->stream.avail_out == 0) { /* consumed all the available output, so extend it */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; + Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; + increment = bufinc ; s->stream.avail_out = increment; - s->bufinc *= 2 ; + bufinc *= 2 ; } RETVAL = deflate(&(s->stream), f); @@ -1166,7 +1113,6 @@ _deflateParams(s, flags, level, strategy, bufsize) s->Strategy = strategy ; if (flags & 4) { s->bufsize = bufsize; - s->bufinc = bufsize; } /* printf("After -- Level %d, Strategy %d, Bufsize %d\n", s->Level, s->Strategy, s->bufsize);*/ #ifdef SETP_BYTE @@ -1340,11 +1286,13 @@ inflate (s, buf, output, eof=FALSE) uInt prefix_length = 0; uInt increment = 0; STRLEN stmp = NO_INIT + uLong bufinc = NO_INIT PREINIT: #ifdef UTF8_AVAILABLE bool out_utf8 = FALSE; #endif CODE: + bufinc = s->bufsize; /* If the buffer is a reference, dereference it */ buf = deRef(buf, "inflate") ; @@ -1383,14 +1331,14 @@ inflate (s, buf, output, eof=FALSE) while (1) { - if (s->stream.avail_out == 0) { + if (s->stream.avail_out == 0 ) { /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; + Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; + increment = bufinc ; s->stream.avail_out = increment; - s->bufinc *= 2 ; + bufinc *= 2 ; } RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH); @@ -1426,12 +1374,12 @@ inflate (s, buf, output, eof=FALSE) s->stream.avail_in = 1; if (s->stream.avail_out == 0) { /* out of space in the output buffer so make it bigger */ - Sv_Grow(output, SvLEN(output) + s->bufinc) ; + Sv_Grow(output, SvLEN(output) + bufinc) ; cur_length += increment ; s->stream.next_out = (Bytef*) SvPVbyte_nolen(output) + cur_length ; - increment = s->bufinc ; + increment = bufinc ; s->stream.avail_out = increment; - s->bufinc *= 2 ; + bufinc *= 2 ; } RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH); s->stream.next_in = nextIn ; diff --git a/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm b/ext/Compress/Raw/Zlib/lib/Compress/Raw/Zlib.pm index f2677ab..b96d0ee 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_13'; +$VERSION = '2.000_14'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -1152,7 +1152,7 @@ of I. =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/Raw/Zlib/private/MakeUtil.pm b/ext/Compress/Raw/Zlib/private/MakeUtil.pm index a2cce29..af86677 100644 --- a/ext/Compress/Raw/Zlib/private/MakeUtil.pm +++ b/ext/Compress/Raw/Zlib/private/MakeUtil.pm @@ -123,6 +123,7 @@ sub UpDowngrade my $upgrade ; my $downgrade ; + my $do_downgrade ; my $caller = (caller(1))[3] || ''; @@ -134,6 +135,12 @@ sub UpDowngrade { $upgrade = 1; } + else + { + $do_downgrade = 1 + if $] < 5.006001 ; + } + # else # { # my $opt = shift @ARGV || '' ; @@ -142,7 +149,8 @@ sub UpDowngrade # push @ARGV, $opt unless $downgrade || $upgrade; # } - if ($downgrade) { + + if ($downgrade || $do_downgrade) { # From: use|no warnings "blah" # To: local ($^W) = 1; # use|no warnings "blah" $warn_sub = sub { @@ -150,7 +158,8 @@ sub UpDowngrade s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; }; } - elsif ($] >= 5.006001 || $upgrade) { + #elsif ($] >= 5.006001 || $upgrade) { + elsif ($upgrade) { # From: local ($^W) = 1; # use|no warnings "blah" # To: use|no warnings "blah" $warn_sub = sub { @@ -158,7 +167,7 @@ sub UpDowngrade }; } - if ($downgrade) { + if ($downgrade || $do_downgrade) { $our_sub = sub { if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { my $indent = $1; @@ -171,7 +180,8 @@ sub UpDowngrade } }; } - elsif ($] >= 5.006000 || $upgrade) { + #elsif ($] >= 5.006000 || $upgrade) { + elsif ($upgrade) { $our_sub = sub { if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { my $indent = $1; diff --git a/ext/Compress/Zlib/Changes b/ext/Compress/Zlib/Changes index 9122642..cee6519 100644 --- a/ext/Compress/Zlib/Changes +++ b/ext/Compress/Zlib/Changes @@ -1,6 +1,10 @@ CHANGES ------- + 2.000_14 26 October 2006 + + * No changes. + 2.000_13 20 June 2006 * No changes. diff --git a/ext/Compress/Zlib/README b/ext/Compress/Zlib/README index f2c6285..88c2dc7 100644 --- a/ext/Compress/Zlib/README +++ b/ext/Compress/Zlib/README @@ -1,9 +1,9 @@ Compress::Zlib - Version 2.000_13 + Version 2.000_14 - 20 June 2006 + 26th October 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 8e6f8cd..8532508 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_13'; +$VERSION = '2.000_14'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -1407,7 +1407,7 @@ of I. =head1 SEE ALSO -L, L, L, L, L, L, L, L, L, L, L, L +L, L, L, L, L, L, L, L, L, L, L, L, L, L L diff --git a/ext/Compress/Zlib/private/MakeUtil.pm b/ext/Compress/Zlib/private/MakeUtil.pm index a2cce29..af86677 100644 --- a/ext/Compress/Zlib/private/MakeUtil.pm +++ b/ext/Compress/Zlib/private/MakeUtil.pm @@ -123,6 +123,7 @@ sub UpDowngrade my $upgrade ; my $downgrade ; + my $do_downgrade ; my $caller = (caller(1))[3] || ''; @@ -134,6 +135,12 @@ sub UpDowngrade { $upgrade = 1; } + else + { + $do_downgrade = 1 + if $] < 5.006001 ; + } + # else # { # my $opt = shift @ARGV || '' ; @@ -142,7 +149,8 @@ sub UpDowngrade # push @ARGV, $opt unless $downgrade || $upgrade; # } - if ($downgrade) { + + if ($downgrade || $do_downgrade) { # From: use|no warnings "blah" # To: local ($^W) = 1; # use|no warnings "blah" $warn_sub = sub { @@ -150,7 +158,8 @@ sub UpDowngrade s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ; }; } - elsif ($] >= 5.006001 || $upgrade) { + #elsif ($] >= 5.006001 || $upgrade) { + elsif ($upgrade) { # From: local ($^W) = 1; # use|no warnings "blah" # To: use|no warnings "blah" $warn_sub = sub { @@ -158,7 +167,7 @@ sub UpDowngrade }; } - if ($downgrade) { + if ($downgrade || $do_downgrade) { $our_sub = sub { if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) { my $indent = $1; @@ -171,7 +180,8 @@ sub UpDowngrade } }; } - elsif ($] >= 5.006000 || $upgrade) { + #elsif ($] >= 5.006000 || $upgrade) { + elsif ($upgrade) { $our_sub = sub { if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) { my $indent = $1; diff --git a/t/lib/compress/CompTestUtils.pm b/t/lib/compress/CompTestUtils.pm index 7e583a0..85d53ba 100644 --- a/t/lib/compress/CompTestUtils.pm +++ b/t/lib/compress/CompTestUtils.pm @@ -6,7 +6,11 @@ use strict ; use warnings; use bytes; +#use lib qw(t t/compress); + use Carp ; +#use Test::More ; + sub title @@ -216,6 +220,8 @@ sub uncompressBuffer 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip', 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf' , + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf', 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp', ); @@ -255,6 +261,10 @@ my %ErrorMap = ( 'IO::Compress::Gzip' => \$IO::Compress::Gzip: 'IO::Compress::Lzop::lzop' => \$IO::Compress::Lzop::LzopError, 'IO::Uncompress::UnLzop' => \$IO::Uncompress::UnLzop::UnLzopError, 'IO::Uncompress::UnLzop::unlzop' => \$IO::Uncompress::UnLzop::UnLzopError, + 'IO::Compress::Lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Compress::Lzf::lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Uncompress::UnLzf' => \$IO::Uncompress::UnLzf::UnLzfError, + 'IO::Uncompress::UnLzf::unlzf' => \$IO::Uncompress::UnLzf::UnLzfError, 'IO::Compress::DummyComp' => \$IO::Compress::DummyComp::DummyCompError, 'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError, @@ -281,6 +291,8 @@ my %TopFuncMap = ( 'IO::Compress::Gzip' => 'IO::Compress::Gzip::gzip', 'IO::Uncompress::Unzip' => 'IO::Uncompress::Unzip::unzip', 'IO::Compress::Lzop' => 'IO::Compress::Lzop::lzop', 'IO::Uncompress::UnLzop' => 'IO::Uncompress::UnLzop::unlzop', + 'IO::Compress::Lzf' => 'IO::Compress::Lzf::lzf', + 'IO::Uncompress::UnLzf' => 'IO::Uncompress::UnLzf::unlzf', 'IO::Compress::DummyComp' => 'IO::Compress::DummyComp::dummyuncomp', 'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', ); @@ -305,6 +317,8 @@ my %inverse = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gun 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop::unlzop', 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf::unlzf', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf', 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', ); @@ -356,6 +370,8 @@ sub compressBuffer 'IO::Uncompress::Unzip::unzip' => 'IO::Compress::Zip', 'IO::Uncompress::UnLzop' => 'IO::Compress::Lzop', 'IO::Uncompress::UnLzop::unlzop' => 'IO::Compress::Lzop', + 'IO::Uncompress::UnLzp' => 'IO::Compress::Lzf', + 'IO::Uncompress::UnLzf::unlzf' => 'IO::Compress::Lzf', 'IO::Uncompress::AnyInflate' => 'IO::Compress::Gzip', 'IO::Uncompress::AnyInflate::anyinflate' => 'IO::Compress::Gzip', 'IO::Uncompress::AnyUncompress' => 'IO::Compress::Gzip', @@ -374,8 +390,7 @@ sub compressBuffer our ($AnyUncompressError); BEGIN { - eval { require IO::Uncompress::AnyUncompress ; - import IO::Uncompress::AnyUncompress qw($AnyUncompressError) } ; + eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); '; } sub anyUncompress @@ -593,6 +608,35 @@ sub dumpObj } +sub getMultiValues +{ + my $class = shift ; + + return (0,0) if $class =~ /lzf/i; + return (1,0); +} + package CompTestUtils; 1; +__END__ + t/Test/Builder.pm + t/Test/More.pm + t/Test/Simple.pm + t/compress/CompTestUtils.pm + t/compress/any.pl + t/compress/anyunc.pl + t/compress/destroy.pl + t/compress/generic.pl + t/compress/merge.pl + t/compress/multi.pl + t/compress/newtied.pl + t/compress/oneshot.pl + t/compress/prime.pl + t/compress/tied.pl + t/compress/truncate.pl + t/compress/zlib-generic.plParsing config.in... +Building Zlib enabled +Auto Detect Gzip OS Code.. +Setting Gzip OS Code to 3 [Unix/Default] +Looks Good. diff --git a/t/lib/compress/generic.pl b/t/lib/compress/generic.pl index 04132fe..b11997c 100644 --- a/t/lib/compress/generic.pl +++ b/t/lib/compress/generic.pl @@ -18,7 +18,7 @@ BEGIN $extra = 1 if $st ; - plan(tests => 615 + $extra) ; + plan(tests => 639 + $extra) ; } sub myGZreadFile @@ -161,6 +161,7 @@ sub run my $lex = new LexFile my $name ; + #my $name = "/tmp/try.lzf"; my $hello = <write($hello) ; + ok $x->close ; + $compressed .= $trailer ; + } + + my $uncomp; + ok my $x = new $UncompressClass(\$compressed, Append => 1) ; + 1 while $x->read($uncomp) > 0 ; + + ok $uncomp eq $hello ; + is $x->trailingData(), $trailer ; + + } + + { # Write # these tests come almost 100% from IO::String @@ -600,7 +632,8 @@ EOM is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" . ("1234567890" x 3) . "67890\n" . - "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n"; + "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n", + "myGZreadFile ok"; } @@ -630,8 +663,8 @@ EOT is $., 0; is $io->input_line_number, 0; - ok ! $io->eof; - is $io->tell(), 0 ; + ok ! $io->eof, "eof"; + is $io->tell(), 0, "tell 0" ; #my @lines = <$io>; my @lines = $io->getlines(); is @lines, 6 @@ -689,6 +722,29 @@ EOT } { + # Record mode + my $reclen = 7 ; + my $expected_records = int(length($str) / $reclen) + + (length($str) % $reclen ? 1 : 0); + local $/ = \$reclen; + + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + + ok ! $io->eof; + my @lines = $io->getlines(); + is $., $expected_records; + is $io->input_line_number, $expected_records; + ok $io->eof; + is @lines, $expected_records, + "Got $expected_records records\n" ; + ok $lines[0] eq substr($str, 0, $reclen) + or print "# $lines[0]\n"; + ok $lines[1] eq substr($str, $reclen, $reclen); + } + + { local $/ = "is"; my $io = $UncompressClass->new($name); my @lines = (); @@ -725,11 +781,11 @@ EOT is $io->read($buf, 0), 0, "Requested 0 bytes" ; - ok $io->read($buf, 3) == 3 ; - ok $buf eq "Thi"; + is $io->read($buf, 3), 3 ; + is $buf, "Thi"; - ok $io->sysread($buf, 3, 2) == 3 ; - ok $buf eq "Ths i" + is $io->sysread($buf, 3, 2), 3 ; + is $buf, "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; @@ -824,6 +880,29 @@ EOT } { + # Record mode + my $reclen = 7 ; + my $expected_records = int(length($str) / $reclen) + + (length($str) % $reclen ? 1 : 0); + local $/ = \$reclen; + + my $io = $UncompressClass->new($name); + is $., 0; + is $io->input_line_number, 0; + + ok ! $io->eof; + my @lines = $io->getlines(); + is $., $expected_records; + is $io->input_line_number, $expected_records; + ok $io->eof; + is @lines, $expected_records, + "Got $expected_records records\n" ; + ok $lines[0] eq substr($str, 0, $reclen) + or print "# $lines[0]\n"; + ok $lines[1] eq substr($str, $reclen, $reclen); + } + + { local $/ = "is"; my $io = $UncompressClass->new($name); my @lines = (); diff --git a/t/lib/compress/multi.pl b/t/lib/compress/multi.pl index c6aaa7d..9daff1a 100644 --- a/t/lib/compress/multi.pl +++ b/t/lib/compress/multi.pl @@ -162,7 +162,8 @@ EOM my $lines = @lines; my $un = ''; - while (<$gz>) { + #while (<$gz>) { + while ($_ = $gz->getline()) { $un .= $_; } is $., $lines, " \$. is $lines"; @@ -181,7 +182,9 @@ EOM { my $un = ''; - 1 while $gz->read($un) > 0 ; + #1 while $gz->read($un) > 0 ; + is $., 0, " \$. is 0"; + $gz->read($un) ; #print "[[$un]]\n" while $gz->read($un) > 0 ; ok ! $gz->error(), " ! error()" or diag "Error is " . $gz->error() ; @@ -190,7 +193,6 @@ EOM or diag "Stream count is " . $gz->streamCount(); ok $un eq "", " expected output" ; is $gz->tell(), 0, " tell is 0"; - is $., 0, " \$. is 0"; } is $gz->nextStream(), 0, " nextStream ok"; diff --git a/t/lib/compress/oneshot.pl b/t/lib/compress/oneshot.pl index 50425df..64588c2 100644 --- a/t/lib/compress/oneshot.pl +++ b/t/lib/compress/oneshot.pl @@ -16,7 +16,7 @@ BEGIN { $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 956 + $extra ; + plan tests => 970 + $extra ; use_ok('IO::Uncompress::AnyUncompress', qw(anyuncompress $AnyUncompressError)) ; @@ -32,6 +32,7 @@ sub run my $TopFuncName = getTopFuncName($CompressClass); + my @MultiValues = getMultiValues($CompressClass); foreach my $bit ($CompressClass, $UncompressClass, 'IO::Uncompress::AnyUncompress', @@ -159,6 +160,29 @@ sub run my $Func = getTopFuncRef($bit); my $TopType = getTopFuncName($bit); + { + my $in ; + my $out ; + my @x ; + + eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ; + like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"), + ' TrailingData output not writable'; + + eval { $a = $Func->(\$in, \$out, TrailingData => \@x) ;} ; + like $@, mkErr("^$TopType: Parameter 'TrailingData' not a scalar reference"), + ' TrailingData output not scaral reference'; + } + } + + foreach my $bit ($UncompressClass, + 'IO::Uncompress::AnyUncompress', + ) + { + my $Error = getErrorRef($bit); + my $Func = getTopFuncRef($bit); + my $TopType = getTopFuncName($bit); + my $data = "mary had a little lamb" ; my $keep = $data ; @@ -505,7 +529,7 @@ sub run } - foreach my $ms (1, 0) + foreach my $ms (@MultiValues) { { title "$TopType - From Array Ref to Buffer, MultiStream $ms" ; @@ -566,6 +590,61 @@ sub run } } + foreach my $bit ($UncompressClass, + #'IO::Uncompress::AnyUncompress', + ) + { + my $Error = getErrorRef($bit); + my $Func = getTopFuncRef($bit); + my $TopType = getTopFuncName($bit); + my $CompressClass = getInverse($bit); + my $C_Func = getTopFuncRef($CompressClass); + + + + my $data = "mary had a little lamb" ; + my $keep = $data ; + my $extra = "after the main event"; + + foreach my $fb ( qw( filehandle buffer ) ) + { + title "Trailingdata with $TopType, from $fb"; + + my $lex = new LexFile my $name ; + my $input ; + + my $compressed ; + ok &$C_Func(\$data, \$compressed), ' Compressed ok' ; + $compressed .= $extra; + + if ($fb eq 'buffer') + { + $input = \$compressed; + } + else + { + writeFile($name, $compressed); + + $input = new IO::File "<$name" ; + } + + my $trailing; + my $out; + ok $Func->($input, \$out, TrailingData => $trailing), " Uncompressed OK" ; + is $out, $keep, " Got uncompressed data"; + + my $rest = ''; + if ($fb eq 'filehandle') + { + read($input, $rest, 10000) ; + } + + is $trailing . $rest, $extra, " Got trailing data"; + + } + } + + # foreach my $bit ($CompressClass) # { # my $Error = getErrorRef($bit); @@ -809,7 +888,7 @@ sub run is @copy, 0, " got all files"; } - foreach my $ms (0, 1) + foreach my $ms (@MultiValues) { { title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ; @@ -889,8 +968,8 @@ sub run my $incumbent = "incumbent data" ; - my @opts = (); - @opts = (RawInflate => 1) + my @opts = (Strict => 1); + push @opts, (RawInflate => 1) if $bit eq 'IO::Uncompress::AnyUncompress'; for my $append (0, 1)