diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Compress')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Compress/Raw/Bzip2.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Compress/Raw/Zlib.pm | 101 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Compress/Zlib.pm | 143 |
3 files changed, 136 insertions, 112 deletions
diff --git a/Master/tlpkg/tlperl/lib/Compress/Raw/Bzip2.pm b/Master/tlpkg/tlperl/lib/Compress/Raw/Bzip2.pm index 43a5fbcc5bb..e2fba4ff5d8 100644 --- a/Master/tlpkg/tlperl/lib/Compress/Raw/Bzip2.pm +++ b/Master/tlpkg/tlperl/lib/Compress/Raw/Bzip2.pm @@ -12,7 +12,7 @@ use Carp ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); -$VERSION = '2.048'; +$VERSION = '2.060'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -379,7 +379,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2012 Paul Marquess. All rights reserved. +Copyright (c) 2005-2013 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/lib/Compress/Raw/Zlib.pm b/Master/tlpkg/tlperl/lib/Compress/Raw/Zlib.pm index 3a4bcfffda6..acf599daa25 100644 --- a/Master/tlpkg/tlperl/lib/Compress/Raw/Zlib.pm +++ b/Master/tlpkg/tlperl/lib/Compress/Raw/Zlib.pm @@ -11,7 +11,7 @@ use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS ); -$VERSION = '2.048'; +$VERSION = '2.060'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -138,10 +138,10 @@ use constant Parse_any => 0x01; use constant Parse_unsigned => 0x02; use constant Parse_signed => 0x04; use constant Parse_boolean => 0x08; -use constant Parse_string => 0x10; -use constant Parse_custom => 0x12; +#use constant Parse_string => 0x10; +#use constant Parse_custom => 0x12; -use constant Parse_store_ref => 0x100 ; +#use constant Parse_store_ref => 0x100 ; use constant OFF_PARSED => 0 ; use constant OFF_TYPE => 1 ; @@ -297,14 +297,14 @@ sub Compress::Raw::Zlib::Parameters::_checkType #local $Carp::CarpLevel = $level ; #print "PARSE $type $key $value $validate $sub\n" ; - if ( $type & Parse_store_ref) - { - #$value = $$value - # if ref ${ $value } ; - - $$output = $value ; - return 1; - } +# if ( $type & Parse_store_ref) +# { +# #$value = $$value +# # if ref ${ $value } ; +# +# $$output = $value ; +# return 1; +# } $value = $$value ; @@ -340,11 +340,11 @@ sub Compress::Raw::Zlib::Parameters::_checkType $$output = defined $value ? $value != 0 : 0 ; return 1; } - elsif ($type & Parse_string) - { - $$output = defined $value ? $value : "" ; - return 1; - } +# elsif ($type & Parse_string) +# { +# $$output = defined $value ? $value : "" ; +# return 1; +# } $$output = $value ; return 1; @@ -375,24 +375,25 @@ sub Compress::Raw::Zlib::Parameters::value return $self->{Got}{lc $name}[OFF_FIXED] ; } +our $OPTIONS_deflate = + { + 'AppendOutput' => [1, 1, Parse_boolean, 0], + 'CRC32' => [1, 1, Parse_boolean, 0], + 'ADLER32' => [1, 1, Parse_boolean, 0], + 'Bufsize' => [1, 1, Parse_unsigned, 4096], + + 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], + 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], + 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], + 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], + 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'Dictionary' => [1, 1, Parse_any, ""], + }; + sub Compress::Raw::Zlib::Deflate::new { my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'AppendOutput' => [1, 1, Parse_boolean, 0], - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - + my ($got) = ParseParameters(0, $OPTIONS_deflate, @_); croak "Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified " . $got->value('Bufsize') @@ -431,22 +432,23 @@ sub Compress::Raw::Zlib::deflateStream::STORABLE_thaw } +our $OPTIONS_inflate = + { + 'AppendOutput' => [1, 1, Parse_boolean, 0], + 'LimitOutput' => [1, 1, Parse_boolean, 0], + 'CRC32' => [1, 1, Parse_boolean, 0], + 'ADLER32' => [1, 1, Parse_boolean, 0], + 'ConsumeInput' => [1, 1, Parse_boolean, 1], + 'Bufsize' => [1, 1, Parse_unsigned, 4096], + + 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], + 'Dictionary' => [1, 1, Parse_any, ""], + } ; + sub Compress::Raw::Zlib::Inflate::new { my $pkg = shift ; - my ($got) = ParseParameters(0, - { - 'AppendOutput' => [1, 1, Parse_boolean, 0], - 'LimitOutput' => [1, 1, Parse_boolean, 0], - 'CRC32' => [1, 1, Parse_boolean, 0], - 'ADLER32' => [1, 1, Parse_boolean, 0], - 'ConsumeInput' => [1, 1, Parse_boolean, 1], - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], - }, @_) ; - + my ($got) = ParseParameters(0, $OPTIONS_inflate, @_); croak "Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified " . $got->value('Bufsize') @@ -1452,9 +1454,10 @@ C<$input>. =head1 ACCESSING ZIP FILES Although it is possible (with some effort on your part) to use this module -to access .zip files, there are other perl modules available that will -do all the hard work for you. Check out C<Archive::Zip>, -C<IO::Compress::Zip> and C<IO::Uncompress::Unzip>. +to access .zip files, there are other perl modules available that will do +all the hard work for you. Check out C<Archive::Zip>, +C<Archive::Zip::SimpleZip>, C<IO::Compress::Zip> and +C<IO::Uncompress::Unzip>. =head1 FAQ @@ -1589,7 +1592,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2012 Paul Marquess. All rights reserved. +Copyright (c) 2005-2013 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/lib/Compress/Zlib.pm b/Master/tlpkg/tlperl/lib/Compress/Zlib.pm index db13bb03860..c5525ce1f92 100644 --- a/Master/tlpkg/tlperl/lib/Compress/Zlib.pm +++ b/Master/tlpkg/tlperl/lib/Compress/Zlib.pm @@ -7,17 +7,17 @@ use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); -use IO::Compress::Base::Common 2.048 ; -use Compress::Raw::Zlib 2.048 ; -use IO::Compress::Gzip 2.048 ; -use IO::Uncompress::Gunzip 2.048 ; +use IO::Compress::Base::Common 2.060 ; +use Compress::Raw::Zlib 2.060 ; +use IO::Compress::Gzip 2.060 ; +use IO::Uncompress::Gunzip 2.060 ; use strict ; use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.048'; +$VERSION = '2.060'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -315,7 +315,14 @@ sub compress($;$) my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); - $x = new Compress::Raw::Zlib::Deflate -AppendOutput => 1, -Level => $level + $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND, + $level, + Z_DEFLATED, + MAX_WBITS, + MAX_MEM_LEVEL, + Z_DEFAULT_STRATEGY, + 4096, + '') or return undef ; $err = $x->deflate($in, $output) ; @@ -325,12 +332,11 @@ sub compress($;$) return undef unless $err == Z_OK() ; return $output ; - } sub uncompress($) { - my ($x, $output, $err, $in) =('', '', '', '') ; + my ($output, $in) =('', '') ; if (ref $_[0] ) { $in = $_[0] ; @@ -341,47 +347,49 @@ sub uncompress($) } $] >= 5.008 and (utf8::downgrade($$in, 1) - or croak "Wide character in uncompress"); - - $x = new Compress::Raw::Zlib::Inflate -ConsumeInput => 0 or return undef ; - - $err = $x->inflate($in, $output) ; - return undef unless $err == Z_STREAM_END() ; - - return $output ; + or croak "Wide character in uncompress"); + + my ($obj, $status) = Compress::Raw::Zlib::_inflateInit(0, + MAX_WBITS, 4096, "") ; + + $status == Z_OK + or return undef; + + $obj->inflate($in, $output) == Z_STREAM_END + or return undef; + + return $output; } - - sub deflateInit(@) { my ($got) = ParseParameters(0, { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - 'Dictionary' => [1, 1, Parse_any, ""], + 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], + 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION()], + 'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED()], + 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], + 'memlevel' => [IO::Compress::Base::Common::Parse_unsigned, MAX_MEM_LEVEL()], + 'strategy' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_ ) ; croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; + $got->getValue('bufsize') + unless $got->getValue('bufsize') >= 1; my $obj ; my $status = 0 ; ($obj, $status) = Compress::Raw::Zlib::_deflateInit(0, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; + $got->getValue('level'), + $got->getValue('method'), + $got->getValue('windowbits'), + $got->getValue('memlevel'), + $got->getValue('strategy'), + $got->getValue('bufsize'), + $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; return wantarray ? ($x, $status) : $x ; @@ -391,22 +399,22 @@ sub inflateInit(@) { my ($got) = ParseParameters(0, { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], + 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], + 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], + 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_) ; croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; + $got->getValue('bufsize') + unless $got->getValue('bufsize') >= 1; my $status = 0 ; my $obj ; ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, - $got->value('WindowBits'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; + $got->getValue('windowbits'), + $got->getValue('bufsize'), + $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; @@ -453,28 +461,42 @@ sub inflate package Compress::Zlib ; -use IO::Compress::Gzip::Constants 2.048 ; +use IO::Compress::Gzip::Constants 2.060 ; sub memGzip($) { - my $out; - - # if the deflation buffer isn't a reference, make it one - my $string = (ref $_[0] ? $_[0] : \$_[0]) ; + _set_gzerr(0); + my $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND|FLAG_CRC, + Z_BEST_COMPRESSION, + Z_DEFLATED, + -MAX_WBITS(), + MAX_MEM_LEVEL, + Z_DEFAULT_STRATEGY, + 4096, + '') + or return undef ; + + # if the deflation buffer isn't a reference, make it one + my $string = (ref $_[0] ? $_[0] : \$_[0]) ; - $] >= 5.008 and (utf8::downgrade($$string, 1) - or croak "Wide character in memGzip"); + $] >= 5.008 and (utf8::downgrade($$string, 1) + or croak "Wide character in memGzip"); - _set_gzerr(0); - if ( ! IO::Compress::Gzip::gzip($string, \$out, Minimal => 1) ) - { - $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; - return undef ; - } + my $out; + my $status ; - return $out; + $x->deflate($string, $out) == Z_OK + or return undef ; + + $x->flush($out) == Z_OK + or return undef ; + + return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . + $out . + pack("V V", $x->crc32(), $x->total_in()); } + sub _removeGzipHeader($) { my $string = shift ; @@ -555,12 +577,11 @@ sub memGunzip($) or return _set_gzerr_undef($status); my $bufsize = length $$string > 4096 ? length $$string : 4096 ; - my $x = new Compress::Raw::Zlib::Inflate({-WindowBits => - MAX_WBITS(), - -Bufsize => $bufsize}) - + my $x = Compress::Raw::Zlib::_inflateInit(FLAG_CRC | FLAG_CONSUME_INPUT, + -MAX_WBITS(), $bufsize, '') or return _ret_gun_error(); - my $output = "" ; + my $output = '' ; $status = $x->inflate($string, $output); if ( $status == Z_OK() ) @@ -1478,7 +1499,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 1995-2012 Paul Marquess. All rights reserved. +Copyright (c) 1995-2013 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |