diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Uncompress')
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm | 6 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm | 121 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm | 6 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm | 24 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm | 46 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm | 150 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm | 10 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm | 24 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm | 14 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm | 16 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm | 373 |
11 files changed, 586 insertions, 204 deletions
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. |