summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IO/Uncompress
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
committerKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
commitc5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch)
tree02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/IO/Uncompress
parent6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff)
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Uncompress')
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Bunzip2.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Identity.pm121
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Adapter/Inflate.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/AnyInflate.pm24
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/AnyUncompress.pm46
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Base.pm150
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Bunzip2.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Gunzip.pm24
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Inflate.pm14
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/RawInflate.pm16
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Uncompress/Unzip.pm373
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.