diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO')
35 files changed, 1951 insertions, 465 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) ; diff --git a/Master/tlpkg/tlperl/lib/IO/Dir.pm b/Master/tlpkg/tlperl/lib/IO/Dir.pm index 74d07784668..7326d7823d4 100644 --- a/Master/tlpkg/tlperl/lib/IO/Dir.pm +++ b/Master/tlpkg/tlperl/lib/IO/Dir.pm @@ -19,7 +19,7 @@ use File::stat; use File::Spec; @ISA = qw(Tie::Hash Exporter); -$VERSION = "1.08"; +$VERSION = "1.10"; $VERSION = eval $VERSION; @EXPORT_OK = qw(DIR_UNLINK); @@ -186,7 +186,7 @@ argument which, if given, C<new> will pass to C<open> =back The following methods are wrappers for the directory related functions built -into perl (the trailing `dir' has been removed from the names). See L<perlfunc> +into perl (the trailing 'dir' has been removed from the names). See L<perlfunc> for details of these functions. =over 4 @@ -237,7 +237,7 @@ L<File::stat> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/File.pm b/Master/tlpkg/tlperl/lib/IO/File.pm index 1162c812e3a..8b29bac2210 100644 --- a/Master/tlpkg/tlperl/lib/IO/File.pm +++ b/Master/tlpkg/tlperl/lib/IO/File.pm @@ -131,13 +131,12 @@ use Carp; use Symbol; use SelectSaver; use IO::Seekable; -use File::Spec; require Exporter; @ISA = qw(IO::Handle IO::Seekable Exporter); -$VERSION = "1.15"; +$VERSION = "1.16"; @EXPORT = @IO::Seekable::EXPORT; diff --git a/Master/tlpkg/tlperl/lib/IO/Handle.pm b/Master/tlpkg/tlperl/lib/IO/Handle.pm index 6ca3c8a35d6..68e6d902e44 100644 --- a/Master/tlpkg/tlperl/lib/IO/Handle.pm +++ b/Master/tlpkg/tlperl/lib/IO/Handle.pm @@ -268,7 +268,7 @@ use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); -$VERSION = "1.31"; +$VERSION = "1.33"; $VERSION = eval $VERSION; @EXPORT_OK = qw( @@ -430,14 +430,14 @@ sub say { print $this @_; } +# Special XS wrapper to make them inherit lexical hints from the caller. +_create_getline_subs( <<'END' ) or die $@; sub getline { @_ == 1 or croak 'usage: $io->getline()'; my $this = shift; return scalar <$this>; } -*gets = \&getline; # deprecated - sub getlines { @_ == 1 or croak 'usage: $io->getlines()'; wantarray or @@ -445,6 +445,10 @@ sub getlines { my $this = shift; return <$this>; } +1; # return true for error checking +END + +*gets = \&getline; # deprecated sub truncate { @_ == 2 or croak 'usage: $io->truncate(LEN)'; diff --git a/Master/tlpkg/tlperl/lib/IO/Pipe.pm b/Master/tlpkg/tlperl/lib/IO/Pipe.pm index 3b4313abb1f..684069f4b7e 100644 --- a/Master/tlpkg/tlperl/lib/IO/Pipe.pm +++ b/Master/tlpkg/tlperl/lib/IO/Pipe.pm @@ -14,7 +14,7 @@ our($VERSION); use Carp; use Symbol; -$VERSION = "1.14"; +$VERSION = "1.15"; sub new { my $type = shift; @@ -246,7 +246,7 @@ L<IO::Handle> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Poll.pm b/Master/tlpkg/tlperl/lib/IO/Poll.pm index cf7ab26f75b..47f1a135595 100644 --- a/Master/tlpkg/tlperl/lib/IO/Poll.pm +++ b/Master/tlpkg/tlperl/lib/IO/Poll.pm @@ -13,7 +13,7 @@ use Exporter (); our(@ISA, @EXPORT_OK, @EXPORT, $VERSION); @ISA = qw(Exporter); -$VERSION = "0.08"; +$VERSION = "0.09"; @EXPORT = qw( POLLIN POLLOUT @@ -198,7 +198,7 @@ L<poll(2)>, L<IO::Handle>, L<IO::Select> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Select.pm b/Master/tlpkg/tlperl/lib/IO/Select.pm index 14b9797a957..756a299c348 100644 --- a/Master/tlpkg/tlperl/lib/IO/Select.pm +++ b/Master/tlpkg/tlperl/lib/IO/Select.pm @@ -11,7 +11,7 @@ use warnings::register; use vars qw($VERSION @ISA); require Exporter; -$VERSION = "1.20"; +$VERSION = "1.21"; @ISA = qw(Exporter); # This is only so we can do version checking @@ -375,7 +375,7 @@ listening for more connections on a listen socket =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Socket.pm b/Master/tlpkg/tlperl/lib/IO/Socket.pm index 31fa18f95d4..529423b5fde 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket.pm @@ -1,3 +1,4 @@ + # IO::Socket.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. @@ -23,7 +24,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); @ISA = qw(IO::Handle); -$VERSION = "1.32"; +$VERSION = "1.34"; @EXPORT_OK = qw(sockatmark); @@ -118,7 +119,18 @@ sub connect { my $sel = new IO::Select $sock; undef $!; - if (!$sel->can_write($timeout)) { + my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout); + if(@$e[0]) { + # Windows return from select after the timeout in case of + # WSAECONNREFUSED(10061) if exception set is not used. + # This behavior is different from Linux. + # Using the exception + # set we now emulate the behavior in Linux + # - Karthik Rajagopalan + $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); + $@ = "connect: $err"; + } + elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); $@ = "connect: timeout"; } @@ -524,7 +536,7 @@ L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX> =head1 AUTHOR Graham Barr. atmark() by Lincoln Stein. Currently maintained by the -Perl Porters. Please report all bugs to <perl5-porters@perl.org>. +Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm b/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm index 2f0e5d1d7a6..5af70303d29 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket/INET.pm @@ -15,7 +15,7 @@ use Exporter; use Errno; @ISA = qw(IO::Socket); -$VERSION = "1.31"; +$VERSION = "1.33"; my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; @@ -338,22 +338,23 @@ In addition to the key-value pairs accepted by L<IO::Socket>, C<IO::Socket::INET> provides. - PeerAddr Remote host address <hostname>[:<port>] - PeerHost Synonym for PeerAddr - PeerPort Remote port or service <service>[(<no>)] | <no> - LocalAddr Local host bind address hostname[:port] - LocalHost Synonym for LocalAddr - LocalPort Local host bind port <service>[(<no>)] | <no> - Proto Protocol name (or number) "tcp" | "udp" | ... - Type Socket type SOCK_STREAM | SOCK_DGRAM | ... - Listen Queue size for listen - ReuseAddr Set SO_REUSEADDR before binding - Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) - ReusePort Set SO_REUSEPORT before binding - Broadcast Set SO_BROADCAST before binding - Timeout Timeout value for various operations - MultiHomed Try all addresses for multi-homed hosts - Blocking Determine if connection will be blocking mode + PeerAddr Remote host address <hostname>[:<port>] + PeerHost Synonym for PeerAddr + PeerPort Remote port or service <service>[(<no>)] | <no> + LocalAddr Local host bind address hostname[:port] + LocalHost Synonym for LocalAddr + LocalPort Local host bind port <service>[(<no>)] | <no> + Proto Protocol name (or number) "tcp" | "udp" | ... + Type Socket type SOCK_STREAM | SOCK_DGRAM | ... + Listen Queue size for listen + ReuseAddr Set SO_REUSEADDR before binding + Reuse Set SO_REUSEADDR before binding (deprecated, + prefer ReuseAddr) + ReusePort Set SO_REUSEPORT before binding + Broadcast Set SO_BROADCAST before binding + Timeout Timeout value for various operations + MultiHomed Try all addresses for multi-homed hosts + Blocking Determine if connection will be blocking mode If C<Listen> is defined then a listen socket is created, else if the socket type, which is derived from the protocol, is SOCK_STREAM then @@ -397,12 +398,13 @@ Examples: $sock = IO::Socket::INET->new('127.0.0.1:25'); - $sock = IO::Socket::INET->new(PeerPort => 9999, - PeerAddr => inet_ntoa(INADDR_BROADCAST), - Proto => udp, - LocalAddr => 'localhost', - Broadcast => 1 ) - or die "Can't bind : $@\n"; + $sock = IO::Socket::INET->new( + PeerPort => 9999, + PeerAddr => inet_ntoa(INADDR_BROADCAST), + Proto => udp, + LocalAddr => 'localhost', + Broadcast => 1 ) + or die "Can't bind : $@\n"; NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE @@ -453,7 +455,7 @@ L<Socket>, L<IO::Socket> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm b/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm index baa092ba1fb..c6a10fea805 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket/UNIX.pm @@ -12,7 +12,7 @@ use IO::Socket; use Carp; @ISA = qw(IO::Socket); -$VERSION = "1.23"; +$VERSION = "1.24"; $VERSION = eval $VERSION; IO::Socket::UNIX->register_domain( AF_UNIX ); @@ -132,7 +132,7 @@ L<Socket>, L<IO::Socket> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all -bugs to <perl5-porters@perl.org>. +bugs to <perlbug@perl.org>. =head1 COPYRIGHT diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm index 6703e59285a..516c5dda4f0 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,12 +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::Raw::Bzip2 2.033 ; +use Compress::Raw::Bzip2 2.048 ; our ($VERSION, @ISA); -$VERSION = '2.033'; +$VERSION = '2.048'; sub mkUncompObject { diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm index 0705a1c9d26..5d74d042124 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,47 +4,131 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); +use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.033'; +$VERSION = '2.048'; -use Compress::Raw::Zlib 2.033 (); +use Compress::Raw::Zlib 2.048 (); sub mkUncompObject { + my $streaming = shift; + my $zip64 = shift; + my $crc32 = 1; #shift ; my $adler32 = shift; - bless { 'CompSize' => 0, + bless { 'CompSize' => new U64 , # 0, 'UnCompSize' => 0, 'wantCRC32' => $crc32, 'CRC32' => Compress::Raw::Zlib::crc32(''), 'wantADLER32'=> $adler32, 'ADLER32' => Compress::Raw::Zlib::adler32(''), 'ConsumesInput' => 1, + 'Streaming' => $streaming, + 'Zip64' => $zip64, + 'DataHdrSize' => $zip64 ? 24 : 16, + 'Pending' => '', } ; } + sub uncompr { my $self = shift; + my $in = $_[0]; my $eof = $_[2]; - if (defined ${ $_[0] } && length ${ $_[0] }) { - $self->{CompSize} += length ${ $_[0] } ; - $self->{UnCompSize} = $self->{CompSize} ; - - $self->{CRC32} = Compress::Raw::Zlib::crc32($_[0], $self->{CRC32}) - if $self->{wantCRC32}; - - $self->{ADLER32} = Compress::Zlib::adler32($_[0], $self->{ADLER32}) - if $self->{wantADLER32}; - - ${ $_[1] } .= ${ $_[0] }; - ${ $_[0] } = ""; + my $len = length $$in; + my $remainder = ''; + + if (defined $$in && $len) { + + if ($self->{Streaming}) { + + if (length $self->{Pending}) { + $$in = $self->{Pending} . $$in ; + $len = length $$in; + $self->{Pending} = ''; + } + + my $ind = index($$in, "\x50\x4b\x07\x08"); + + if ($ind < 0) { + $len = length $$in; + if ($len >= 3 && substr($$in, -3) eq "\x50\x4b\x07") { + $ind = $len - 3 ; + } + elsif ($len >= 2 && substr($$in, -2) eq "\x50\x4b") { + $ind = $len - 2 ; + } + elsif ($len >= 1 && substr($$in, -1) eq "\x50") { + $ind = $len - 1 ; + } + } + + if ($ind >= 0) { + $remainder = substr($$in, $ind) ; + substr($$in, $ind) = '' ; + } + } + + if (length $remainder && length $remainder < $self->{DataHdrSize}) { + $self->{Pending} = $remainder ; + $remainder = ''; + } + elsif (length $remainder >= $self->{DataHdrSize}) { + my $crc = unpack "V", substr($remainder, 4); + if ($crc == Compress::Raw::Zlib::crc32($$in, $self->{CRC32})) { + my ($l1, $l2) ; + + if ($self->{Zip64}) { + $l1 = U64::newUnpack_V64(substr($remainder, 8)); + $l2 = U64::newUnpack_V64(substr($remainder, 16)); + } + else { + $l1 = U64::newUnpack_V32(substr($remainder, 8)); + $l2 = U64::newUnpack_V32(substr($remainder, 12)); + } + + my $newLen = $self->{CompSize}->clone(); + $newLen->add(length $$in); + if ($l1->equal($l2) && $l1->equal($newLen) ) { + $eof = 1; + } + else { + $$in .= substr($remainder, 0, 4) ; + $remainder = substr($remainder, 4); + #$self->{Pending} = substr($remainder, 4); + #$remainder = ''; + $eof = 0; + } + } + else { + $$in .= substr($remainder, 0, 4) ; + $remainder = substr($remainder, 4); + #$self->{Pending} = substr($remainder, 4); + #$remainder = ''; + $eof = 0; + } + } + + if (length $$in) { + $self->{CompSize}->add(length $$in) ; + + $self->{CRC32} = Compress::Raw::Zlib::crc32($$in, $self->{CRC32}) + if $self->{wantCRC32}; + + $self->{ADLER32} = Compress::Zlib::adler32($$in, $self->{ADLER32}) + if $self->{wantADLER32}; + } + + ${ $_[1] } .= $$in; + $$in = $remainder; } return STATUS_ENDSTREAM if $eof; @@ -63,7 +147,6 @@ sub reset return STATUS_OK ; } - #sub count #{ # my $self = shift ; @@ -73,13 +156,13 @@ sub reset sub compressedBytes { my $self = shift ; - return $self->{UnCompSize} ; + return $self->{CompSize} ; } sub uncompressedBytes { my $self = shift ; - return $self->{UnCompSize} ; + return $self->{CompSize} ; } sub sync diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm index dc0365ce009..c0f3542a98a 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ 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_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common 2.048 qw(:Status); +use Compress::Raw::Zlib 2.048 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); -$VERSION = '2.033'; +$VERSION = '2.048'; diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm index 796230ec92a..a6ab437159a 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm @@ -6,22 +6,22 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -use IO::Uncompress::Adapter::Inflate 2.033 (); +use IO::Uncompress::Adapter::Inflate 2.048 (); -use IO::Uncompress::Base 2.033 ; -use IO::Uncompress::Gunzip 2.033 ; -use IO::Uncompress::Inflate 2.033 ; -use IO::Uncompress::RawInflate 2.033 ; -use IO::Uncompress::Unzip 2.033 ; +use IO::Uncompress::Base 2.048 ; +use IO::Uncompress::Gunzip 2.048 ; +use IO::Uncompress::Inflate 2.048 ; +use IO::Uncompress::RawInflate 2.048 ; +use IO::Uncompress::Unzip 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.033'; +$VERSION = '2.048'; $AnyInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -48,7 +48,7 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.033 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ) ; } @@ -856,7 +856,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 @@ -951,7 +951,7 @@ See L<IO::Uncompress::AnyInflate::FAQ|IO::Uncompress::AnyInflate::FAQ/"Compresse 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::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>, @@ -980,7 +980,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/Uncompress/AnyUncompress.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm index 64d2fa001a8..d9a48e6a240 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm @@ -4,16 +4,16 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -use IO::Uncompress::Base 2.033 ; +use IO::Uncompress::Base 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.033'; +$VERSION = '2.048'; $AnyUncompressError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -27,22 +27,22 @@ Exporter::export_ok_tags('all'); BEGIN { - eval ' use IO::Uncompress::Adapter::Inflate 2.033 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.033 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.033 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.033 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.020 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.020 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.033 ;'; - eval ' use IO::Uncompress::UnLzop 2.033 ;'; - eval ' use IO::Uncompress::Gunzip 2.033 ;'; - eval ' use IO::Uncompress::Inflate 2.033 ;'; - eval ' use IO::Uncompress::RawInflate 2.033 ;'; - eval ' use IO::Uncompress::Unzip 2.033 ;'; - eval ' use IO::Uncompress::UnLzf 2.033 ;'; - eval ' use IO::Uncompress::UnLzma 2.033 ;'; - eval ' use IO::Uncompress::UnXz 2.033 ;'; + eval ' use IO::Uncompress::Adapter::Inflate 2.048 ;'; + eval ' use IO::Uncompress::Adapter::Bunzip2 2.048 ;'; + eval ' use IO::Uncompress::Adapter::LZO 2.048 ;'; + eval ' use IO::Uncompress::Adapter::Lzf 2.048 ;'; + eval ' use IO::Uncompress::Adapter::UnLzma 2.048 ;'; + eval ' use IO::Uncompress::Adapter::UnXz 2.048 ;'; + + eval ' use IO::Uncompress::Bunzip2 2.048 ;'; + eval ' use IO::Uncompress::UnLzop 2.048 ;'; + eval ' use IO::Uncompress::Gunzip 2.048 ;'; + eval ' use IO::Uncompress::Inflate 2.048 ;'; + eval ' use IO::Uncompress::RawInflate 2.048 ;'; + eval ' use IO::Uncompress::Unzip 2.048 ;'; + eval ' use IO::Uncompress::UnLzf 2.048 ;'; + eval ' use IO::Uncompress::UnLzma 2.048 ;'; + eval ' use IO::Uncompress::UnXz 2.048 ;'; } sub new @@ -60,7 +60,7 @@ sub anyuncompress sub getExtraParams { - use IO::Compress::Base::Common 2.033 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'RawInflate' => [1, 1, Parse_boolean, 0] , 'UnLzma' => [1, 1, Parse_boolean, 0] ) ; } @@ -904,7 +904,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 @@ -995,7 +995,7 @@ Same as doing this 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<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>, @@ -1011,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/Uncompress/Base.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm index 77e4a8c5810..cb1e15e9aef 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm @@ -9,13 +9,12 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(Exporter IO::File); -$VERSION = '2.033'; +$VERSION = '2.048'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.033 ; -#use Parse::Parameters ; +use IO::Compress::Base::Common 2.048 ; use IO::File ; use Symbol; @@ -25,16 +24,12 @@ use Carp ; %EXPORT_TAGS = ( ); push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; -#Exporter::export_ok_tags('all') ; - - sub smartRead { my $self = $_[0]; my $out = $_[1]; my $size = $_[2]; - #$$out = "" ; $$out = "" ; my $offset = 0 ; @@ -48,7 +43,6 @@ sub smartRead } if ( length *$self->{Prime} ) { - #$$out = substr(*$self->{Prime}, 0, $size, '') ; $$out = substr(*$self->{Prime}, 0, $size) ; substr(*$self->{Prime}, 0, $size) = '' ; if (length $$out == $size) { @@ -86,7 +80,6 @@ sub smartRead } if (length $$out > $size ) { - #*$self->{Prime} = substr($$out, $size, length($$out), ''); *$self->{Prime} = substr($$out, $size, length($$out)); substr($$out, $size, length($$out)) = ''; } @@ -97,7 +90,6 @@ sub smartRead no warnings 'uninitialized'; my $buf = *$self->{Buffer} ; $$buf = '' unless defined $$buf ; - #$$out = '' unless defined $$out ; substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size); if (*$self->{ConsumeInput}) { substr($$buf, 0, $get_size) = '' } @@ -148,19 +140,38 @@ sub smartSeek my $self = shift ; my $offset = shift ; my $truncate = shift; - #print "smartSeek to $offset\n"; + my $position = shift || SEEK_SET; # TODO -- need to take prime into account if (defined *$self->{FH}) - { *$self->{FH}->seek($offset, SEEK_SET) } + { *$self->{FH}->seek($offset, $position) } else { - *$self->{BufferOffset} = $offset ; + if ($position == SEEK_END) { + *$self->{BufferOffset} = length ${ *$self->{Buffer} } + $offset ; + } + elsif ($position == SEEK_CUR) { + *$self->{BufferOffset} += $offset ; + } + else { + *$self->{BufferOffset} = $offset ; + } + substr(${ *$self->{Buffer} }, *$self->{BufferOffset}) = '' if $truncate; return 1; } } +sub smartTell +{ + my $self = shift ; + + if (defined *$self->{FH}) + { return *$self->{FH}->tell() } + else + { return *$self->{BufferOffset} } +} + sub smartWrite { my $self = shift ; @@ -199,7 +210,8 @@ sub smartEof # # here, but this can cause trouble if # the filehandle is itself a tied handle, but it uses sysread. - # Then we get into mixing buffered & non-buffered IO, which will cause trouble + # Then we get into mixing buffered & non-buffered IO, + # which will cause trouble my $info = $self->getErrInfo(); @@ -207,7 +219,7 @@ sub smartEof my $status = $self->smartRead(\$buffer, 1); $self->pushBack($buffer) if length $buffer; $self->setErrInfo($info); - + return $status == 0 ; } elsif (defined *$self->{InputEvent}) @@ -244,8 +256,6 @@ sub saveStatus { my $self = shift ; my $errno = shift() + 0 ; - #return $errno unless $errno || ! defined *$self->{ErrorNo}; - #return $errno unless $errno ; *$self->{ErrorNo} = $errno; ${ *$self->{Error} } = '' ; @@ -259,12 +269,9 @@ sub saveErrorString my $self = shift ; my $retval = shift ; - #return $retval if ${ *$self->{Error} }; - ${ *$self->{Error} } = shift ; - *$self->{ErrorNo} = shift() + 0 if @_ ; + *$self->{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ; - #warn "saveErrorString: " . ${ *$self->{Error} } . " " . *$self->{Error} . "\n" ; return $retval; } @@ -482,14 +489,32 @@ sub _create return undef unless defined $status; - if ( ! $status) { + *$obj->{InNew} = 0; + *$obj->{Closed} = 0; + + if ($status) { + # Need to try uncompressing to catch the case + # where the compressed file uncompresses to an + # empty string - so eof is set immediately. + + my $out_buffer = ''; + + $status = $obj->read(\$out_buffer); + + if ($status < 0) { + *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ]; + } + + $obj->ungetc($out_buffer) + if length $out_buffer; + } + else { return undef unless *$obj->{Transparent}; $obj->clearError(); *$obj->{Type} = 'plain'; *$obj->{Plain} = 1; - #$status = $obj->mkIdentityUncomp($class, $got); $obj->pushBack(*$obj->{HeaderPending}) ; } @@ -706,7 +731,7 @@ sub _rd2 while (($status = $z->read($x->{buff})) > 0) { if ($fh) { - print $fh ${ $x->{buff} } + syswrite $fh, ${ $x->{buff} } or return $z->saveErrorString(undef, "Error writing to output file: $!", $!); ${ $x->{buff} } = '' ; } @@ -725,7 +750,6 @@ sub _rd2 } last if $status < 0 || $z->smartEof(); - #last if $status < 0 ; last unless *$self->{MultiStream}; @@ -784,7 +808,7 @@ sub readBlock } my $status = $self->smartRead($buff, $size) ; - return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!") + return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!) if $status == STATUS_ERROR ; if ($status == 0 ) { @@ -811,7 +835,6 @@ sub _raw_read my $self = shift ; return G_EOF if *$self->{Closed} ; - #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ; return G_EOF if *$self->{EndStream} ; my $buffer = shift ; @@ -851,6 +874,7 @@ sub _raw_read my $temp_buf = ''; my $outSize = 0; my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ; + return G_ERR if $status == STATUS_ERROR ; @@ -879,7 +903,7 @@ sub _raw_read *$self->{TotalInflatedBytesRead} += $buf_len ; *$self->{UnCompSize}->add($buf_len) ; - $self->filterUncompressed($buffer); + $self->filterUncompressed($buffer, $before_len); if (*$self->{Encoding}) { $$buffer = *$self->{Encoding}->decode($$buffer); @@ -889,8 +913,6 @@ sub _raw_read if ($status == STATUS_ENDSTREAM) { *$self->{EndStream} = 1 ; -#$self->pushBack($temp_buf) ; -#$temp_buf = ''; my $trailer; my $trailer_size = *$self->{Info}{TrailerLength} ; @@ -980,12 +1002,13 @@ sub gotoNextStream *$self->{NewStream} = 0 ; *$self->{EndStream} = 0 ; + *$self->{CompressedInputLengthDone} = undef ; + *$self->{CompressedInputLength} = undef ; $self->reset(); *$self->{UnCompSize}->reset(); *$self->{CompSize}->reset(); my $magic = $self->ckMagic(); - #*$self->{EndStream} = 0 ; if ( ! defined $magic) { if (! *$self->{Transparent} || $self->eof()) @@ -1021,6 +1044,13 @@ sub streamCount return scalar @{ *$self->{InfoList} } ; } +#sub read +#{ +# my $status = myRead(@_); +# return undef if $status < 0; +# return $status; +#} + sub read { # return codes @@ -1030,6 +1060,13 @@ sub read my $self = shift ; + if (defined *$self->{ReadStatus} ) { + my $status = *$self->{ReadStatus}[0]; + $self->saveErrorString( @{ *$self->{ReadStatus} } ); + delete *$self->{ReadStatus} ; + return $status ; + } + return G_EOF if *$self->{Closed} ; my $buffer ; @@ -1065,6 +1102,9 @@ sub read } } } + elsif (! defined $$buffer) { + $$buffer = '' ; + } return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ; @@ -1121,7 +1161,6 @@ sub read *$self->{Pending} = $out_buffer; $out_buffer = \*$self->{Pending} ; - #substr($$buffer, $offset) = substr($$out_buffer, 0, $length, '') ; substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ; substr($$out_buffer, 0, $length) = '' ; @@ -1137,7 +1176,7 @@ sub _getline if ( ! defined $/ ) { my $data ; 1 while ($status = $self->read($data)) > 0 ; - return $status < 0 ? \undef : \$data ; + return ($status, \$data); } # Record Mode @@ -1145,7 +1184,7 @@ sub _getline my $reclen = ${$/} ; my $data ; $status = $self->read($data, $reclen) ; - return $status < 0 ? \undef : \$data ; + return ($status, \$data); } # Paragraph Mode @@ -1155,47 +1194,54 @@ sub _getline if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; my $par = $1 ; - return \$par ; + return (1, \$par); } } - return $status < 0 ? \undef : \$paragraph; + return ($status, \$paragraph); } # $/ isn't empty, or a reference, so it's Line Mode. { my $line ; - 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 (($status = $self->read($line)) > 0 ) { my $offset = index($line, $/); if ($offset >= 0) { my $l = substr($line, 0, $offset + length $/ ); substr($line, 0, $offset + length $/) = ''; $$p = $line; - return \$l; + return (1, \$l); } } - return $status < 0 ? \undef : \$line; + return ($status, \$line); } } sub getline { my $self = shift; + + if (defined *$self->{ReadStatus} ) { + $self->saveErrorString( @{ *$self->{ReadStatus} } ); + delete *$self->{ReadStatus} ; + return undef; + } + + return undef + if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ; + my $current_append = *$self->{AppendOutput} ; *$self->{AppendOutput} = 1; - my $lineref = $self->_getline(); - $. = ++ *$self->{LineNo} if defined $$lineref ; + + my ($status, $lineref) = $self->_getline(); *$self->{AppendOutput} = $current_append; + + return undef + if $status < 0 || length $$lineref == 0 ; + + $. = ++ *$self->{LineNo} ; + return $$lineref ; } @@ -1289,7 +1335,6 @@ sub close if (defined *$self->{FH}) { if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { - #if ( *$self->{AutoClose}) { local $.; $! = 0 ; $status = *$self->{FH}->close(); @@ -1420,7 +1465,6 @@ sub input_line_number sub _notAvailable { my $name = shift ; - #return sub { croak "$name Not Available" ; } ; return sub { croak "$name Not Available: File opened only for intput" ; } ; } @@ -1460,7 +1504,7 @@ purpose if to to be sub-classed by IO::Uncompress 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>, @@ -1476,7 +1520,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/Uncompress/Bunzip2.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm index 39adbef079b..f53513a7e48 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); -use IO::Uncompress::Base 2.033 ; -use IO::Uncompress::Adapter::Bunzip2 2.033 ; +use IO::Uncompress::Base 2.048 ; +use IO::Uncompress::Adapter::Bunzip2 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error); -$VERSION = '2.033'; +$VERSION = '2.048'; $Bunzip2Error = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -40,7 +40,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 ( 'Verbosity' => [1, 1, Parse_boolean, 0], diff --git a/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm index 94fd6756d9e..bf803ae161b 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm @@ -1,7 +1,7 @@ package IO::Uncompress::Gunzip ; -require 5.004 ; +require 5.006 ; # for RFC1952 @@ -9,12 +9,12 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.033 ; +use IO::Uncompress::RawInflate 2.048 ; -use Compress::Raw::Zlib 2.033 qw( crc32 ) ; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.033 ; -use IO::Compress::Zlib::Extra 2.033 ; +use Compress::Raw::Zlib 2.048 () ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Compress::Gzip::Constants 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; require Exporter ; @@ -28,7 +28,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.033'; +$VERSION = '2.048'; sub new { @@ -47,7 +47,7 @@ sub gunzip sub getExtraParams { - use IO::Compress::Base::Common 2.033 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'ParseExtra' => [1, 1, Parse_boolean, 0] ) ; } @@ -222,7 +222,7 @@ sub _readGzipHeader($) or return $self->TruncatedHeader("FHCRC"); $HeaderCRC = unpack("v", $buffer) ; - my $crc16 = crc32($keep) & 0xFF ; + my $crc16 = Compress::Raw::Zlib::crc32($keep) & 0xFF ; return $self->HeaderError("CRC16 mismatch.") if *$self->{Strict} && $crc16 != $HeaderCRC; @@ -980,7 +980,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 @@ -1075,7 +1075,7 @@ See L<IO::Uncompress::Gunzip::FAQ|IO::Uncompress::Gunzip::FAQ/"Compressed files L<Compress::Zlib>, L<IO::Compress::Gzip>, 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>, @@ -1104,7 +1104,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/Uncompress/Inflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm index a7b12fcde4f..7a40889fa84 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); -use IO::Compress::Zlib::Constants 2.033 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Compress::Zlib::Constants 2.048 ; -use IO::Uncompress::RawInflate 2.033 ; +use IO::Uncompress::RawInflate 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.033'; +$VERSION = '2.048'; $InflateError = ''; @ISA = qw( Exporter IO::Uncompress::RawInflate ); @@ -851,7 +851,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 @@ -946,7 +946,7 @@ See L<IO::Uncompress::Inflate::FAQ|IO::Uncompress::Inflate::FAQ/"Compressed file L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, 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>, @@ -975,7 +975,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/Uncompress/RawInflate.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm index 07d70e316c7..0372ec72e35 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.033 ; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); +use Compress::Raw::Zlib 2.048 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); -use IO::Uncompress::Base 2.033 ; -use IO::Uncompress::Adapter::Inflate 2.033 ; +use IO::Uncompress::Base 2.048 ; +use IO::Uncompress::Adapter::Inflate 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.033'; +$VERSION = '2.048'; $RawInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -979,7 +979,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 @@ -1074,7 +1074,7 @@ See L<IO::Uncompress::RawInflate::FAQ|IO::Uncompress::RawInflate::FAQ/"Compresse 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::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>, @@ -1103,7 +1103,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/Uncompress/Unzip.pm b/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm index a678251a899..7b2121c4e75 100644 --- a/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm +++ b/Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm @@ -1,6 +1,6 @@ package IO::Uncompress::Unzip; -require 5.004 ; +require 5.006 ; # for RFC1952 @@ -8,21 +8,22 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.033 ; -use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject); -use IO::Uncompress::Adapter::Inflate 2.033 ; -use IO::Uncompress::Adapter::Identity 2.033 ; -use IO::Compress::Zlib::Extra 2.033 ; -use IO::Compress::Zip::Constants 2.033 ; +use IO::File; +use IO::Uncompress::RawInflate 2.048 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Uncompress::Adapter::Inflate 2.048 ; +use IO::Uncompress::Adapter::Identity 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; +use IO::Compress::Zip::Constants 2.048 ; -use Compress::Raw::Zlib 2.033 qw(crc32) ; +use Compress::Raw::Zlib 2.048 () ; BEGIN { eval { require IO::Uncompress::Adapter::Bunzip2 ; import IO::Uncompress::Adapter::Bunzip2 } ; -# eval { require IO::Uncompress::Adapter::UnLzma ; -# import IO::Uncompress::Adapter::UnLzma } ; + eval { require IO::Uncompress::Adapter::UnLzma ; + import IO::Uncompress::Adapter::UnLzma } ; } @@ -30,7 +31,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.033'; +$VERSION = '2.048'; $UnzipError = ''; @ISA = qw(Exporter IO::Uncompress::RawInflate); @@ -63,15 +64,16 @@ sub unzip sub getExtraParams { - use IO::Compress::Base::Common 2.033 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( # # Zip header fields 'Name' => [1, 1, Parse_any, undef], -# 'Stream' => [1, 1, Parse_boolean, 1], - # This means reading the central directory to get + 'Stream' => [1, 1, Parse_boolean, 0], + + # TODO - This means reading the central directory to get # 1. the local header offsets # 2. The compressed data length ); @@ -415,7 +417,7 @@ sub skipCentralDirectory64Rec my $keep = $magic . $buffer ; my ($sizeLo, $sizeHi) = unpack ("V V", $buffer); - my $size = $sizeHi * 0xFFFFFFFF + $sizeLo; + my $size = $sizeHi * U64::MAX32 + $sizeLo; $self->fastForward($size) or return $self->TrailerError("Minimum header size is " . @@ -473,8 +475,8 @@ sub skipEndCentralDirectory #my $cntrlDirDiskNo = unpack ("v", substr($buffer, 6-4, 2)); #my $entriesInThisCD = unpack ("v", substr($buffer, 8-4, 2)); #my $entriesInCD = unpack ("v", substr($buffer, 10-4, 2)); - #my $sizeOfCD = unpack ("V", substr($buffer, 12-4, 2)); - #my $offsetToCD = unpack ("V", substr($buffer, 16-4, 2)); + #my $sizeOfCD = unpack ("V", substr($buffer, 12-4, 4)); + #my $offsetToCD = unpack ("V", substr($buffer, 16-4, 4)); my $comment_length = unpack ("v", substr($buffer, 20-4, 2)); @@ -549,9 +551,6 @@ sub _readZipHeader($) my @EXTRA = (); my $streamingMode = ($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) ? 1 : 0 ; - 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); @@ -601,14 +600,14 @@ sub _readZipHeader($) if (! $streamingMode) { my $offset = 0 ; - if ($uncompressedLength->get32bit() == 0xFFFFFFFF ) { + if (U64::full32 $uncompressedLength->get32bit() ) { $uncompressedLength = U64::newUnpack_V64 substr($buff, 0, 8); $offset += 8 ; } - if ($compressedLength->get32bit() == 0xFFFFFFFF) { + if (U64::full32 $compressedLength->get32bit() ) { $compressedLength = U64::newUnpack_V64 substr($buff, $offset, 8); @@ -630,7 +629,7 @@ sub _readZipHeader($) *$self->{CompressedInputLength} = $compressedLength->get64bit(); } - *$self->{ZipData}{CRC32} = crc32(undef); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); *$self->{ZipData}{Method} = $compressedMethod; if ($compressedMethod == ZIP_CM_DEFLATE) { @@ -650,41 +649,41 @@ sub _readZipHeader($) *$self->{Uncomp} = $obj; } -# elsif ($compressedMethod == ZIP_CM_LZMA) -# { -# return $self->HeaderError("Unsupported Compression format $compressedMethod") -# if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ; -# -# *$self->{Type} = 'zip-lzma'; -# my $LzmaHeader; -# $self->smartReadExact(\$LzmaHeader, 4) -# or return $self->saveErrorString(undef, "Truncated file"); -# my ($verHi, $verLo) = unpack ("CC", substr($LzmaHeader, 0, 2)); -# my $LzmaPropertiesSize = unpack ("v", substr($LzmaHeader, 2, 2)); -# -# -# my $LzmaPropertyData; -# $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize) -# or return $self->saveErrorString(undef, "Truncated file"); -# #my $LzmaInfo = unpack ("C", substr($LzmaPropertyData, 0, 1)); -# #my $LzmaDictSize = unpack ("V", substr($LzmaPropertyData, 1, 4)); -# -# # Create an LZMA_Alone header -# $self->pushBack($LzmaPropertyData . -# $uncompressedLength->getPacked_V64()); -# -# my $obj = -# IO::Uncompress::Adapter::UnLzma::mkUncompObject(); -# -# *$self->{Uncomp} = $obj; -# } - elsif ($compressedMethod == ZIP_CM_STORE) + elsif ($compressedMethod == ZIP_CM_LZMA) { - # TODO -- add support for reading uncompressed + return $self->HeaderError("Unsupported Compression format $compressedMethod") + if ! defined $IO::Uncompress::Adapter::UnLzma::VERSION ; + + *$self->{Type} = 'zip-lzma'; + my $LzmaHeader; + $self->smartReadExact(\$LzmaHeader, 4) + or return $self->saveErrorString(undef, "Truncated file"); + my ($verHi, $verLo) = unpack ("CC", substr($LzmaHeader, 0, 2)); + my $LzmaPropertiesSize = unpack ("v", substr($LzmaHeader, 2, 2)); + + my $LzmaPropertyData; + $self->smartReadExact(\$LzmaPropertyData, $LzmaPropertiesSize) + or return $self->saveErrorString(undef, "Truncated file"); + + if (! $streamingMode) { + *$self->{ZipData}{CompressedLen}->subtract(4 + $LzmaPropertiesSize) ; + *$self->{CompressedInputLengthRemaining} = + *$self->{CompressedInputLength} = *$self->{ZipData}{CompressedLen}->get64bit(); + } + + my $obj = + IO::Uncompress::Adapter::UnLzma::mkUncompZipObject($LzmaPropertyData); + + *$self->{Uncomp} = $obj; + } + elsif ($compressedMethod == ZIP_CM_STORE) + { *$self->{Type} = 'zip-stored'; - my $obj = IO::Uncompress::Adapter::Identity::mkUncompObject(); + my $obj = + IO::Uncompress::Adapter::Identity::mkUncompObject($streamingMode, + $zip64); *$self->{Uncomp} = $obj; } @@ -746,7 +745,7 @@ sub filterUncompressed *$self->{ZipData}{CRC32} = *$self->{Uncomp}->crc32() ; } else { - *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32}); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}, $_[1]); } } @@ -772,6 +771,262 @@ sub _dosToUnixTime return $time_t; } +#sub scanCentralDirectory +#{ +# # Use cases +# # 1 32-bit CD +# # 2 64-bit CD +# +# my $self = shift ; +# +# my @CD = (); +# my $offset = $self->findCentralDirectoryOffset(); +# +# return 0 +# if ! defined $offset; +# +# $self->smarkSeek($offset, 0, SEEK_SET) ; +# +# # Now walk the Central Directory Records +# my $buffer ; +# while ($self->smartReadExact(\$buffer, 46) && +# unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { +# +# my $compressedLength = unpack ("V", substr($buffer, 20, 4)); +# my $filename_length = unpack ("v", substr($buffer, 28, 2)); +# my $extra_length = unpack ("v", substr($buffer, 30, 2)); +# my $comment_length = unpack ("v", substr($buffer, 32, 2)); +# +# $self->smarkSeek($filename_length + $extra_length + $comment_length, 0, SEEK_CUR) +# if $extra_length || $comment_length || $filename_length; +# push @CD, $compressedLength ; +# } +# +#} +# +#sub findCentralDirectoryOffset +#{ +# my $self = shift ; +# +# # Most common use-case is where there is no comment, so +# # know exactly where the end of central directory record +# # should be. +# +# $self->smarkSeek(-22, 0, SEEK_END) ; +# +# my $buffer; +# $self->smartReadExact(\$buffer, 22) ; +# +# my $zip64 = 0; +# my $centralDirOffset ; +# if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { +# $centralDirOffset = unpack ("V", substr($buffer, 16, 2)); +# } +# else { +# die "xxxx"; +# } +# +# return $centralDirOffset ; +#} +# +#sub is84BitCD +#{ +# # TODO +# my $self = shift ; +#} + + +sub skip +{ + my $self = shift; + my $size = shift; + + use Fcntl qw(SEEK_CUR); + if (ref $size eq 'U64') { + $self->smartSeek($size->get64bit(), SEEK_CUR); + } + else { + $self->smartSeek($size, SEEK_CUR); + } + +} + + +sub scanCentralDirectory +{ + my $self = shift; + + my $here = $self->tell(); + + # Use cases + # 1 32-bit CD + # 2 64-bit CD + + my @CD = (); + my $offset = $self->findCentralDirectoryOffset(); + + return () + if ! defined $offset; + + $self->smarkSeek($offset, 0, SEEK_SET) ; + + # Now walk the Central Directory Records + my $buffer ; + while ($self->smartReadExact(\$buffer, 46) && + unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { + + my $compressedLength = unpack("V", substr($buffer, 20, 4)); + my $uncompressedLength = unpack("V", substr($buffer, 24, 4)); + my $filename_length = unpack("v", substr($buffer, 28, 2)); + my $extra_length = unpack("v", substr($buffer, 30, 2)); + my $comment_length = unpack("v", substr($buffer, 32, 2)); + + $self->skip($filename_length ) ; + + my $v64 = new U64 $compressedLength ; + + if (U64::full32 $compressedLength ) { + $self->smartReadExact(\$buffer, $extra_length) ; + die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer) + if length($buffer) != $extra_length; + my $got = $self->get64Extra($buffer, U64::full32 $uncompressedLength); + + # If not Zip64 extra field, assume size is 0xFFFFFFFF + $v64 = $got if defined $got; + } + else { + $self->skip($extra_length) ; + } + + $self->skip($comment_length ) ; + + push @CD, $v64 ; + } + + $self->smartSeek($here, 0, SEEK_SET) ; + + return @CD; +} + +sub get64Extra +{ + my $self = shift ; + + my $buffer = shift; + my $is_uncomp = shift ; + + my $extra = IO::Compress::Zlib::Extra::findID(0x0001, $buffer); + + if (! defined $extra) + { + return undef; + } + else + { + my $u64 = U64::newUnpack_V64(substr($extra, $is_uncomp ? 8 : 0)) ; + return $u64; + } +} + +sub offsetFromZip64 +{ + my $self = shift ; + my $here = shift; + + $self->smartSeek($here - 20, 0, SEEK_SET) + or die "xx $!" ; + + my $buffer; + my $got = 0; + $self->smartReadExact(\$buffer, 20) + or die "xxx $here $got $!" ; + + if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) { + my $cd64 = U64::Value_VV64 substr($buffer, 8, 8); + + $self->smartSeek($cd64, 0, SEEK_SET) ; + + $self->smartReadExact(\$buffer, 4) + or die "xxx" ; + + if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) { + + $self->smartReadExact(\$buffer, 8) + or die "xxx" ; + my $size = U64::Value_VV64($buffer); + $self->smartReadExact(\$buffer, $size) + or die "xxx" ; + + my $cd64 = U64::Value_VV64 substr($buffer, 36, 8); + + return $cd64 ; + } + + die "zzz"; + } + + die "zzz"; +} + +use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG); + +sub findCentralDirectoryOffset +{ + my $self = shift ; + + # Most common use-case is where there is no comment, so + # know exactly where the end of central directory record + # should be. + + $self->smartSeek(-22, 0, SEEK_END) ; + my $here = $self->tell(); + + my $buffer; + $self->smartReadExact(\$buffer, 22) + or die "xxx" ; + + my $zip64 = 0; + my $centralDirOffset ; + if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { + $centralDirOffset = unpack("V", substr($buffer, 16, 4)); + } + else { + $self->smartSeek(0, 0, SEEK_END) ; + + my $fileLen = $self->tell(); + my $want = 0 ; + + while(1) { + $want += 1024; + my $seekTo = $fileLen - $want; + if ($seekTo < 0 ) { + $seekTo = 0; + $want = $fileLen ; + } + $self->smartSeek( $seekTo, 0, SEEK_SET) + or die "xxx $!" ; + my $got; + $self->smartReadExact($buffer, $want) + or die "xxx " ; + my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG); + + if ($pos >= 0) { + #$here = $self->tell(); + $here = $seekTo + $pos ; + $centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4)); + last ; + } + + return undef + if $want == $fileLen; + } + } + + $centralDirOffset = $self->offsetFromZip64($here) + if U64::full32 $centralDirOffset ; + + return $centralDirOffset ; +} 1; @@ -1425,7 +1680,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 @@ -1528,7 +1783,7 @@ stream at a time. or die "Cannot open $zipfile: $UnzipError"; my $status; - for ($status = 1; ! $u->eof(); $status = $u->nextStream()) + for ($status = 1; $stream > 0; $status = $u->nextStream()) { my $name = $u->getHeaderInfo()->{Name}; @@ -1557,7 +1812,7 @@ skipping to the next one. 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>, @@ -1586,7 +1841,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. |