diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Compress')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm | 22 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm | 18 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm | 4 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Base.pm | 91 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm | 111 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm | 10 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm | 23 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod | 597 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm | 33 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm | 2 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm | 49 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm | 486 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm | 34 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm | 2 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm | 41 |
15 files changed, 1305 insertions, 218 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm index c3718d1f0df..452e12ef483 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,13 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); -#use Compress::Bzip2 ; -use Compress::Raw::Bzip2 2.033 ; +use Compress::Raw::Bzip2 2.048 ; our ($VERSION); -$VERSION = '2.033'; +$VERSION = '2.048'; sub mkCompObject { @@ -18,11 +17,12 @@ sub mkCompObject my $WorkFactor = shift ; my $Verbosity = shift ; + $BlockSize100K = 1 if ! defined $BlockSize100K ; + $WorkFactor = 0 if ! defined $WorkFactor ; + $Verbosity = 0 if ! defined $Verbosity ; + my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, $WorkFactor, $Verbosity); - #my ($def, $status) = bzdeflateInit(); - #-BlockSize100K => $params->value('BlockSize100K'), - #-WorkFactor => $params->value('WorkFactor'); return (undef, "Could not create Deflate object: $status", $status) if $status != BZ_OK ; @@ -39,7 +39,6 @@ sub compr my $def = $self->{Def}; - #my ($out, $status) = $def->bzdeflate(defined ${$_[0]} ? ${$_[0]} : "") ; my $status = $def->bzdeflate($_[0], $_[1]) ; $self->{ErrorNo} = $status; @@ -49,8 +48,6 @@ sub compr return STATUS_ERROR; } - #${ $_[1] } .= $out if defined $out; - return STATUS_OK; } @@ -60,8 +57,6 @@ sub flush my $def = $self->{Def}; - #my ($out, $status) = $def->bzflush($opt); - #my $status = $def->bzflush($_[0], $opt); my $status = $def->bzflush($_[0]); $self->{ErrorNo} = $status; @@ -71,7 +66,6 @@ sub flush return STATUS_ERROR; } - #${ $_[0] } .= $out if defined $out ; return STATUS_OK; } @@ -82,7 +76,6 @@ sub close my $def = $self->{Def}; - #my ($out, $status) = $def->bzclose(); my $status = $def->bzclose($_[0]); $self->{ErrorNo} = $status; @@ -92,7 +85,6 @@ sub close return STATUS_ERROR; } - #${ $_[0] } .= $out if defined $out ; return STATUS_OK; } diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm index 33e56d08a04..4a99c36cf7e 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm @@ -4,12 +4,18 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status); - -use Compress::Raw::Zlib 2.033 qw(Z_OK Z_FINISH MAX_WBITS) ; -our ($VERSION); - -$VERSION = '2.033'; +use IO::Compress::Base::Common 2.048 qw(:Status); +use Compress::Raw::Zlib 2.048 qw( !crc32 !adler32 ) ; + +require Exporter; +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); + +$VERSION = '2.048'; +@ISA = qw(Exporter); +@EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; +%EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; +@EXPORT = @EXPORT_OK; +%DEFLATE_CONSTANTS = %EXPORT_TAGS ; sub mkCompObject { diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm index 21a0be41080..c7a0031a1d4 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); our ($VERSION); -$VERSION = '2.033'; +$VERSION = '2.048'; sub mkCompObject { diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm index d0d585ce761..2137bbb8de2 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm @@ -1,26 +1,26 @@ package IO::Compress::Base ; -require 5.004 ; +require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.033 ; +use IO::Compress::Base::Common 2.048 ; -use IO::File ; +use IO::File qw(SEEK_SET SEEK_END); ; use Scalar::Util qw(blessed readonly); #use File::Glob; #require Exporter ; -use Carp ; -use Symbol; +use Carp() ; +use Symbol(); use bytes; our (@ISA, $VERSION); @ISA = qw(Exporter IO::File); -$VERSION = '2.033'; +$VERSION = '2.048'; #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. @@ -48,7 +48,7 @@ sub croakError { my $self = shift ; $self->saveErrorString(0, $_[0]); - croak $_[0]; + Carp::croak $_[0]; } sub closeError @@ -106,6 +106,14 @@ sub writeAt return 1; } +sub outputPayload +{ + + my $self = shift ; + return $self->output(@_); +} + + sub output { my $self = shift ; @@ -115,9 +123,9 @@ sub output return 1 if length $data == 0 && ! $last ; - if ( *$self->{FilterEnvelope} ) { + if ( *$self->{FilterContainer} ) { *_ = \$data; - &{ *$self->{FilterEnvelope} }(); + &{ *$self->{FilterContainer} }(); } if (length $data) { @@ -155,7 +163,7 @@ sub checkParams 'Append' => [1, 1, Parse_boolean, 0], 'BinModeIn' => [1, 1, Parse_boolean, 0], - 'FilterEnvelope' => [1, 1, Parse_any, undef], + 'FilterContainer' => [1, 1, Parse_code, undef], $self->getExtraParams(), *$self->{OneShot} ? $self->getOneShotParams() @@ -206,7 +214,7 @@ sub _create my $merge = $got->value('Merge') ; my $appendOutput = $got->value('Append') || $merge ; *$obj->{Append} = $appendOutput; - *$obj->{FilterEnvelope} = $got->value('FilterEnvelope') ; + *$obj->{FilterContainer} = $got->value('FilterContainer') ; if ($merge) { @@ -275,6 +283,7 @@ sub _create *$obj->{Header} = $obj->mkHeader($got) ; $obj->output( *$obj->{Header} ) or return undef; + $obj->beforePayload(); } else { @@ -392,7 +401,7 @@ sub _def # finally the 1 to 1 and n to 1 return $obj->_singleTarget($x, 1, $input, $output, @_); - croak "should not be here" ; + Carp::croak "should not be here" ; } sub _singleTarget @@ -405,7 +414,7 @@ sub _singleTarget if ($x->{oneInput}) { $obj->getFileInfo($x->{Got}, $input) - if isaFilename($input) and $inputIsFilename ; + if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ; my $z = $obj->_create($x->{Got}, @_) or return undef ; @@ -435,7 +444,7 @@ sub _singleTarget else { $obj->getFileInfo($x->{Got}, $element) - if $isFilename; + if isaScalar($element) || $isFilename; $obj->_create($x->{Got}, @_) or return undef ; @@ -504,7 +513,7 @@ sub _wr2 return $count ; } - croak "Should not be here"; + Carp::croak "Should not be here"; return undef; } @@ -518,7 +527,7 @@ sub addInterStream { $self->getFileInfo(*$self->{Got}, $input) #if isaFilename($input) and $inputIsFilename ; - if isaFilename($input) ; + if isaScalar($input) || isaFilename($input) ; # TODO -- newStream needs to allow gzip/zip header to be modified return $self->newStream(); @@ -581,7 +590,7 @@ sub syswrite } $] >= 5.008 and ( utf8::downgrade($$buffer, 1) - or croak "Wide character in " . *$self->{ClassName} . "::write:"); + or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:"); if (@_ > 1) { @@ -625,7 +634,7 @@ sub syswrite *$self->{CompSize}->add(length $outBuffer) ; - $self->output($outBuffer) + $self->outputPayload($outBuffer) or return undef; return $buffer_length; @@ -679,7 +688,7 @@ sub flush *$self->{CompSize}->add(length $outBuffer) ; - $self->output($outBuffer) + $self->outputPayload($outBuffer) or return 0; if ( defined *$self->{FH} ) { @@ -690,16 +699,18 @@ sub flush return 1; } -sub newStream +sub beforePayload +{ +} + +sub _newStream { my $self = shift ; - + my $got = shift; + $self->_writeTrailer() or return 0 ; - my $got = $self->checkParams('newStream', *$self->{Got}, @_) - or return 0 ; - $self->ckParams($got) or $self->croakError("newStream: $self->{Error}"); @@ -713,9 +724,35 @@ sub newStream *$self->{UnCompSize}->reset(); *$self->{CompSize}->reset(); + $self->beforePayload(); + return 1 ; } +sub newStream +{ + my $self = shift ; + + my $got = $self->checkParams('newStream', *$self->{Got}, @_) + or return 0 ; + + $self->_newStream($got); + +# *$self->{Compress} = $self->mkComp($got) +# or return 0; +# +# *$self->{Header} = $self->mkHeader($got) ; +# $self->output(*$self->{Header} ) +# or return 0; +# +# *$self->{UnCompSize}->reset(); +# *$self->{CompSize}->reset(); +# +# $self->beforePayload(); +# +# return 1 ; +} + sub reset { my $self = shift ; @@ -913,7 +950,7 @@ sub input_line_number sub _notAvailable { my $name = shift ; - return sub { croak "$name Not Available: File opened only for output" ; } ; + return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; } *read = _notAvailable('read'); @@ -958,7 +995,7 @@ purpose if to to be sub-classed by IO::Compress modules. L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -974,7 +1011,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2011 Paul Marquess. All rights reserved. +Copyright (c) 2005-2012 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/IO/Compress/Base/Common.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm index 1b38c59846a..c6c38181ef8 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm @@ -11,15 +11,20 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); -$VERSION = '2.033'; +$VERSION = '2.048'; -@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput +@EXPORT = qw( isaFilehandle isaFilename isaScalar + whatIsInput whatIsOutput isaFileGlobString cleanFileGlobString oneTarget setBinModeInput setBinModeOutput ckInOutParams createSelfTiedObject getEncoding + isGeMax32 + + MAX32 + WANT_CODE WANT_EXT WANT_UNDEF @@ -42,7 +47,16 @@ use constant STATUS_OK => 0; use constant STATUS_ENDSTREAM => 1; use constant STATUS_EOF => 2; use constant STATUS_ERROR => -1; +use constant MAX16 => 0xFFFF ; +use constant MAX32 => 0xFFFFFFFF ; +use constant MAX32cmp => 0xFFFFFFFF + 1 - 1; # for 5.6.x on 32-bit need to force an non-IV value + +sub isGeMax32 +{ + return $_[0] >= MAX32cmp ; +} + sub hasEncode() { if (! defined $HAS_ENCODE) { @@ -106,6 +120,11 @@ sub isaFilehandle($) ) } +sub isaScalar +{ + return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ; +} + sub isaFilename($) { return (defined $_[0] and @@ -451,7 +470,8 @@ sub createSelfTiedObject $EXPORT_TAGS{Parse} = [qw( ParseParameters Parse_any Parse_unsigned Parse_signed - Parse_boolean Parse_custom Parse_string + Parse_boolean Parse_string + Parse_code Parse_multiple Parse_writable_scalar ) ]; @@ -463,7 +483,7 @@ 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_code => 0x20; #use constant Parse_store_ref => 0x100 ; use constant Parse_multiple => 0x100 ; @@ -499,6 +519,7 @@ sub ParseParameters #package IO::Compress::Base::Parameters; use strict; + use warnings; use Carp; @@ -741,6 +762,13 @@ sub IO::Compress::Base::Parameters::_checkType $$output = defined $value ? $value != 0 : 0 ; return 1; } + elsif ($type & Parse_code) + { + return $self->setError("Parameter '$key' must be a code reference, got '$value'") + if $validate && (! defined $value || ref $value ne 'CODE') ; + $$output = defined $value ? $value : "" ; + return 1; + } elsif ($type & Parse_string) { $$output = defined $value ? $value : "" ; @@ -901,9 +929,13 @@ sub add $self->[HIGH] += $value->[HIGH] ; $value = $value->[LOW]; } + elsif ($value > MAX32) { + $self->[HIGH] += int($value / HI_1) ; + $value = $value % HI_1; + } my $available = MAX32 - $self->[LOW] ; - + if ($value > $available) { ++ $self->[HIGH] ; $self->[LOW] = $value - $available - 1; @@ -911,7 +943,33 @@ sub add else { $self->[LOW] += $value ; } +} + +sub subtract +{ + my $self = shift; + my $value = shift; + if (ref $value eq 'U64') { + + if ($value->[HIGH]) { + die "bad" + if $self->[HIGH] == 0 || + $value->[HIGH] > $self->[HIGH] ; + + $self->[HIGH] -= $value->[HIGH] ; + } + + $value = $value->[LOW] ; + } + + if ($value > $self->[LOW]) { + -- $self->[HIGH] ; + $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ; + } + else { + $self->[LOW] -= $value; + } } sub equal @@ -923,12 +981,40 @@ sub equal $self->[HIGH] == $other->[HIGH] ; } +sub gt +{ + my $self = shift; + my $other = shift; + + return $self->cmp($other) > 0 ; +} + +sub cmp +{ + my $self = shift; + my $other = shift ; + + if ($self->[LOW] == $other->[LOW]) { + return $self->[HIGH] - $other->[HIGH] ; + } + else { + return $self->[LOW] - $other->[LOW] ; + } +} + + sub is64bit { my $self = shift; return $self->[HIGH] > 0 ; } +sub isAlmost64bit +{ + my $self = shift; + return $self->[HIGH] > 0 || $self->[LOW] == MAX32 ; +} + sub getPacked_V64 { my $self = shift; @@ -951,6 +1037,21 @@ sub pack_V64 } +sub full32 +{ + return $_[0] == MAX32 ; +} + +sub Value_VV64 +{ + my $buffer = shift; + + my ($lo, $hi) = unpack ("V V" , $buffer); + no warnings 'uninitialized'; + return $hi * HI_1 + $lo; +} + + package IO::Compress::Base::Common; 1; diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm index 5d478d91bd2..dd9016bf834 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.033 ; +use IO::Compress::Base 2.048 ; -use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject); -use IO::Compress::Adapter::Bzip2 2.033 ; +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); +use IO::Compress::Adapter::Bzip2 2.048 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.033'; +$VERSION = '2.048'; $Bzip2Error = ''; @ISA = qw(Exporter IO::Compress::Base); @@ -51,7 +51,7 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.033 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'BlockSize100K' => [0, 1, Parse_unsigned, 1], diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm index 20329bb4284..daa7d7aa258 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm @@ -1,26 +1,29 @@ package IO::Compress::Deflate ; +require 5.006 ; + use strict ; use warnings; use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.033 ; +use IO::Compress::RawDeflate 2.048 (); +use IO::Compress::Adapter::Deflate 2.048 ; -use Compress::Raw::Zlib 2.033 ; -use IO::Compress::Zlib::Constants 2.033 ; -use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject); +use IO::Compress::Zlib::Constants 2.048 ; +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.033'; +$VERSION = '2.048'; $DeflateError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @EXPORT_OK = qw( $DeflateError deflate ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; + push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -774,7 +777,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -884,8 +887,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -894,7 +895,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -923,7 +924,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2011 Paul Marquess. All rights reserved. +Copyright (c) 2005-2012 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/IO/Compress/FAQ.pod b/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod new file mode 100644 index 00000000000..d392ff2cc91 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/IO/Compress/FAQ.pod @@ -0,0 +1,597 @@ + +=head1 NAME + +IO::Compress::FAQ -- Frequently Asked Questions about IO::Compress + +=head1 DESCRIPTION + +Common questions answered. + +=head1 GENERAL + +=head2 Compatibility with Unix compress/uncompress. + +Although C<Compress::Zlib> has a pair of functions called C<compress> and +C<uncompress>, they are I<not> related to the Unix programs of the same +name. The C<Compress::Zlib> module is not compatible with Unix +C<compress>. + +If you have the C<uncompress> program available, you can use this to read +compressed files + + open F, "uncompress -c $filename |"; + while (<F>) + { + ... + +Alternatively, if you have the C<gunzip> program available, you can use +this to read compressed files + + open F, "gunzip -c $filename |"; + while (<F>) + { + ... + +and this to write compress files, if you have the C<compress> program +available + + open F, "| compress -c $filename "; + print F "data"; + ... + close F ; + +=head2 Accessing .tar.Z files + +The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via the +C<IO::Zlib> module) to access tar files that have been compressed with +C<gzip>. Unfortunately tar files compressed with the Unix C<compress> +utility cannot be read by C<Compress::Zlib> and so cannot be directly +accessed by C<Archive::Tar>. + +If the C<uncompress> or C<gunzip> programs are available, you can use one +of these workarounds to read C<.tar.Z> files from C<Archive::Tar> + +Firstly with C<uncompress> + + use strict; + use warnings; + use Archive::Tar; + + open F, "uncompress -c $filename |"; + my $tar = Archive::Tar->new(*F); + ... + +and this with C<gunzip> + + use strict; + use warnings; + use Archive::Tar; + + open F, "gunzip -c $filename |"; + my $tar = Archive::Tar->new(*F); + ... + +Similarly, if the C<compress> program is available, you can use this to +write a C<.tar.Z> file + + use strict; + use warnings; + use Archive::Tar; + use IO::File; + + my $fh = new IO::File "| compress -c >$filename"; + my $tar = Archive::Tar->new(); + ... + $tar->write($fh); + $fh->close ; + +=head2 How do I recompress using a different compression? + +This is easier that you might expect if you realise that all the +C<IO::Compress::*> objects are derived from C<IO::File> and that all the +C<IO::Uncompress::*> modules can read from an C<IO::File> filehandle. + +So, for example, say you have a file compressed with gzip that you want to +recompress with bzip2. Here is all that is needed to carry out the +recompression. + + use IO::Uncompress::Gunzip ':all'; + use IO::Compress::Bzip2 ':all'; + + my $gzipFile = "somefile.gz"; + my $bzipFile = "somefile.bz2"; + + my $gunzip = new IO::Uncompress::Gunzip $gzipFile + or die "Cannot gunzip $gzipFile: $GunzipError\n" ; + + bzip2 $gunzip => $bzipFile + or die "Cannot bzip2 to $bzipFile: $Bzip2Error\n" ; + +Note, there is a limitation of this technique. Some compression file +formats store extra information along with the compressed data payload. For +example, gzip can optionally store the original filename and Zip stores a +lot of information about the original file. If the original compressed file +contains any of this extra information, it will not be transferred to the +new compressed file usign the technique above. + +=head1 ZIP + +=head2 What Compression Types do IO::Compress::Zip & IO::Uncompress::Unzip support? + +The following compression formats are supported by C<IO::Compress::Zip> and +C<IO::Uncompress::Unzip> + +=over 5 + +=item * Store (method 0) + +No compression at all. + +=item * Deflate (method 8) + +This is the default compression used when creating a zip file with +C<IO::Compress::Zip>. + +=item * Bzip2 (method 12) + +Only supported if the C<IO-Compress-Bzip2> module is installed. + +=item * Lzma (method 14) + +Only supported if the C<IO-Compress-Lzma> module is installed. + +=back + +=head2 Can I Read/Write Zip files larger the 4 Gig? + +Yes, both the C<IO-Compress-Zip> and C<IO-Uncompress-Unzip> modules +support the zip feature called I<Zip64>. That allows them to read/write +files/buffers larger than 4Gig. + +If you are creating a Zip file using the one-shot interface, and any of the +input files is greater than 4Gig, a zip64 complaint zip file will be +created. + + zip "really-large-file" => "my.zip"; + +Similarly with the one-shot interface, if the input is a buffer larger than +4 Gig, a zip64 complaint zip file will be created. + + zip \$really_large_buffer => "my.zip"; + +The one-shot interface allows you to force the creation of a zip64 zip file +by including the C<Zip64> option. + + zip $filehandle => "my.zip", Zip64 => 1; + +If you want to create a zip64 zip file with the OO interface you must +specify the C<Zip64> option. + + my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; + +When uncompressing with C<IO-Uncompress-Unzip>, it will automatically +detect if the zip file is zip64. + +If you intend to manipulate the Zip64 zip files created with +C<IO-Compress-Zip> using an external zip/unzip, make sure that it supports +Zip64. + +In particular, if you are using Info-Zip you need to have zip version 3.x +or better to update a Zip64 archive and unzip version 6.x to read a zip64 +archive. + +=head2 Zip Resources + +The primary reference for zip files is the "appnote" document available at +L<http://www.pkware.com/documents/casestudies/APPNOTE.TXT> + +An alternatively is the Info-Zip appnote. This is available from +L<ftp://ftp.info-zip.org/pub/infozip/doc/> + +=head1 GZIP + +=head2 Gzip Resources + +The primary reference for gzip files is RFC 1952 +L<http://www.faqs.org/rfcs/rfc1952.html> + +The primary site for gzip is F<http://www.gzip.org>. + +=head1 ZLIB + +=head2 Zlib Resources + +The primary site for the I<zlib> compression library is +F<http://www.zlib.org>. + +=head1 HTTP & NETWORK + +=head2 Apache::GZip Revisited + +Below is a mod_perl Apache compression module, called C<Apache::GZip>, +taken from +F<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.html#On_the_Fly_Compression> + + package Apache::GZip; + #File: Apache::GZip.pm + + use strict vars; + use Apache::Constants ':common'; + use Compress::Zlib; + use IO::File; + use constant GZIP_MAGIC => 0x1f8b; + use constant OS_MAGIC => 0x03; + + sub handler { + my $r = shift; + my ($fh,$gz); + my $file = $r->filename; + return DECLINED unless $fh=IO::File->new($file); + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + tie *STDOUT,'Apache::GZip',$r; + print($_) while <$fh>; + untie *STDOUT; + return OK; + } + + sub TIEHANDLE { + my($class,$r) = @_; + # initialize a deflation stream + my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; + + # gzip header -- don't ask how I found out + $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); + + return bless { r => $r, + crc => crc32(undef), + d => $d, + l => 0 + },$class; + } + + sub PRINT { + my $self = shift; + foreach (@_) { + # deflate the data + my $data = $self->{d}->deflate($_); + $self->{r}->print($data); + # keep track of its length and crc + $self->{l} += length($_); + $self->{crc} = crc32($_,$self->{crc}); + } + } + + sub DESTROY { + my $self = shift; + + # flush the output buffers + my $data = $self->{d}->flush; + $self->{r}->print($data); + + # print the CRC and the total length (uncompressed) + $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); + } + + 1; + +Here's the Apache configuration entry you'll need to make use of it. Once +set it will result in everything in the /compressed directory will be +compressed automagically. + + <Location /compressed> + SetHandler perl-script + PerlHandler Apache::GZip + </Location> + +Although at first sight there seems to be quite a lot going on in +C<Apache::GZip>, you could sum up what the code was doing as follows -- +read the contents of the file in C<< $r->filename >>, compress it and write +the compressed data to standard output. That's all. + +This code has to jump through a few hoops to achieve this because + +=over + +=item 1. + +The gzip support in C<Compress::Zlib> version 1.x can only work with a real +filesystem filehandle. The filehandles used by Apache modules are not +associated with the filesystem. + +=item 2. + +That means all the gzip support has to be done by hand - in this case by +creating a tied filehandle to deal with creating the gzip header and +trailer. + +=back + +C<IO::Compress::Gzip> doesn't have that filehandle limitation (this was one +of the reasons for writing it in the first place). So if +C<IO::Compress::Gzip> is used instead of C<Compress::Zlib> the whole tied +filehandle code can be removed. Here is the rewritten code. + + package Apache::GZip; + + use strict vars; + use Apache::Constants ':common'; + use IO::Compress::Gzip; + use IO::File; + + sub handler { + my $r = shift; + my ($fh,$gz); + my $file = $r->filename; + return DECLINED unless $fh=IO::File->new($file); + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + my $gz = new IO::Compress::Gzip '-', Minimal => 1 + or return DECLINED ; + + print $gz $_ while <$fh>; + + return OK; + } + +or even more succinctly, like this, using a one-shot gzip + + package Apache::GZip; + + use strict vars; + use Apache::Constants ':common'; + use IO::Compress::Gzip qw(gzip); + + sub handler { + my $r = shift; + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + gzip $r->filename => '-', Minimal => 1 + or return DECLINED ; + + return OK; + } + + 1; + +The use of one-shot C<gzip> above just reads from C<< $r->filename >> and +writes the compressed data to standard output. + +Note the use of the C<Minimal> option in the code above. When using gzip +for Content-Encoding you should I<always> use this option. In the example +above it will prevent the filename being included in the gzip header and +make the size of the gzip data stream a slight bit smaller. + +=head2 Compressed files and Net::FTP + +The C<Net::FTP> module provides two low-level methods called C<stor> and +C<retr> that both return filehandles. These filehandles can used with the +C<IO::Compress/Uncompress> modules to compress or uncompress files read +from or written to an FTP Server on the fly, without having to create a +temporary file. + +Firstly, here is code that uses C<retr> to uncompressed a file as it is +read from the FTP Server. + + use Net::FTP; + use IO::Uncompress::Gunzip qw(:all); + + my $ftp = new Net::FTP ... + + my $retr_fh = $ftp->retr($compressed_filename); + gunzip $retr_fh => $outFilename, AutoClose => 1 + or die "Cannot uncompress '$compressed_file': $GunzipError\n"; + +and this to compress a file as it is written to the FTP Server + + use Net::FTP; + use IO::Compress::Gzip qw(:all); + + my $stor_fh = $ftp->stor($filename); + gzip "filename" => $stor_fh, AutoClose => 1 + or die "Cannot compress '$filename': $GzipError\n"; + +=head1 MISC + +=head2 Using C<InputLength> to uncompress data embedded in a larger file/buffer. + +A fairly common use-case is where compressed data is embedded in a larger +file/buffer and you want to read both. + +As an example consider the structure of a zip file. This is a well-defined +file format that mixes both compressed and uncompressed sections of data in +a single file. + +For the purposes of this discussion you can think of a zip file as sequence +of compressed data streams, each of which is prefixed by an uncompressed +local header. The local header contains information about the compressed +data stream, including the name of the compressed file and, in particular, +the length of the compressed data stream. + +To illustrate how to use C<InputLength> here is a script that walks a zip +file and prints out how many lines are in each compressed file (if you +intend write code to walking through a zip file for real see +L<IO::Uncompress::Unzip/"Walking through a zip file"> ). Also, although +this example uses the zlib-based compression, the technique can be used by +the other C<IO::Uncompress::*> modules. + + use strict; + use warnings; + + use IO::File; + use IO::Uncompress::RawInflate qw(:all); + + use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; + use constant ZIP_LOCAL_HDR_LENGTH => 30; + + my $file = $ARGV[0] ; + + my $fh = new IO::File "<$file" + or die "Cannot open '$file': $!\n"; + + while (1) + { + my $sig; + my $buffer; + + my $x ; + ($x = $fh->read($buffer, ZIP_LOCAL_HDR_LENGTH)) == ZIP_LOCAL_HDR_LENGTH + or die "Truncated file: $!\n"; + + my $signature = unpack ("V", substr($buffer, 0, 4)); + + last unless $signature == ZIP_LOCAL_HDR_SIG; + + # Read Local Header + my $gpFlag = unpack ("v", substr($buffer, 6, 2)); + my $compressedMethod = unpack ("v", substr($buffer, 8, 2)); + my $compressedLength = unpack ("V", substr($buffer, 18, 4)); + my $uncompressedLength = unpack ("V", substr($buffer, 22, 4)); + my $filename_length = unpack ("v", substr($buffer, 26, 2)); + my $extra_length = unpack ("v", substr($buffer, 28, 2)); + + my $filename ; + $fh->read($filename, $filename_length) == $filename_length + or die "Truncated file\n"; + + $fh->read($buffer, $extra_length) == $extra_length + or die "Truncated file\n"; + + if ($compressedMethod != 8 && $compressedMethod != 0) + { + warn "Skipping file '$filename' - not deflated $compressedMethod\n"; + $fh->read($buffer, $compressedLength) == $compressedLength + or die "Truncated file\n"; + next; + } + + if ($compressedMethod == 0 && $gpFlag & 8 == 8) + { + die "Streamed Stored not supported for '$filename'\n"; + } + + next if $compressedLength == 0; + + # Done reading the Local Header + + my $inf = new IO::Uncompress::RawInflate $fh, + Transparent => 1, + InputLength => $compressedLength + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The majority of the code above is concerned with reading the zip local +header data. The code that I want to focus on is at the bottom. + + while (1) { + + # read local zip header data + # get $filename + # get $compressedLength + + my $inf = new IO::Uncompress::RawInflate $fh, + Transparent => 1, + InputLength => $compressedLength + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The call to C<IO::Uncompress::RawInflate> creates a new filehandle C<$inf> +that can be used to read from the parent filehandle C<$fh>, uncompressing +it as it goes. The use of the C<InputLength> option will guarantee that +I<at most> C<$compressedLength> bytes of compressed data will be read from +the C<$fh> filehandle (The only exception is for an error case like a +truncated file or a corrupt data stream). + +This means that once RawInflate is finished C<$fh> will be left at the +byte directly after the compressed data stream. + +Now consider what the code looks like without C<InputLength> + + while (1) { + + # read local zip header data + # get $filename + # get $compressedLength + + # read all the compressed data into $data + read($fh, $data, $compressedLength); + + my $inf = new IO::Uncompress::RawInflate \$data, + Transparent => 1, + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The difference here is the addition of the temporary variable C<$data>. +This is used to store a copy of the compressed data while it is being +uncompressed. + +If you know that C<$compressedLength> isn't that big then using temporary +storage won't be a problem. But if C<$compressedLength> is very large or +you are writing an application that other people will use, and so have no +idea how big C<$compressedLength> will be, it could be an issue. + +Using C<InputLength> avoids the use of temporary storage and means the +application can cope with large compressed data streams. + +One final point -- obviously C<InputLength> can only be used whenever you +know the length of the compressed data beforehand, like here with a zip +file. + +=head1 SEE ALSO + +L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> + +L<IO::Compress::FAQ|IO::Compress::FAQ> + +L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, +L<Archive::Tar|Archive::Tar>, +L<IO::Zlib|IO::Zlib> + +=head1 AUTHOR + +This module was written by Paul Marquess, F<pmqs@cpan.org>. + +=head1 MODIFICATION HISTORY + +See the Changes file. + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005-2012 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/IO/Compress/Gzip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm index 2a7894257d4..6530c2532de 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm @@ -1,19 +1,19 @@ - package IO::Compress::Gzip ; -require 5.004 ; +require 5.006 ; use strict ; use warnings; use bytes; +require Exporter ; -use IO::Compress::RawDeflate 2.033 ; +use IO::Compress::RawDeflate 2.048 () ; +use IO::Compress::Adapter::Deflate 2.048 ; -use Compress::Raw::Zlib 2.033 ; -use IO::Compress::Base::Common 2.033 qw(:Status :Parse createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.033 ; -use IO::Compress::Zlib::Extra 2.033 ; +use IO::Compress::Base::Common 2.048 qw(:Status :Parse isaScalar createSelfTiedObject); +use IO::Compress::Gzip::Constants 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; BEGIN { @@ -23,16 +23,15 @@ BEGIN { *noUTF8 = sub {} } } -require Exporter ; - -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.033'; +$VERSION = '2.048'; $GzipError = '' ; @ISA = qw(Exporter IO::Compress::RawDeflate); @EXPORT_OK = qw( $GzipError gzip ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; + push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -178,6 +177,8 @@ sub getFileInfo my $params = shift; my $filename = shift ; + return if isaScalar($filename); + my $defaultTime = (stat($filename))[9] ; $params->value('Name' => $filename) @@ -256,7 +257,7 @@ sub mkHeader } # HEADER CRC - $out .= pack("v", crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ; + $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ; noUTF8($out); @@ -1086,7 +1087,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -1196,8 +1197,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -1206,7 +1205,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1235,7 +1234,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2011 Paul Marquess. All rights reserved. +Copyright (c) 2005-2012 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/IO/Compress/Gzip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm index ca74d738837..c218a31445c 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm +++ b/Master/tlpkg/tlperl/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.033'; +$VERSION = '2.048'; @ISA = qw(Exporter); diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm index bb077f989c9..883a4eb2f72 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm @@ -7,44 +7,23 @@ use warnings; use bytes; -use IO::Compress::Base 2.033 ; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); -use IO::Compress::Adapter::Deflate 2.033 ; +use IO::Compress::Base 2.048 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Compress::Adapter::Deflate 2.048 ; require Exporter ; - our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.033'; +$VERSION = '2.048'; $RawDeflateError = ''; @ISA = qw(Exporter IO::Compress::Base); @EXPORT_OK = qw( $RawDeflateError rawdeflate ) ; +push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; + +%EXPORT_TAGS = %IO::Compress::Adapter::Deflate::DEFLATE_CONSTANTS; -%EXPORT_TAGS = ( flush => [qw{ - Z_NO_FLUSH - Z_PARTIAL_FLUSH - Z_SYNC_FLUSH - Z_FULL_FLUSH - Z_FINISH - Z_BLOCK - }], - level => [qw{ - Z_NO_COMPRESSION - Z_BEST_SPEED - Z_BEST_COMPRESSION - Z_DEFAULT_COMPRESSION - }], - strategy => [qw{ - Z_FILTERED - Z_HUFFMAN_ONLY - Z_RLE - Z_FIXED - Z_DEFAULT_STRATEGY - }], - - ); { my %seen; @@ -60,7 +39,7 @@ $RawDeflateError = ''; %DEFLATE_CONSTANTS = %EXPORT_TAGS; -push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; +#push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -142,8 +121,8 @@ sub getZlibParams { my $self = shift ; - use IO::Compress::Base::Common 2.033 qw(:Parse); - use Compress::Raw::Zlib 2.033 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); + use IO::Compress::Base::Common 2.048 qw(:Parse); + use Compress::Raw::Zlib 2.048 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); return ( @@ -861,7 +840,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -971,8 +950,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -981,7 +958,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1010,7 +987,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2011 Paul Marquess. All rights reserved. +Copyright (c) 2005-2012 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/IO/Compress/Zip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm index 62acc8e1fa2..9c2780a5e06 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm @@ -4,40 +4,45 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); -use IO::Compress::RawDeflate 2.033 ; -use IO::Compress::Adapter::Deflate 2.033 ; -use IO::Compress::Adapter::Identity 2.033 ; -use IO::Compress::Zlib::Extra 2.033 ; -use IO::Compress::Zip::Constants 2.033 ; +use IO::Compress::Base::Common 2.048 qw(:Status MAX32 isGeMax32 isaScalar createSelfTiedObject); +use IO::Compress::RawDeflate 2.048 (); +use IO::Compress::Adapter::Deflate 2.048 ; +use IO::Compress::Adapter::Identity 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; +use IO::Compress::Zip::Constants 2.048 ; +use File::Spec(); +use Config; + +use Compress::Raw::Zlib 2.048 (); -use Compress::Raw::Zlib 2.033 qw(crc32) ; BEGIN { eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.033 ; + import IO::Compress::Adapter::Bzip2 2.048 ; require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.033 ; + import IO::Compress::Bzip2 2.048 ; + } ; + + eval { require IO::Compress::Adapter::Lzma ; + import IO::Compress::Adapter::Lzma 2.048 ; + require IO::Compress::Lzma ; + import IO::Compress::Lzma 2.048 ; } ; -# eval { require IO::Compress::Adapter::Lzma ; -# import IO::Compress::Adapter::Lzma 2.020 ; -# require IO::Compress::Lzma ; -# import IO::Compress::Lzma 2.033 ; -# } ; } require Exporter ; -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.033'; +$VERSION = '2.048'; $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 ZIP_CM_LZMA)]; @@ -51,6 +56,7 @@ sub new my $obj = createSelfTiedObject($class, \$ZipError); $obj->_create(undef, @_); + } sub zip @@ -59,6 +65,46 @@ sub zip return $obj->_def(@_); } +sub isMethodAvailable +{ + my $method = shift; + + # Store & Deflate are always available + return 1 + if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ; + + return 1 + if $method == ZIP_CM_BZIP2 and + defined $IO::Compress::Adapter::Bzip2::VERSION; + + return 1 + if $method == ZIP_CM_LZMA and + defined $IO::Compress::Adapter::Lzma::VERSION; + + return 0; +} + +sub beforePayload +{ + my $self = shift ; + + if (*$self->{ZipData}{Sparse} ) { + my $inc = 1024 * 100 ; + my $NULLS = ("\x00" x $inc) ; + my $sparse = *$self->{ZipData}{Sparse} ; + *$self->{CompSize}->add( $sparse ); + *$self->{UnCompSize}->add( $sparse ); + + *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR); + + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32}) + for 1 .. int $sparse / $inc; + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc), + *$self->{ZipData}{CRC32}) + if $sparse % $inc; + } +} + sub mkComp { my $self = shift ; @@ -71,7 +117,7 @@ sub mkComp $got->value('Level'), $got->value('Strategy') ); - *$self->{ZipData}{CRC32} = crc32(undef); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); } elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject( @@ -87,12 +133,14 @@ sub mkComp $got->value('WorkFactor'), $got->value('Verbosity') ); - *$self->{ZipData}{CRC32} = crc32(undef); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); + } + elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { + ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->value('Preset'), + $got->value('Extreme'), + ); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); } -# elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { -# ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkCompObject(); -# *$self->{ZipData}{CRC32} = crc32(undef); -# } return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; @@ -126,11 +174,57 @@ sub filterUncompressed *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32(); } else { - *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32}); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}); } } +sub canonicalName +{ + # This sub is derived from Archive::Zip::_asZipDirName + + # Return the normalized name as used in a zip file (path + # separators become slashes, etc.). + # Will translate internal slashes in path components (i.e. on Macs) to + # underscores. Discards volume names. + # When $forceDir is set, returns paths with trailing slashes + # + # input output + # . '.' + # ./a a + # ./a/b a/b + # ./a/b/ a/b + # a/b/ a/b + # /a/b/ a/b + # c:\a\b\c.doc a/b/c.doc # on Windows + # "i/o maps:whatever" i_o maps/whatever # on Macs + + my $name = shift; + my $forceDir = shift ; + + my ( $volume, $directories, $file ) = + File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); + + my @dirs = map { $_ =~ s{/}{_}g; $_ } + File::Spec->splitdir($directories); + + if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component + push @dirs, defined($file) ? $file : '' ; + + my $normalised_path = join '/', @dirs; + + # Leading directory separators should not be stored in zip archives. + # Example: + # C:\a\b\c\ a/b/c + # C:\a\b\c.txt a/b/c.txt + # /a/b/c/ a/b/c + # /a/b/c.txt a/b/c.txt + $normalised_path =~ s{^/}{}; # remove leading separator + + return $normalised_path; +} + + sub mkHeader { my $self = shift; @@ -139,11 +233,27 @@ sub mkHeader *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset}); + my $comment = ''; + $comment = $param->value('Comment') || ''; + my $filename = ''; $filename = $param->value('Name') || ''; - my $comment = ''; - $comment = $param->value('Comment') || ''; + $filename = canonicalName($filename) + if length $filename && $param->value('CanonicalName') ; + + if (defined *$self->{ZipData}{FilterName} ) { + local *_ = \$filename ; + &{ *$self->{ZipData}{FilterName} }() ; + } + +# if ( $param->value('UTF8') ) { +# require Encode ; +# $filename = Encode::encode_utf8($filename) +# if length $filename ; +# $comment = Encode::encode_utf8($filename) +# if length $comment ; +# } my $hdr = ''; @@ -156,11 +266,12 @@ sub mkHeader my $extFileAttr = 0 ; # This code assumes Unix. + # TODO - revisit this $extFileAttr = 0100644 << 16 if $osCode == ZIP_OS_CODE_UNIX ; if (*$self->{ZipData}{Zip64}) { - $empty = 0xFFFFFFFF; + $empty = MAX32; my $x = ''; $x .= pack "V V", 0, 0 ; # uncompressedLength @@ -169,7 +280,7 @@ sub mkHeader } if (! $param->value('Minimal')) { - if (defined $param->value('exTime')) + if ($param->parsed('MTime')) { $extra .= mkExtendedTime($param->value('MTime'), $param->value('ATime'), @@ -178,10 +289,20 @@ sub mkHeader $ctlExtra .= mkExtendedTime($param->value('MTime')); } - if ( $param->value('UID') && $osCode == ZIP_OS_CODE_UNIX) + if ( $osCode == ZIP_OS_CODE_UNIX ) { - $extra .= mkUnix2Extra( $param->value('UID'), $param->value('GID')); - $ctlExtra .= mkUnix2Extra(); + if ( $param->value('want_exUnixN') ) + { + my $ux3 = mkUnixNExtra( @{ $param->value('want_exUnixN') }); + $extra .= $ux3; + $ctlExtra .= $ux3; + } + + if ( $param->value('exUnix2') ) + { + $extra .= mkUnix2Extra( @{ $param->value('exUnix2') }); + $ctlExtra .= mkUnix2Extra(); + } } $extFileAttr = $param->value('ExtAttr') @@ -194,15 +315,21 @@ sub mkHeader if defined $param->value('ExtraFieldCentral'); } + my $method = *$self->{ZipData}{Method} ; my $gpFlag = 0 ; $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK if *$self->{ZipData}{Stream} ; - my $method = *$self->{ZipData}{Method} ; + $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT + if $method == ZIP_CM_LZMA ; + + #$gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING + #if $param->value('UTF8') && length($filename) + length($comment); my $version = $ZIP_CM_MIN_VERSIONS{$method}; $version = ZIP64_MIN_VERSION if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64}; + my $madeBy = ($param->value('OS_Code') << 8) + $version; my $extract = $version; @@ -264,7 +391,7 @@ sub mkHeader # offset to local hdr if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { - $ctl .= pack 'V', 0xFFFFFFFF ; + $ctl .= pack 'V', MAX32 ; } else { $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; @@ -278,6 +405,7 @@ sub mkHeader *$self->{ZipData}{CentralHeader} = $ctl; + return $hdr; } @@ -307,6 +435,7 @@ sub mkTrailer my $data = $crc32 . $sizes ; + my $xtrasize = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size $xtrasize .= *$self->{CompSize}->getPacked_V64() ; # Compressed size @@ -331,14 +460,14 @@ sub mkTrailer my $x = ''; # uncompressed length - if (*$self->{UnCompSize}->is64bit() ) { + if (*$self->{UnCompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) { $x .= *$self->{UnCompSize}->getPacked_V64() ; } else { substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ; } # compressed length - if (*$self->{CompSize}->is64bit() ) { + if (*$self->{CompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) { $x .= *$self->{CompSize}->getPacked_V64() ; } else { substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ; @@ -406,8 +535,8 @@ sub mkFinalTrailer $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir $z64e .= pack 'V', 1 ; # Total number of disks - $cd_offset = 0xFFFFFFFF ; - $cd_len = 0xFFFFFFFF if $cd_len >= 0xFFFFFFFF ; + $cd_offset = MAX32 ; + $cd_len = MAX32 if isGeMax32 $cd_len ; $entries = 0xFFFF if $entries >= 0xFFFF ; } @@ -449,16 +578,20 @@ sub ckParams $got->value("CTime", $timeRef->[2]); } - # Unix2 Extended Attribute - if ($got->parsed('exUnix2') ) { - my $timeRef = $got->value('exUnix2'); - if ( defined $timeRef) { - return $self->saveErrorString(undef, "exUnix2 not a 2-element array ref") - if ref $timeRef ne 'ARRAY' || @$timeRef != 2; + # Unix2/3 Extended Attribute + for my $name (qw(exUnix2 exUnixN)) + { + if ($got->parsed($name) ) { + my $idRef = $got->value($name); + if ( defined $idRef) { + return $self->saveErrorString(undef, "$name not a 2-element array ref") + if ref $idRef ne 'ARRAY' || @$idRef != 2; + } + + $got->value("UID", $idRef->[0]); + $got->value("GID", $idRef->[1]); + $got->value("want_$name", $idRef); } - - $got->value("UID", $timeRef->[0]); - $got->value("GID", $timeRef->[1]); } *$self->{ZipData}{AnyZip64} = 1 @@ -475,9 +608,8 @@ sub ckParams ! defined $IO::Compress::Adapter::Bzip2::VERSION; return $self->saveErrorString(undef, "Lzma not available") - if $method == ZIP_CM_LZMA ; - #and - #! defined $IO::Compress::Adapter::Lzma::VERSION; + if $method == ZIP_CM_LZMA + and ! defined $IO::Compress::Adapter::Lzma::VERSION; *$self->{ZipData}{Method} = $method; @@ -499,9 +631,28 @@ sub ckParams if defined $IO::Compress::Bzip2::VERSION and ! IO::Compress::Bzip2::ckParams($self, $got); + if ($got->parsed('Sparse') ) { + *$self->{ZipData}{Sparse} = $got->value('Sparse') ; + *$self->{ZipData}{Method} = ZIP_CM_STORE; + } + + if ($got->parsed('FilterName')) { + my $v = $got->value('FilterName') ; + *$self->{ZipData}{FilterName} = $v + if ref $v eq 'CODE' ; + } + return 1 ; } +sub outputPayload +{ + my $self = shift ; + return 1 if *$self->{ZipData}{Sparse} ; + return $self->output(@_); +} + + #sub newHeader #{ # my $self = shift ; @@ -513,14 +664,14 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.033 qw(:Parse); - use Compress::Raw::Zlib 2.033 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); + use IO::Compress::Base::Common 2.048 qw(:Parse); + use Compress::Raw::Zlib 2.048 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(), @@ -535,9 +686,13 @@ sub getExtraParams 'Comment' => [0, 1, Parse_any, ''], 'ZipComment'=> [0, 1, Parse_any, ''], 'Name' => [0, 1, Parse_any, ''], + 'FilterName'=> [0, 1, Parse_code, undef], + 'CanonicalName'=> [0, 1, Parse_boolean, 0], + #'UTF8' => [0, 1, Parse_boolean, 0], 'Time' => [0, 1, Parse_any, undef], 'exTime' => [0, 1, Parse_any, undef], 'exUnix2' => [0, 1, Parse_any, undef], + 'exUnixN' => [0, 1, Parse_any, undef], 'ExtAttr' => [0, 1, Parse_any, $Compress::Raw::Zlib::gzip_os_code == 3 ? 0100644 << 16 @@ -548,6 +703,13 @@ sub getExtraParams 'ExtraFieldLocal' => [0, 1, Parse_any, undef], 'ExtraFieldCentral'=> [0, 1, Parse_any, undef], + # Lzma + 'Preset' => [0, 1, Parse_unsigned, 6], + 'Extreme' => [1, 1, Parse_boolean, 0], + + # For internal use only + 'Sparse' => [0, 1, Parse_unsigned, 0], + @Bzip2, ); } @@ -564,8 +726,31 @@ sub getFileInfo my $params = shift; my $filename = shift ; - my ($mode, $uid, $gid, $atime, $mtime, $ctime) - = (stat($filename))[2, 4,5, 8,9,10] ; + if (isaScalar($filename)) + { + $params->value(Zip64 => 1) + if isGeMax32 length (${ $filename }) ; + + return ; + } + + my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ; + if ( $params->parsed('StoreLinks') ) + { + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + = (lstat($filename))[2, 4,5,7, 8,9,10] ; + } + else + { + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + = (stat($filename))[2, 4,5,7, 8,9,10] ; + } + + $params->value(TextFlag => -T $filename ) + if ! $params->parsed('TextFlag'); + + $params->value(Zip64 => 1) + if isGeMax32 $size ; $params->value('Name' => $filename) if ! $params->parsed('Name') ; @@ -578,13 +763,21 @@ sub getFileInfo $params->value('MTime' => $mtime) ; $params->value('ATime' => $atime) ; $params->value('CTime' => undef) ; # No Creation time - $params->value("exTime", [$mtime, $atime, undef]); + # TODO - see if can fillout creation time on non-Unix } # NOTE - Unix specific code alert - $params->value('ExtAttr' => $mode << 16) - if ! $params->parsed('ExtAttr'); + if (! $params->parsed('ExtAttr')) + { + use Fcntl qw(:mode) ; + my $attr = $mode << 16; + $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ; + $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ; + + $params->value('ExtAttr' => $attr); + } + $params->value('want_exUnixN', [$uid, $gid]); $params->value('UID' => $uid) ; $params->value('GID' => $gid) ; @@ -625,11 +818,29 @@ sub mkUnix2Extra $ids); } +sub mkUnixNExtra +{ + my $uid = shift; + my $gid = shift; + + # Assumes UID/GID are 32-bit + my $ids ; + $ids .= pack "C", 1; # version + $ids .= pack "C", $Config{uidsize}; + $ids .= pack "V", $uid; + $ids .= pack "C", $Config{gidsize}; + $ids .= pack "V", $gid; + + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, + $ids); +} + # from Archive::Zip sub _unixToDosTime # Archive::Zip::Member { my $time_t = shift; + # TODO - add something to cope with unix time < 1980 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); my $dt = 0; @@ -705,11 +916,14 @@ zip files and buffers. It is not a general-purpose file archiver. If that is what you want, check out C<Archive::Zip>. At present three compression methods are supported by IO::Compress::Zip, -namely Store (no compression at all), Deflate and Bzip2. +namely Store (no compression at all), Deflate, Bzip2 and LZMA. Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must be installed. +Note that to create LZMA content, the module C<IO::Compress::Lzma> must +be installed. + For reading zip files/buffers, see the companion module L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>. @@ -780,10 +994,10 @@ See L<File::GlobMapper|File::GlobMapper> for more details. If the C<$input> parameter is any other type, C<undef> will be returned. In addition, if C<$input> is a simple filename, the default values for -the C<Name>, C<Time>, C<ExtAttr> and C<exTime> options will be sourced from that file. +the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options will be sourced from that file. If you do not want to use these defaults they can be overridden by -explicitly setting the C<Name>, C<Time>, C<ExtAttr> and C<exTime> options or by setting the +explicitly setting the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options or by setting the C<Minimal> parameter. =head3 The C<$output> parameter @@ -1060,12 +1274,67 @@ This parameter defaults to 0. Stores the contents of C<$string> in the zip filename header field. -If C<Name> is not specified and the C<$input> parameter is a filename that -will be used for the zip filename header field. +If C<Name> is not specified and the C<$input> parameter is a filename, the +value of C<$input> will be used for the zip filename header field. If C<Name> is not specified and the C<$input> parameter is not a filename, no zip filename field will be created. +Note that both the C<CanonicalName> and C<FilterName> options +can modify the value used for the zip filename header field. + +=item C<< CanonicalName => 0|1 >> + +This option controls whether the filename field in the zip header is +I<normalized> into Unix format before being written to the zip file. + +It is recommended that you enable this option unless you really need +to create a non-standard Zip file. + +This is what APPNOTE.TXT has to say on what should be stored in the zip +filename header field. + + The name of the file, with optional relative path. + The path stored should not contain a drive or + device letter, or a leading slash. All slashes + should be forward slashes '/' as opposed to + backwards slashes '\' for compatibility with Amiga + and UNIX file systems etc. + +This option defaults to B<false>. + +=item C<< FilterName => sub { ... } >> + +This option allow the filename field in the zip header to be modified +before it is written to the zip file. + +This option takes a parameter that must be a reference to a sub. On entry +to the sub the C<$_> variable will contain the name to be filtered. If no +filename is available C<$_> will contain an empty string. + +The value of C<$_> when the sub returns will be stored in the filename +header field. + +Note that if C<CanonicalName> is enabled, a +normalized filename will be passed to the sub. + +If you use C<FilterName> to modify the filename, it is your responsibility +to keep the filename in Unix format. + +Although this option can be used with the OO ointerface, it is of most use +with the one-shot interface. For example, the code below shows how +C<FilterName> can be used to remove the path component from a series of +filenames before they are stored in C<$zipfile>. + + sub compressTxtFiles + { + my $zipfile = shift ; + my $dir = shift ; + + zip [ <$dir/*.txt> ] => $zipfile, + FilterName => sub { s[^$dir/][] } ; + } + =item C<< Time => $number >> Sets the last modified time field in the zip header to $number. @@ -1111,18 +1380,37 @@ By default no extended time field is created. =item C<< exUnix2 => [$uid, $gid] >> This option expects an array reference with exactly two elements: C<$uid> -and C<$gid>. These values correspond to the numeric user ID and group ID -of the owner of the files respectively. +and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID +(GID) of the owner of the files respectively. When the C<exUnix2> option is present it will trigger the creation of a -Unix2 extra field (ID is "Ux") in the local zip. This will be populated -with C<$uid> and C<$gid>. In addition an empty Unix2 extra field will also -be created in the central zip header +Unix2 extra field (ID is "Ux") in the local zip header. This will be populated +with C<$uid> and C<$gid>. An empty Unix2 extra field will also +be created in the central zip header. + +Note - The UID & GID are stored as 16-bit +integers in the "Ux" field. Use C<< exUnixN >> if your UID or GID are +32-bit. If the C<Minimal> option is set to true, this option will be ignored. By default no Unix2 extra field is created. +=item C<< exUnixN => [$uid, $gid] >> + +This option expects an array reference with exactly two elements: C<$uid> +and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID +(GID) of the owner of the files respectively. + +When the C<exUnixN> option is present it will trigger the creation of a +UnixN extra field (ID is "ux") in bothe the local and central zip headers. +This will be populated with C<$uid> and C<$gid>. +The UID & GID are stored as 32-bit integers. + +If the C<Minimal> option is set to true, this option will be ignored. + +By default no UnixN extra field is created. + =item C<< Comment => $comment >> Stores the contents of C<$comment> in the Central File Header of @@ -1139,12 +1427,12 @@ By default, no comment field is written to the zip file. =item C<< Method => $method >> -Controls which compression method is used. At present three compression -methods are supported, namely Store (no compression at all), Deflate and -Bzip2. +Controls which compression method is used. At present four compression +methods are supported, namely Store (no compression at all), Deflate, +Bzip2 and Lzma. -The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 are used to -select the compression method. +The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2 and ZIP_CM_LZMA +are used to select the compression method. These constants are not imported by C<IO::Compress::Zip> by default. @@ -1156,6 +1444,10 @@ Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must be installed. A fatal error will be thrown if you attempt to create Bzip2 content when C<IO::Compress::Bzip2> is not available. +Note that to create Lzma content, the module C<IO::Compress::Lzma> must +be installed. A fatal error will be thrown if you attempt to create Lzma +content when C<IO::Compress::Lzma> is not available. + The default method is ZIP_CM_DEFLATE. =item C<< Stream => 0|1 >> @@ -1170,11 +1462,14 @@ The default is 1. =item C<< Zip64 => 0|1 >> -Create a Zip64 zip file/buffer. This option should only be used if you want -to store files larger than 4 Gig. +Create a Zip64 zip file/buffer. This option is used if you want +to store files larger than 4 Gig. + +C<Zip64> will be automatically set, as needed, if working with the one-shot +interface when the input is either a filename or a scalar reference. If you intend to manipulate the Zip64 zip files created with this module -using an external zip/unzip make sure that it supports Zip64. +using an external zip/unzip, make sure that it supports Zip64. In particular, if you are using Info-Zip you need to have zip version 3.x or better to update a Zip64 archive and unzip version 6.x to read a zip64 @@ -1188,6 +1483,9 @@ This parameter controls the setting of a bit in the zip central header. It is used to signal that the data stored in the zip file/buffer is probably text. +In one-shot mode this flag will be set to true if the Perl C<-T> operator thinks +the file contains text. + The default is 0. =item C<< ExtraFieldLocal => $data >> @@ -1227,6 +1525,9 @@ Alternatively the list of subfields can by supplied as a scalar, thus ExtraField => $rawdata +In this case C<IO::Compress::Zip> will check that C<$rawdata> consists of +zero or more conformant sub-fields. + The Extended Time field (ID "UT"), set using the C<exTime> option, and the Unix2 extra field (ID "Ux), set using the C<exUnix2> option, are examples of extra fields. @@ -1239,7 +1540,8 @@ The maximum size of an extra field 65535 bytes. If specified, this option will disable the creation of all extra fields in the zip local and central headers. So the C<exTime>, C<exUnix2>, -C<ExtraFieldLocal> and C<ExtraFieldCentral> options will be ignored. +C<exUnixN>, C<ExtraFieldLocal> and C<ExtraFieldCentral> options will +be ignored. This parameter defaults to 0. @@ -1266,6 +1568,32 @@ otherwise. The default is 0. +=item C<< Preset => number >> + +Used to choose the LZMA compression preset. + +Valid values are 0-9 and C<LZMA_PRESET_DEFAULT>. + +0 is the fastest compression with the lowest memory usage and the lowest +compression. + +9 is the slowest compession with the highest memory usage but with the best +compression. + +This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored +otherwise. + +Defaults to C<LZMA_PRESET_DEFAULT> (6). + +=item C<< Extreme => 0|1 >> + +Makes LZMA compression a lot slower, but a small compression gain. + +This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored +otherwise. + +Defaults to 0. + =item -Level Defines the compression level used by zlib. The value should either be @@ -1460,7 +1788,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -1579,8 +1907,6 @@ constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -1589,7 +1915,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1618,7 +1944,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2011 Paul Marquess. All rights reserved. +Copyright (c) 2005-2012 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/IO/Compress/Zip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm index 44fd5e891d0..8db079cb93d 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.033'; +$VERSION = '2.048'; @ISA = qw(Exporter); @@ -38,7 +38,9 @@ $VERSION = '2.033'; ZIP_EXTRA_ID_ZIP64 ZIP_EXTRA_ID_EXT_TIMESTAMP ZIP_EXTRA_ID_INFO_ZIP_UNIX2 - ZIP_EXTRA_ID_INFO_ZIP_UNIXn + ZIP_EXTRA_ID_INFO_ZIP_UNIXN + ZIP_EXTRA_ID_INFO_ZIP_Upath + ZIP_EXTRA_ID_INFO_ZIP_Ucom ZIP_EXTRA_ID_JAVA_EXE ZIP_OS_CODE_UNIX @@ -49,6 +51,12 @@ $VERSION = '2.033'; %ZIP_CM_MIN_VERSIONS ZIP64_MIN_VERSION + ZIP_A_RONLY + ZIP_A_HIDDEN + ZIP_A_SYSTEM + ZIP_A_LABEL + ZIP_A_DIR + ZIP_A_ARCHIVE ); # Compression types supported @@ -72,6 +80,7 @@ use constant ZIP_IFA_TEXT_MASK => 1; # Signatures for each of the headers use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; use constant ZIP_DATA_HDR_SIG => 0x08074b50; +use constant packed_ZIP_DATA_HDR_SIG => pack "V", ZIP_DATA_HDR_SIG; use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50; @@ -86,16 +95,27 @@ use constant ZIP_OS_CODE_DEFAULT => 3; use constant ZIP_EXTRA_ID_ZIP64 => pack "v", 1; use constant ZIP_EXTRA_ID_EXT_TIMESTAMP => "UT"; use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2 => "Ux"; -use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXn => "ux"; +use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN => "ux"; +use constant ZIP_EXTRA_ID_INFO_ZIP_Upath => "up"; +use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom => "uc"; use constant ZIP_EXTRA_ID_JAVA_EXE => pack "v", 0xCAFE; +# DOS Attributes +use constant ZIP_A_RONLY => 0x01; +use constant ZIP_A_HIDDEN => 0x02; +use constant ZIP_A_SYSTEM => 0x04; +use constant ZIP_A_LABEL => 0x08; +use constant ZIP_A_DIR => 0x10; +use constant ZIP_A_ARCHIVE => 0x20; + use constant ZIP64_MIN_VERSION => 45; %ZIP_CM_MIN_VERSIONS = ( - ZIP_CM_STORE() => 20, - ZIP_CM_DEFLATE() => 20, - ZIP_CM_BZIP2() => 46, - ZIP_CM_LZMA() => 63, + ZIP_CM_STORE() => 20, + ZIP_CM_DEFLATE() => 20, + ZIP_CM_BZIP2() => 46, + ZIP_CM_LZMA() => 63, + ZIP_CM_PPMD() => 63, ); diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm index 4c2d5eb00f6..992b1b925f2 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.033'; +$VERSION = '2.048'; @ISA = qw(Exporter); diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm index 3b13e291cc6..9e0be2e4b6c 100644 --- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm +++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm @@ -1,6 +1,6 @@ package IO::Compress::Zlib::Extra; -require 5.004 ; +require 5.006 ; use strict ; use warnings; @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.033'; +$VERSION = '2.048'; -use IO::Compress::Gzip::Constants 2.033 ; +use IO::Compress::Gzip::Constants 2.048 ; sub ExtraFieldError { @@ -98,6 +98,38 @@ sub parseRawExtra return undef ; } +sub findID +{ + my $id_want = shift ; + my $data = shift; + + my $XLEN = length $data ; + + my $offset = 0 ; + while ($offset < $XLEN) { + + return undef + if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; + + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; + + my $subLen = unpack("v", substr($data, $offset, + GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); + $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; + + return undef + if $offset + $subLen > $XLEN ; + + return substr($data, $offset, $subLen) + if $id eq $id_want ; + + $offset += $subLen ; + } + + return undef ; +} + sub mkSubField { @@ -142,7 +174,6 @@ sub parseExtraField return parseRawExtra($dataRef, undef, 1, $gzipMode); } - #my $data = $$dataRef; my $data = $dataRef; my $out = '' ; @@ -163,7 +194,7 @@ sub parseExtraField return ExtraFieldError("Not even number of elements") unless @$data % 2 == 0; - for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) { + for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { my $bad = validateExtraFieldPair([$data->[$ix], $data->[$ix+1]], $strict, $gzipMode) ; |