diff options
| author |   sthen <sthen@openbsd.org> | 2013-03-25 20:06:16 +0000 |
|---|---|---|
| committer | sthen <sthen@openbsd.org> | 2013-03-25 20:06:16 +0000 |
| commit | 898184e3e61f9129feb5978fad5a8c6865f00b92 (patch) | |
| tree | 56f32aefc1eed60b534611007c7856f82697a205 /gnu/usr.bin/perl/cpan/IO-Compress/lib | |
| parent | PGSHIFT -> PAGE_SHIFT (diff) | |
| download | wireguard-openbsd-898184e3e61f9129feb5978fad5a8c6865f00b92.tar.xz wireguard-openbsd-898184e3e61f9129feb5978fad5a8c6865f00b92.zip | |
import perl 5.16.3 from CPAN - worked on by Andrew Fresh and myself
Diffstat (limited to 'gnu/usr.bin/perl/cpan/IO-Compress/lib')
28 files changed, 2069 insertions, 543 deletions
diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/Compress/Zlib.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/Compress/Zlib.pm index 9424df63b8b..db13bb03860 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/Compress/Zlib.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/Compress/Zlib.pm @@ -1,24 +1,23 @@ package Compress::Zlib; -require 5.004 ; +require 5.006 ; require Exporter; -use AutoLoader; use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); -use IO::Compress::Base::Common 2.024 ; -use Compress::Raw::Zlib 2.024 ; -use IO::Compress::Gzip 2.024 ; -use IO::Uncompress::Gunzip 2.024 ; +use IO::Compress::Base::Common 2.048 ; +use Compress::Raw::Zlib 2.048 ; +use IO::Compress::Gzip 2.048 ; +use IO::Uncompress::Gunzip 2.048 ; use strict ; use warnings ; use bytes ; -our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD); +our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.024'; +$VERSION = '2.048'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -46,16 +45,6 @@ BEGIN *zlib_version = \&Compress::Raw::Zlib::zlib_version; } -sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - my ($error, $val) = Compress::Raw::Zlib::constant($constname); - Carp::croak $error if $error; - no strict 'refs'; - *{$AUTOLOAD} = sub { $val }; - goto &{$AUTOLOAD}; -} - use constant FLAG_APPEND => 1 ; use constant FLAG_CRC => 2 ; use constant FLAG_ADLER => 4 ; @@ -98,15 +87,16 @@ sub _set_gzerr_undef _set_gzerr(@_); return undef; } + sub _save_gzerr { my $gz = shift ; my $test_eof = shift ; my $value = $gz->errorNo() || 0 ; + my $eof = $gz->eof() ; if ($test_eof) { - #my $gz = $self->[0] ; # gzread uses Z_STREAM_END to denote a successful end $value = Z_STREAM_END() if $gz->eof() && $value == 0 ; } @@ -173,13 +163,14 @@ sub Compress::Zlib::gzFile::gzread my $len = defined $_[1] ? $_[1] : 4096 ; + my $gz = $self->[0] ; if ($self->gzeof() || $len == 0) { # Zap the output buffer to match ver 1 behaviour. $_[0] = "" ; + _save_gzerr($gz, 1); return 0 ; } - my $gz = $self->[0] ; my $status = $gz->read($_[0], $len) ; _save_gzerr($gz, 1); return $status ; @@ -462,7 +453,7 @@ sub inflate package Compress::Zlib ; -use IO::Compress::Gzip::Constants 2.024 ; +use IO::Compress::Gzip::Constants 2.048 ; sub memGzip($) { @@ -587,7 +578,7 @@ sub memGunzip($) substr($$string, 0, 8) = ''; return _set_gzerr_undef(Z_DATA_ERROR()) unless $len == length($output) and - $crc == crc32($output); + $crc == Compress::Raw::Zlib::crc32($output); } else { @@ -709,7 +700,7 @@ enhancements/changes have been made to the C<gzopen> interface: =item 1 -If you want to to open either STDIN or STDOUT with C<gzopen>, you can now +If you want to open either STDIN or STDOUT with C<gzopen>, you can now optionally use the special filename "C<->" as a synonym for C<\*STDIN> and C<\*STDOUT>. @@ -1018,7 +1009,7 @@ carry out in-memory gzip compression. This function is used to uncompress an in-memory gzip file. $dest = Compress::Zlib::memGunzip($buffer) - or die "Cannot uncomprss: $gzerrno\n"; + or die "Cannot uncompress: $gzerrno\n"; If successful, it returns the uncompressed gzip file. Otherwise it returns C<undef> and the C<$gzerrno> variable will store the zlib error @@ -1458,7 +1449,7 @@ of I<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>, @@ -1487,7 +1478,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 1995-2010 Paul Marquess. All rights reserved. +Copyright (c) 1995-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/gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm index 40a606309e0..76d4bed1178 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/File/GlobMapper.pm @@ -31,7 +31,7 @@ $VERSION = '1.000'; our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); -$noPreBS = '(?<!\\\)' ; # no preceeding backslash +$noPreBS = '(?<!\\\)' ; # no preceding backslash $metachars = '.*?[](){}'; $matchMetaRE = '[' . quotemeta($metachars) . ']'; @@ -309,7 +309,7 @@ sub _parseOutputGlob if $1 > $maxwild ; } - my $noPreBS = '(?<!\\\)' ; # no preceeding backslash + my $noPreBS = '(?<!\\\)' ; # no preceding backslash #warn "noPreBS = '$noPreBS'\n"; #$string =~ s/${noPreBS}\$(\d)/\${$1}/g; diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm index 3e2e89f8e12..452e12ef483 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,13 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); -#use Compress::Bzip2 ; -use Compress::Raw::Bzip2 2.024 ; +use Compress::Raw::Bzip2 2.048 ; our ($VERSION); -$VERSION = '2.024'; +$VERSION = '2.048'; sub mkCompObject { @@ -18,11 +17,12 @@ sub mkCompObject my $WorkFactor = shift ; my $Verbosity = shift ; + $BlockSize100K = 1 if ! defined $BlockSize100K ; + $WorkFactor = 0 if ! defined $WorkFactor ; + $Verbosity = 0 if ! defined $Verbosity ; + my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, $WorkFactor, $Verbosity); - #my ($def, $status) = bzdeflateInit(); - #-BlockSize100K => $params->value('BlockSize100K'), - #-WorkFactor => $params->value('WorkFactor'); return (undef, "Could not create Deflate object: $status", $status) if $status != BZ_OK ; @@ -39,7 +39,6 @@ sub compr my $def = $self->{Def}; - #my ($out, $status) = $def->bzdeflate(defined ${$_[0]} ? ${$_[0]} : "") ; my $status = $def->bzdeflate($_[0], $_[1]) ; $self->{ErrorNo} = $status; @@ -49,8 +48,6 @@ sub compr return STATUS_ERROR; } - #${ $_[1] } .= $out if defined $out; - return STATUS_OK; } @@ -60,8 +57,6 @@ sub flush my $def = $self->{Def}; - #my ($out, $status) = $def->bzflush($opt); - #my $status = $def->bzflush($_[0], $opt); my $status = $def->bzflush($_[0]); $self->{ErrorNo} = $status; @@ -71,7 +66,6 @@ sub flush return STATUS_ERROR; } - #${ $_[0] } .= $out if defined $out ; return STATUS_OK; } @@ -82,7 +76,6 @@ sub close my $def = $self->{Def}; - #my ($out, $status) = $def->bzclose(); my $status = $def->bzclose($_[0]); $self->{ErrorNo} = $status; @@ -92,7 +85,6 @@ sub close return STATUS_ERROR; } - #${ $_[0] } .= $out if defined $out ; return STATUS_OK; } diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm index f23a9819c67..4a99c36cf7e 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm @@ -4,12 +4,18 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); - -use Compress::Raw::Zlib 2.024 qw(Z_OK Z_FINISH MAX_WBITS) ; -our ($VERSION); - -$VERSION = '2.024'; +use IO::Compress::Base::Common 2.048 qw(:Status); +use Compress::Raw::Zlib 2.048 qw( !crc32 !adler32 ) ; + +require Exporter; +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); + +$VERSION = '2.048'; +@ISA = qw(Exporter); +@EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; +%EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; +@EXPORT = @EXPORT_OK; +%DEFLATE_CONSTANTS = %EXPORT_TAGS ; sub mkCompObject { diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm index 16f14d8e7f3..c7a0031a1d4 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); our ($VERSION); -$VERSION = '2.024'; +$VERSION = '2.048'; sub mkCompObject { diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base.pm index 5a20f60007b..2137bbb8de2 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base.pm @@ -1,26 +1,26 @@ package IO::Compress::Base ; -require 5.004 ; +require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.024 ; +use IO::Compress::Base::Common 2.048 ; -use IO::File ; +use IO::File qw(SEEK_SET SEEK_END); ; use Scalar::Util qw(blessed readonly); #use File::Glob; #require Exporter ; -use Carp ; -use Symbol; +use Carp() ; +use Symbol(); use bytes; our (@ISA, $VERSION); @ISA = qw(Exporter IO::File); -$VERSION = '2.024'; +$VERSION = '2.048'; #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. @@ -48,7 +48,7 @@ sub croakError { my $self = shift ; $self->saveErrorString(0, $_[0]); - croak $_[0]; + Carp::croak $_[0]; } sub closeError @@ -106,6 +106,14 @@ sub writeAt return 1; } +sub outputPayload +{ + + my $self = shift ; + return $self->output(@_); +} + + sub output { my $self = shift ; @@ -115,9 +123,9 @@ sub output return 1 if length $data == 0 && ! $last ; - if ( *$self->{FilterEnvelope} ) { + if ( *$self->{FilterContainer} ) { *_ = \$data; - &{ *$self->{FilterEnvelope} }(); + &{ *$self->{FilterContainer} }(); } if (length $data) { @@ -155,7 +163,7 @@ sub checkParams 'Append' => [1, 1, Parse_boolean, 0], 'BinModeIn' => [1, 1, Parse_boolean, 0], - 'FilterEnvelope' => [1, 1, Parse_any, undef], + 'FilterContainer' => [1, 1, Parse_code, undef], $self->getExtraParams(), *$self->{OneShot} ? $self->getOneShotParams() @@ -206,7 +214,7 @@ sub _create my $merge = $got->value('Merge') ; my $appendOutput = $got->value('Append') || $merge ; *$obj->{Append} = $appendOutput; - *$obj->{FilterEnvelope} = $got->value('FilterEnvelope') ; + *$obj->{FilterContainer} = $got->value('FilterContainer') ; if ($merge) { @@ -275,6 +283,7 @@ sub _create *$obj->{Header} = $obj->mkHeader($got) ; $obj->output( *$obj->{Header} ) or return undef; + $obj->beforePayload(); } else { @@ -392,7 +401,7 @@ sub _def # finally the 1 to 1 and n to 1 return $obj->_singleTarget($x, 1, $input, $output, @_); - croak "should not be here" ; + Carp::croak "should not be here" ; } sub _singleTarget @@ -405,7 +414,7 @@ sub _singleTarget if ($x->{oneInput}) { $obj->getFileInfo($x->{Got}, $input) - if isaFilename($input) and $inputIsFilename ; + if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ; my $z = $obj->_create($x->{Got}, @_) or return undef ; @@ -435,7 +444,7 @@ sub _singleTarget else { $obj->getFileInfo($x->{Got}, $element) - if $isFilename; + if isaScalar($element) || $isFilename; $obj->_create($x->{Got}, @_) or return undef ; @@ -504,7 +513,7 @@ sub _wr2 return $count ; } - croak "Should not be here"; + Carp::croak "Should not be here"; return undef; } @@ -518,7 +527,7 @@ sub addInterStream { $self->getFileInfo(*$self->{Got}, $input) #if isaFilename($input) and $inputIsFilename ; - if isaFilename($input) ; + if isaScalar($input) || isaFilename($input) ; # TODO -- newStream needs to allow gzip/zip header to be modified return $self->newStream(); @@ -581,7 +590,7 @@ sub syswrite } $] >= 5.008 and ( utf8::downgrade($$buffer, 1) - or croak "Wide character in " . *$self->{ClassName} . "::write:"); + or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:"); if (@_ > 1) { @@ -625,7 +634,7 @@ sub syswrite *$self->{CompSize}->add(length $outBuffer) ; - $self->output($outBuffer) + $self->outputPayload($outBuffer) or return undef; return $buffer_length; @@ -679,7 +688,7 @@ sub flush *$self->{CompSize}->add(length $outBuffer) ; - $self->output($outBuffer) + $self->outputPayload($outBuffer) or return 0; if ( defined *$self->{FH} ) { @@ -690,16 +699,18 @@ sub flush return 1; } -sub newStream +sub beforePayload +{ +} + +sub _newStream { my $self = shift ; - + my $got = shift; + $self->_writeTrailer() or return 0 ; - my $got = $self->checkParams('newStream', *$self->{Got}, @_) - or return 0 ; - $self->ckParams($got) or $self->croakError("newStream: $self->{Error}"); @@ -713,9 +724,35 @@ sub newStream *$self->{UnCompSize}->reset(); *$self->{CompSize}->reset(); + $self->beforePayload(); + return 1 ; } +sub newStream +{ + my $self = shift ; + + my $got = $self->checkParams('newStream', *$self->{Got}, @_) + or return 0 ; + + $self->_newStream($got); + +# *$self->{Compress} = $self->mkComp($got) +# or return 0; +# +# *$self->{Header} = $self->mkHeader($got) ; +# $self->output(*$self->{Header} ) +# or return 0; +# +# *$self->{UnCompSize}->reset(); +# *$self->{CompSize}->reset(); +# +# $self->beforePayload(); +# +# return 1 ; +} + sub reset { my $self = shift ; @@ -913,7 +950,7 @@ sub input_line_number sub _notAvailable { my $name = shift ; - return sub { croak "$name Not Available: File opened only for output" ; } ; + return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; } *read = _notAvailable('read'); @@ -958,7 +995,7 @@ purpose if to to be sub-classed by IO::Compress modules. L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -974,7 +1011,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm index 4f8b4dadc36..c6c38181ef8 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm @@ -11,15 +11,20 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); -$VERSION = '2.024'; +$VERSION = '2.048'; -@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput +@EXPORT = qw( isaFilehandle isaFilename isaScalar + whatIsInput whatIsOutput isaFileGlobString cleanFileGlobString oneTarget setBinModeInput setBinModeOutput ckInOutParams createSelfTiedObject getEncoding + isGeMax32 + + MAX32 + WANT_CODE WANT_EXT WANT_UNDEF @@ -42,7 +47,16 @@ use constant STATUS_OK => 0; use constant STATUS_ENDSTREAM => 1; use constant STATUS_EOF => 2; use constant STATUS_ERROR => -1; +use constant MAX16 => 0xFFFF ; +use constant MAX32 => 0xFFFFFFFF ; +use constant MAX32cmp => 0xFFFFFFFF + 1 - 1; # for 5.6.x on 32-bit need to force an non-IV value + +sub isGeMax32 +{ + return $_[0] >= MAX32cmp ; +} + sub hasEncode() { if (! defined $HAS_ENCODE) { @@ -106,6 +120,11 @@ sub isaFilehandle($) ) } +sub isaScalar +{ + return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ; +} + sub isaFilename($) { return (defined $_[0] and @@ -451,7 +470,8 @@ sub createSelfTiedObject $EXPORT_TAGS{Parse} = [qw( ParseParameters Parse_any Parse_unsigned Parse_signed - Parse_boolean Parse_custom Parse_string + Parse_boolean Parse_string + Parse_code Parse_multiple Parse_writable_scalar ) ]; @@ -463,7 +483,7 @@ use constant Parse_unsigned => 0x02; use constant Parse_signed => 0x04; use constant Parse_boolean => 0x08; use constant Parse_string => 0x10; -use constant Parse_custom => 0x12; +use constant Parse_code => 0x20; #use constant Parse_store_ref => 0x100 ; use constant Parse_multiple => 0x100 ; @@ -499,6 +519,7 @@ sub ParseParameters #package IO::Compress::Base::Parameters; use strict; + use warnings; use Carp; @@ -635,7 +656,7 @@ sub IO::Compress::Base::Parameters::parse ++ $parsed{$canonkey}; return $self->setError("Muliple instances of '$key' found") - if $parsed && $type & Parse_multiple == 0 ; + if $parsed && ($type & Parse_multiple) == 0 ; my $s ; $self->_checkType($key, $value, $type, 1, \$s) @@ -741,6 +762,13 @@ sub IO::Compress::Base::Parameters::_checkType $$output = defined $value ? $value != 0 : 0 ; return 1; } + elsif ($type & Parse_code) + { + return $self->setError("Parameter '$key' must be a code reference, got '$value'") + if $validate && (! defined $value || ref $value ne 'CODE') ; + $$output = defined $value ? $value : "" ; + return 1; + } elsif ($type & Parse_string) { $$output = defined $value ? $value : "" ; @@ -901,9 +929,13 @@ sub add $self->[HIGH] += $value->[HIGH] ; $value = $value->[LOW]; } + elsif ($value > MAX32) { + $self->[HIGH] += int($value / HI_1) ; + $value = $value % HI_1; + } my $available = MAX32 - $self->[LOW] ; - + if ($value > $available) { ++ $self->[HIGH] ; $self->[LOW] = $value - $available - 1; @@ -911,7 +943,33 @@ sub add else { $self->[LOW] += $value ; } +} + +sub subtract +{ + my $self = shift; + my $value = shift; + if (ref $value eq 'U64') { + + if ($value->[HIGH]) { + die "bad" + if $self->[HIGH] == 0 || + $value->[HIGH] > $self->[HIGH] ; + + $self->[HIGH] -= $value->[HIGH] ; + } + + $value = $value->[LOW] ; + } + + if ($value > $self->[LOW]) { + -- $self->[HIGH] ; + $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ; + } + else { + $self->[LOW] -= $value; + } } sub equal @@ -923,12 +981,40 @@ sub equal $self->[HIGH] == $other->[HIGH] ; } +sub gt +{ + my $self = shift; + my $other = shift; + + return $self->cmp($other) > 0 ; +} + +sub cmp +{ + my $self = shift; + my $other = shift ; + + if ($self->[LOW] == $other->[LOW]) { + return $self->[HIGH] - $other->[HIGH] ; + } + else { + return $self->[LOW] - $other->[LOW] ; + } +} + + sub is64bit { my $self = shift; return $self->[HIGH] > 0 ; } +sub isAlmost64bit +{ + my $self = shift; + return $self->[HIGH] > 0 || $self->[LOW] == MAX32 ; +} + sub getPacked_V64 { my $self = shift; @@ -951,6 +1037,21 @@ sub pack_V64 } +sub full32 +{ + return $_[0] == MAX32 ; +} + +sub Value_VV64 +{ + my $buffer = shift; + + my ($lo, $hi) = unpack ("V V" , $buffer); + no warnings 'uninitialized'; + return $hi * HI_1 + $lo; +} + + package IO::Compress::Base::Common; 1; diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm index 2a85ef55b19..dd9016bf834 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.024 ; +use IO::Compress::Base 2.048 ; -use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject); -use IO::Compress::Adapter::Bzip2 2.024 ; +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); +use IO::Compress::Adapter::Bzip2 2.048 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.024'; +$VERSION = '2.048'; $Bzip2Error = ''; @ISA = qw(Exporter IO::Compress::Base); @@ -51,7 +51,7 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.024 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'BlockSize100K' => [0, 1, Parse_unsigned, 1], diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Deflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Deflate.pm index 0f46e59d3a4..daa7d7aa258 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Deflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Deflate.pm @@ -1,26 +1,29 @@ package IO::Compress::Deflate ; +require 5.006 ; + use strict ; use warnings; use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.024 ; +use IO::Compress::RawDeflate 2.048 (); +use IO::Compress::Adapter::Deflate 2.048 ; -use Compress::Raw::Zlib 2.024 ; -use IO::Compress::Zlib::Constants 2.024 ; -use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject); +use IO::Compress::Zlib::Constants 2.048 ; +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.024'; +$VERSION = '2.048'; $DeflateError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @EXPORT_OK = qw( $DeflateError deflate ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; + push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -281,8 +284,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<deflate> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -327,6 +328,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -394,8 +397,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all compressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all compressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -774,7 +777,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -884,8 +887,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -894,7 +895,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -923,7 +924,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/FAQ.pod b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/FAQ.pod new file mode 100644 index 00000000000..d392ff2cc91 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/FAQ.pod @@ -0,0 +1,597 @@ + +=head1 NAME + +IO::Compress::FAQ -- Frequently Asked Questions about IO::Compress + +=head1 DESCRIPTION + +Common questions answered. + +=head1 GENERAL + +=head2 Compatibility with Unix compress/uncompress. + +Although C<Compress::Zlib> has a pair of functions called C<compress> and +C<uncompress>, they are I<not> related to the Unix programs of the same +name. The C<Compress::Zlib> module is not compatible with Unix +C<compress>. + +If you have the C<uncompress> program available, you can use this to read +compressed files + + open F, "uncompress -c $filename |"; + while (<F>) + { + ... + +Alternatively, if you have the C<gunzip> program available, you can use +this to read compressed files + + open F, "gunzip -c $filename |"; + while (<F>) + { + ... + +and this to write compress files, if you have the C<compress> program +available + + open F, "| compress -c $filename "; + print F "data"; + ... + close F ; + +=head2 Accessing .tar.Z files + +The C<Archive::Tar> module can optionally use C<Compress::Zlib> (via the +C<IO::Zlib> module) to access tar files that have been compressed with +C<gzip>. Unfortunately tar files compressed with the Unix C<compress> +utility cannot be read by C<Compress::Zlib> and so cannot be directly +accessed by C<Archive::Tar>. + +If the C<uncompress> or C<gunzip> programs are available, you can use one +of these workarounds to read C<.tar.Z> files from C<Archive::Tar> + +Firstly with C<uncompress> + + use strict; + use warnings; + use Archive::Tar; + + open F, "uncompress -c $filename |"; + my $tar = Archive::Tar->new(*F); + ... + +and this with C<gunzip> + + use strict; + use warnings; + use Archive::Tar; + + open F, "gunzip -c $filename |"; + my $tar = Archive::Tar->new(*F); + ... + +Similarly, if the C<compress> program is available, you can use this to +write a C<.tar.Z> file + + use strict; + use warnings; + use Archive::Tar; + use IO::File; + + my $fh = new IO::File "| compress -c >$filename"; + my $tar = Archive::Tar->new(); + ... + $tar->write($fh); + $fh->close ; + +=head2 How do I recompress using a different compression? + +This is easier that you might expect if you realise that all the +C<IO::Compress::*> objects are derived from C<IO::File> and that all the +C<IO::Uncompress::*> modules can read from an C<IO::File> filehandle. + +So, for example, say you have a file compressed with gzip that you want to +recompress with bzip2. Here is all that is needed to carry out the +recompression. + + use IO::Uncompress::Gunzip ':all'; + use IO::Compress::Bzip2 ':all'; + + my $gzipFile = "somefile.gz"; + my $bzipFile = "somefile.bz2"; + + my $gunzip = new IO::Uncompress::Gunzip $gzipFile + or die "Cannot gunzip $gzipFile: $GunzipError\n" ; + + bzip2 $gunzip => $bzipFile + or die "Cannot bzip2 to $bzipFile: $Bzip2Error\n" ; + +Note, there is a limitation of this technique. Some compression file +formats store extra information along with the compressed data payload. For +example, gzip can optionally store the original filename and Zip stores a +lot of information about the original file. If the original compressed file +contains any of this extra information, it will not be transferred to the +new compressed file usign the technique above. + +=head1 ZIP + +=head2 What Compression Types do IO::Compress::Zip & IO::Uncompress::Unzip support? + +The following compression formats are supported by C<IO::Compress::Zip> and +C<IO::Uncompress::Unzip> + +=over 5 + +=item * Store (method 0) + +No compression at all. + +=item * Deflate (method 8) + +This is the default compression used when creating a zip file with +C<IO::Compress::Zip>. + +=item * Bzip2 (method 12) + +Only supported if the C<IO-Compress-Bzip2> module is installed. + +=item * Lzma (method 14) + +Only supported if the C<IO-Compress-Lzma> module is installed. + +=back + +=head2 Can I Read/Write Zip files larger the 4 Gig? + +Yes, both the C<IO-Compress-Zip> and C<IO-Uncompress-Unzip> modules +support the zip feature called I<Zip64>. That allows them to read/write +files/buffers larger than 4Gig. + +If you are creating a Zip file using the one-shot interface, and any of the +input files is greater than 4Gig, a zip64 complaint zip file will be +created. + + zip "really-large-file" => "my.zip"; + +Similarly with the one-shot interface, if the input is a buffer larger than +4 Gig, a zip64 complaint zip file will be created. + + zip \$really_large_buffer => "my.zip"; + +The one-shot interface allows you to force the creation of a zip64 zip file +by including the C<Zip64> option. + + zip $filehandle => "my.zip", Zip64 => 1; + +If you want to create a zip64 zip file with the OO interface you must +specify the C<Zip64> option. + + my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; + +When uncompressing with C<IO-Uncompress-Unzip>, it will automatically +detect if the zip file is zip64. + +If you intend to manipulate the Zip64 zip files created with +C<IO-Compress-Zip> using an external zip/unzip, make sure that it supports +Zip64. + +In particular, if you are using Info-Zip you need to have zip version 3.x +or better to update a Zip64 archive and unzip version 6.x to read a zip64 +archive. + +=head2 Zip Resources + +The primary reference for zip files is the "appnote" document available at +L<http://www.pkware.com/documents/casestudies/APPNOTE.TXT> + +An alternatively is the Info-Zip appnote. This is available from +L<ftp://ftp.info-zip.org/pub/infozip/doc/> + +=head1 GZIP + +=head2 Gzip Resources + +The primary reference for gzip files is RFC 1952 +L<http://www.faqs.org/rfcs/rfc1952.html> + +The primary site for gzip is F<http://www.gzip.org>. + +=head1 ZLIB + +=head2 Zlib Resources + +The primary site for the I<zlib> compression library is +F<http://www.zlib.org>. + +=head1 HTTP & NETWORK + +=head2 Apache::GZip Revisited + +Below is a mod_perl Apache compression module, called C<Apache::GZip>, +taken from +F<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.html#On_the_Fly_Compression> + + package Apache::GZip; + #File: Apache::GZip.pm + + use strict vars; + use Apache::Constants ':common'; + use Compress::Zlib; + use IO::File; + use constant GZIP_MAGIC => 0x1f8b; + use constant OS_MAGIC => 0x03; + + sub handler { + my $r = shift; + my ($fh,$gz); + my $file = $r->filename; + return DECLINED unless $fh=IO::File->new($file); + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + tie *STDOUT,'Apache::GZip',$r; + print($_) while <$fh>; + untie *STDOUT; + return OK; + } + + sub TIEHANDLE { + my($class,$r) = @_; + # initialize a deflation stream + my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; + + # gzip header -- don't ask how I found out + $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); + + return bless { r => $r, + crc => crc32(undef), + d => $d, + l => 0 + },$class; + } + + sub PRINT { + my $self = shift; + foreach (@_) { + # deflate the data + my $data = $self->{d}->deflate($_); + $self->{r}->print($data); + # keep track of its length and crc + $self->{l} += length($_); + $self->{crc} = crc32($_,$self->{crc}); + } + } + + sub DESTROY { + my $self = shift; + + # flush the output buffers + my $data = $self->{d}->flush; + $self->{r}->print($data); + + # print the CRC and the total length (uncompressed) + $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); + } + + 1; + +Here's the Apache configuration entry you'll need to make use of it. Once +set it will result in everything in the /compressed directory will be +compressed automagically. + + <Location /compressed> + SetHandler perl-script + PerlHandler Apache::GZip + </Location> + +Although at first sight there seems to be quite a lot going on in +C<Apache::GZip>, you could sum up what the code was doing as follows -- +read the contents of the file in C<< $r->filename >>, compress it and write +the compressed data to standard output. That's all. + +This code has to jump through a few hoops to achieve this because + +=over + +=item 1. + +The gzip support in C<Compress::Zlib> version 1.x can only work with a real +filesystem filehandle. The filehandles used by Apache modules are not +associated with the filesystem. + +=item 2. + +That means all the gzip support has to be done by hand - in this case by +creating a tied filehandle to deal with creating the gzip header and +trailer. + +=back + +C<IO::Compress::Gzip> doesn't have that filehandle limitation (this was one +of the reasons for writing it in the first place). So if +C<IO::Compress::Gzip> is used instead of C<Compress::Zlib> the whole tied +filehandle code can be removed. Here is the rewritten code. + + package Apache::GZip; + + use strict vars; + use Apache::Constants ':common'; + use IO::Compress::Gzip; + use IO::File; + + sub handler { + my $r = shift; + my ($fh,$gz); + my $file = $r->filename; + return DECLINED unless $fh=IO::File->new($file); + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + my $gz = new IO::Compress::Gzip '-', Minimal => 1 + or return DECLINED ; + + print $gz $_ while <$fh>; + + return OK; + } + +or even more succinctly, like this, using a one-shot gzip + + package Apache::GZip; + + use strict vars; + use Apache::Constants ':common'; + use IO::Compress::Gzip qw(gzip); + + sub handler { + my $r = shift; + $r->header_out('Content-Encoding'=>'gzip'); + $r->send_http_header; + return OK if $r->header_only; + + gzip $r->filename => '-', Minimal => 1 + or return DECLINED ; + + return OK; + } + + 1; + +The use of one-shot C<gzip> above just reads from C<< $r->filename >> and +writes the compressed data to standard output. + +Note the use of the C<Minimal> option in the code above. When using gzip +for Content-Encoding you should I<always> use this option. In the example +above it will prevent the filename being included in the gzip header and +make the size of the gzip data stream a slight bit smaller. + +=head2 Compressed files and Net::FTP + +The C<Net::FTP> module provides two low-level methods called C<stor> and +C<retr> that both return filehandles. These filehandles can used with the +C<IO::Compress/Uncompress> modules to compress or uncompress files read +from or written to an FTP Server on the fly, without having to create a +temporary file. + +Firstly, here is code that uses C<retr> to uncompressed a file as it is +read from the FTP Server. + + use Net::FTP; + use IO::Uncompress::Gunzip qw(:all); + + my $ftp = new Net::FTP ... + + my $retr_fh = $ftp->retr($compressed_filename); + gunzip $retr_fh => $outFilename, AutoClose => 1 + or die "Cannot uncompress '$compressed_file': $GunzipError\n"; + +and this to compress a file as it is written to the FTP Server + + use Net::FTP; + use IO::Compress::Gzip qw(:all); + + my $stor_fh = $ftp->stor($filename); + gzip "filename" => $stor_fh, AutoClose => 1 + or die "Cannot compress '$filename': $GzipError\n"; + +=head1 MISC + +=head2 Using C<InputLength> to uncompress data embedded in a larger file/buffer. + +A fairly common use-case is where compressed data is embedded in a larger +file/buffer and you want to read both. + +As an example consider the structure of a zip file. This is a well-defined +file format that mixes both compressed and uncompressed sections of data in +a single file. + +For the purposes of this discussion you can think of a zip file as sequence +of compressed data streams, each of which is prefixed by an uncompressed +local header. The local header contains information about the compressed +data stream, including the name of the compressed file and, in particular, +the length of the compressed data stream. + +To illustrate how to use C<InputLength> here is a script that walks a zip +file and prints out how many lines are in each compressed file (if you +intend write code to walking through a zip file for real see +L<IO::Uncompress::Unzip/"Walking through a zip file"> ). Also, although +this example uses the zlib-based compression, the technique can be used by +the other C<IO::Uncompress::*> modules. + + use strict; + use warnings; + + use IO::File; + use IO::Uncompress::RawInflate qw(:all); + + use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; + use constant ZIP_LOCAL_HDR_LENGTH => 30; + + my $file = $ARGV[0] ; + + my $fh = new IO::File "<$file" + or die "Cannot open '$file': $!\n"; + + while (1) + { + my $sig; + my $buffer; + + my $x ; + ($x = $fh->read($buffer, ZIP_LOCAL_HDR_LENGTH)) == ZIP_LOCAL_HDR_LENGTH + or die "Truncated file: $!\n"; + + my $signature = unpack ("V", substr($buffer, 0, 4)); + + last unless $signature == ZIP_LOCAL_HDR_SIG; + + # Read Local Header + my $gpFlag = unpack ("v", substr($buffer, 6, 2)); + my $compressedMethod = unpack ("v", substr($buffer, 8, 2)); + my $compressedLength = unpack ("V", substr($buffer, 18, 4)); + my $uncompressedLength = unpack ("V", substr($buffer, 22, 4)); + my $filename_length = unpack ("v", substr($buffer, 26, 2)); + my $extra_length = unpack ("v", substr($buffer, 28, 2)); + + my $filename ; + $fh->read($filename, $filename_length) == $filename_length + or die "Truncated file\n"; + + $fh->read($buffer, $extra_length) == $extra_length + or die "Truncated file\n"; + + if ($compressedMethod != 8 && $compressedMethod != 0) + { + warn "Skipping file '$filename' - not deflated $compressedMethod\n"; + $fh->read($buffer, $compressedLength) == $compressedLength + or die "Truncated file\n"; + next; + } + + if ($compressedMethod == 0 && $gpFlag & 8 == 8) + { + die "Streamed Stored not supported for '$filename'\n"; + } + + next if $compressedLength == 0; + + # Done reading the Local Header + + my $inf = new IO::Uncompress::RawInflate $fh, + Transparent => 1, + InputLength => $compressedLength + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The majority of the code above is concerned with reading the zip local +header data. The code that I want to focus on is at the bottom. + + while (1) { + + # read local zip header data + # get $filename + # get $compressedLength + + my $inf = new IO::Uncompress::RawInflate $fh, + Transparent => 1, + InputLength => $compressedLength + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The call to C<IO::Uncompress::RawInflate> creates a new filehandle C<$inf> +that can be used to read from the parent filehandle C<$fh>, uncompressing +it as it goes. The use of the C<InputLength> option will guarantee that +I<at most> C<$compressedLength> bytes of compressed data will be read from +the C<$fh> filehandle (The only exception is for an error case like a +truncated file or a corrupt data stream). + +This means that once RawInflate is finished C<$fh> will be left at the +byte directly after the compressed data stream. + +Now consider what the code looks like without C<InputLength> + + while (1) { + + # read local zip header data + # get $filename + # get $compressedLength + + # read all the compressed data into $data + read($fh, $data, $compressedLength); + + my $inf = new IO::Uncompress::RawInflate \$data, + Transparent => 1, + or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; + + my $line_count = 0; + + while (<$inf>) + { + ++ $line_count; + } + + print "$filename: $line_count\n"; + } + +The difference here is the addition of the temporary variable C<$data>. +This is used to store a copy of the compressed data while it is being +uncompressed. + +If you know that C<$compressedLength> isn't that big then using temporary +storage won't be a problem. But if C<$compressedLength> is very large or +you are writing an application that other people will use, and so have no +idea how big C<$compressedLength> will be, it could be an issue. + +Using C<InputLength> avoids the use of temporary storage and means the +application can cope with large compressed data streams. + +One final point -- obviously C<InputLength> can only be used whenever you +know the length of the compressed data beforehand, like here with a zip +file. + +=head1 SEE ALSO + +L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> + +L<IO::Compress::FAQ|IO::Compress::FAQ> + +L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, +L<Archive::Tar|Archive::Tar>, +L<IO::Zlib|IO::Zlib> + +=head1 AUTHOR + +This module was written by Paul Marquess, F<pmqs@cpan.org>. + +=head1 MODIFICATION HISTORY + +See the Changes file. + +=head1 COPYRIGHT AND LICENSE + +Copyright (c) 2005-2012 Paul Marquess. All rights reserved. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip.pm index 1978b91b283..6530c2532de 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip.pm @@ -1,19 +1,19 @@ - package IO::Compress::Gzip ; -require 5.004 ; +require 5.006 ; use strict ; use warnings; use bytes; +require Exporter ; -use IO::Compress::RawDeflate 2.024 ; +use IO::Compress::RawDeflate 2.048 () ; +use IO::Compress::Adapter::Deflate 2.048 ; -use Compress::Raw::Zlib 2.024 ; -use IO::Compress::Base::Common 2.024 qw(:Status :Parse createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.024 ; -use IO::Compress::Zlib::Extra 2.024 ; +use IO::Compress::Base::Common 2.048 qw(:Status :Parse isaScalar createSelfTiedObject); +use IO::Compress::Gzip::Constants 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; BEGIN { @@ -23,16 +23,15 @@ BEGIN { *noUTF8 = sub {} } } -require Exporter ; - -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.024'; +$VERSION = '2.048'; $GzipError = '' ; @ISA = qw(Exporter IO::Compress::RawDeflate); @EXPORT_OK = qw( $GzipError gzip ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; + push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -141,9 +140,9 @@ sub ckParams if ( ! $got->parsed('ExtraFlags')) { $got->value('ExtraFlags' => 2) - if $got->value('Level') == Z_BEST_SPEED ; - $got->value('ExtraFlags' => 4) if $got->value('Level') == Z_BEST_COMPRESSION ; + $got->value('ExtraFlags' => 4) + if $got->value('Level') == Z_BEST_SPEED ; } my $data = $got->value('ExtraField') ; @@ -178,6 +177,8 @@ sub getFileInfo my $params = shift; my $filename = shift ; + return if isaScalar($filename); + my $defaultTime = (stat($filename))[9] ; $params->value('Name' => $filename) @@ -256,7 +257,7 @@ sub mkHeader } # HEADER CRC - $out .= pack("v", crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ; + $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ; noUTF8($out); @@ -392,8 +393,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<gzip> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -445,6 +444,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -512,8 +513,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all compressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all compressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -1086,7 +1087,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -1196,8 +1197,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -1206,7 +1205,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1235,7 +1234,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm index 8504330d188..c218a31445c 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.024'; +$VERSION = '2.048'; @ISA = qw(Exporter); diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm index b97b51c0509..883a4eb2f72 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm @@ -7,44 +7,23 @@ use warnings; use bytes; -use IO::Compress::Base 2.024 ; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); -use IO::Compress::Adapter::Deflate 2.024 ; +use IO::Compress::Base 2.048 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Compress::Adapter::Deflate 2.048 ; require Exporter ; - our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.024'; +$VERSION = '2.048'; $RawDeflateError = ''; @ISA = qw(Exporter IO::Compress::Base); @EXPORT_OK = qw( $RawDeflateError rawdeflate ) ; +push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; + +%EXPORT_TAGS = %IO::Compress::Adapter::Deflate::DEFLATE_CONSTANTS; -%EXPORT_TAGS = ( flush => [qw{ - Z_NO_FLUSH - Z_PARTIAL_FLUSH - Z_SYNC_FLUSH - Z_FULL_FLUSH - Z_FINISH - Z_BLOCK - }], - level => [qw{ - Z_NO_COMPRESSION - Z_BEST_SPEED - Z_BEST_COMPRESSION - Z_DEFAULT_COMPRESSION - }], - strategy => [qw{ - Z_FILTERED - Z_HUFFMAN_ONLY - Z_RLE - Z_FIXED - Z_DEFAULT_STRATEGY - }], - - ); { my %seen; @@ -60,7 +39,7 @@ $RawDeflateError = ''; %DEFLATE_CONSTANTS = %EXPORT_TAGS; -push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; +#push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -142,8 +121,8 @@ sub getZlibParams { my $self = shift ; - use IO::Compress::Base::Common 2.024 qw(:Parse); - use Compress::Raw::Zlib 2.024 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); + use IO::Compress::Base::Common 2.048 qw(:Parse); + use Compress::Raw::Zlib 2.048 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); return ( @@ -368,8 +347,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<rawdeflate> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -414,6 +391,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -481,8 +460,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all compressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all compressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -861,7 +840,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -971,8 +950,6 @@ These symbolic constants are used by the C<Strategy> option in the constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -981,7 +958,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1010,7 +987,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip.pm index 5e37d78f97d..9c2780a5e06 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip.pm @@ -4,40 +4,45 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); -use IO::Compress::RawDeflate 2.024 ; -use IO::Compress::Adapter::Deflate 2.024 ; -use IO::Compress::Adapter::Identity 2.024 ; -use IO::Compress::Zlib::Extra 2.024 ; -use IO::Compress::Zip::Constants 2.024 ; +use IO::Compress::Base::Common 2.048 qw(:Status MAX32 isGeMax32 isaScalar createSelfTiedObject); +use IO::Compress::RawDeflate 2.048 (); +use IO::Compress::Adapter::Deflate 2.048 ; +use IO::Compress::Adapter::Identity 2.048 ; +use IO::Compress::Zlib::Extra 2.048 ; +use IO::Compress::Zip::Constants 2.048 ; +use File::Spec(); +use Config; + +use Compress::Raw::Zlib 2.048 (); -use Compress::Raw::Zlib 2.024 qw(crc32) ; BEGIN { eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.024 ; + import IO::Compress::Adapter::Bzip2 2.048 ; require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.024 ; + import IO::Compress::Bzip2 2.048 ; + } ; + + eval { require IO::Compress::Adapter::Lzma ; + import IO::Compress::Adapter::Lzma 2.048 ; + require IO::Compress::Lzma ; + import IO::Compress::Lzma 2.048 ; } ; -# eval { require IO::Compress::Adapter::Lzma ; -# import IO::Compress::Adapter::Lzma 2.020 ; -# require IO::Compress::Lzma ; -# import IO::Compress::Lzma 2.024 ; -# } ; } require Exporter ; -our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError); +our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.024'; +$VERSION = '2.048'; $ZipError = ''; @ISA = qw(Exporter IO::Compress::RawDeflate); @EXPORT_OK = qw( $ZipError zip ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; + push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; $EXPORT_TAGS{zip_method} = [qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA)]; @@ -51,6 +56,7 @@ sub new my $obj = createSelfTiedObject($class, \$ZipError); $obj->_create(undef, @_); + } sub zip @@ -59,6 +65,46 @@ sub zip return $obj->_def(@_); } +sub isMethodAvailable +{ + my $method = shift; + + # Store & Deflate are always available + return 1 + if $method == ZIP_CM_STORE || $method == ZIP_CM_DEFLATE ; + + return 1 + if $method == ZIP_CM_BZIP2 and + defined $IO::Compress::Adapter::Bzip2::VERSION; + + return 1 + if $method == ZIP_CM_LZMA and + defined $IO::Compress::Adapter::Lzma::VERSION; + + return 0; +} + +sub beforePayload +{ + my $self = shift ; + + if (*$self->{ZipData}{Sparse} ) { + my $inc = 1024 * 100 ; + my $NULLS = ("\x00" x $inc) ; + my $sparse = *$self->{ZipData}{Sparse} ; + *$self->{CompSize}->add( $sparse ); + *$self->{UnCompSize}->add( $sparse ); + + *$self->{FH}->seek($sparse, IO::Handle::SEEK_CUR); + + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32($NULLS, *$self->{ZipData}{CRC32}) + for 1 .. int $sparse / $inc; + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(substr($NULLS, 0, $sparse % $inc), + *$self->{ZipData}{CRC32}) + if $sparse % $inc; + } +} + sub mkComp { my $self = shift ; @@ -71,7 +117,7 @@ sub mkComp $got->value('Level'), $got->value('Strategy') ); - *$self->{ZipData}{CRC32} = crc32(undef); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); } elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) { ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject( @@ -87,12 +133,14 @@ sub mkComp $got->value('WorkFactor'), $got->value('Verbosity') ); - *$self->{ZipData}{CRC32} = crc32(undef); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); + } + elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { + ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->value('Preset'), + $got->value('Extreme'), + ); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef); } -# elsif (*$self->{ZipData}{Method} == ZIP_CM_LZMA) { -# ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkCompObject(); -# *$self->{ZipData}{CRC32} = crc32(undef); -# } return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; @@ -126,11 +174,57 @@ sub filterUncompressed *$self->{ZipData}{CRC32} = *$self->{Compress}->crc32(); } else { - *$self->{ZipData}{CRC32} = crc32(${$_[0]}, *$self->{ZipData}{CRC32}); + *$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(${$_[0]}, *$self->{ZipData}{CRC32}); } } +sub canonicalName +{ + # This sub is derived from Archive::Zip::_asZipDirName + + # Return the normalized name as used in a zip file (path + # separators become slashes, etc.). + # Will translate internal slashes in path components (i.e. on Macs) to + # underscores. Discards volume names. + # When $forceDir is set, returns paths with trailing slashes + # + # input output + # . '.' + # ./a a + # ./a/b a/b + # ./a/b/ a/b + # a/b/ a/b + # /a/b/ a/b + # c:\a\b\c.doc a/b/c.doc # on Windows + # "i/o maps:whatever" i_o maps/whatever # on Macs + + my $name = shift; + my $forceDir = shift ; + + my ( $volume, $directories, $file ) = + File::Spec->splitpath( File::Spec->canonpath($name), $forceDir ); + + my @dirs = map { $_ =~ s{/}{_}g; $_ } + File::Spec->splitdir($directories); + + if ( @dirs > 0 ) { pop (@dirs) if $dirs[-1] eq '' } # remove empty component + push @dirs, defined($file) ? $file : '' ; + + my $normalised_path = join '/', @dirs; + + # Leading directory separators should not be stored in zip archives. + # Example: + # C:\a\b\c\ a/b/c + # C:\a\b\c.txt a/b/c.txt + # /a/b/c/ a/b/c + # /a/b/c.txt a/b/c.txt + $normalised_path =~ s{^/}{}; # remove leading separator + + return $normalised_path; +} + + sub mkHeader { my $self = shift; @@ -139,11 +233,27 @@ sub mkHeader *$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset}); + my $comment = ''; + $comment = $param->value('Comment') || ''; + my $filename = ''; $filename = $param->value('Name') || ''; - my $comment = ''; - $comment = $param->value('Comment') || ''; + $filename = canonicalName($filename) + if length $filename && $param->value('CanonicalName') ; + + if (defined *$self->{ZipData}{FilterName} ) { + local *_ = \$filename ; + &{ *$self->{ZipData}{FilterName} }() ; + } + +# if ( $param->value('UTF8') ) { +# require Encode ; +# $filename = Encode::encode_utf8($filename) +# if length $filename ; +# $comment = Encode::encode_utf8($filename) +# if length $comment ; +# } my $hdr = ''; @@ -156,11 +266,12 @@ sub mkHeader my $extFileAttr = 0 ; # This code assumes Unix. - $extFileAttr = 0666 << 16 + # TODO - revisit this + $extFileAttr = 0100644 << 16 if $osCode == ZIP_OS_CODE_UNIX ; if (*$self->{ZipData}{Zip64}) { - $empty = 0xFFFFFFFF; + $empty = MAX32; my $x = ''; $x .= pack "V V", 0, 0 ; # uncompressedLength @@ -169,7 +280,7 @@ sub mkHeader } if (! $param->value('Minimal')) { - if (defined $param->value('exTime')) + if ($param->parsed('MTime')) { $extra .= mkExtendedTime($param->value('MTime'), $param->value('ATime'), @@ -178,10 +289,20 @@ sub mkHeader $ctlExtra .= mkExtendedTime($param->value('MTime')); } - if ( $param->value('UID') && $osCode == ZIP_OS_CODE_UNIX) + if ( $osCode == ZIP_OS_CODE_UNIX ) { - $extra .= mkUnix2Extra( $param->value('UID'), $param->value('GID')); - $ctlExtra .= mkUnix2Extra(); + if ( $param->value('want_exUnixN') ) + { + my $ux3 = mkUnixNExtra( @{ $param->value('want_exUnixN') }); + $extra .= $ux3; + $ctlExtra .= $ux3; + } + + if ( $param->value('exUnix2') ) + { + $extra .= mkUnix2Extra( @{ $param->value('exUnix2') }); + $ctlExtra .= mkUnix2Extra(); + } } $extFileAttr = $param->value('ExtAttr') @@ -194,15 +315,21 @@ sub mkHeader if defined $param->value('ExtraFieldCentral'); } + my $method = *$self->{ZipData}{Method} ; my $gpFlag = 0 ; $gpFlag |= ZIP_GP_FLAG_STREAMING_MASK if *$self->{ZipData}{Stream} ; - my $method = *$self->{ZipData}{Method} ; + $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT + if $method == ZIP_CM_LZMA ; + + #$gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING + #if $param->value('UTF8') && length($filename) + length($comment); my $version = $ZIP_CM_MIN_VERSIONS{$method}; $version = ZIP64_MIN_VERSION if ZIP64_MIN_VERSION > $version && *$self->{ZipData}{Zip64}; + my $madeBy = ($param->value('OS_Code') << 8) + $version; my $extract = $version; @@ -264,7 +391,7 @@ sub mkHeader # offset to local hdr if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) { - $ctl .= pack 'V', 0xFFFFFFFF ; + $ctl .= pack 'V', MAX32 ; } else { $ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ; @@ -278,6 +405,7 @@ sub mkHeader *$self->{ZipData}{CentralHeader} = $ctl; + return $hdr; } @@ -307,6 +435,7 @@ sub mkTrailer my $data = $crc32 . $sizes ; + my $xtrasize = *$self->{UnCompSize}->getPacked_V64() ; # Uncompressed size $xtrasize .= *$self->{CompSize}->getPacked_V64() ; # Compressed size @@ -331,14 +460,14 @@ sub mkTrailer my $x = ''; # uncompressed length - if (*$self->{UnCompSize}->is64bit() ) { + if (*$self->{UnCompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) { $x .= *$self->{UnCompSize}->getPacked_V64() ; } else { substr($ctl, 24, 4) = *$self->{UnCompSize}->getPacked_V32() ; } # compressed length - if (*$self->{CompSize}->is64bit() ) { + if (*$self->{CompSize}->isAlmost64bit() || *$self->{ZipData}{Zip64} > 1) { $x .= *$self->{CompSize}->getPacked_V64() ; } else { substr($ctl, 20, 4) = *$self->{CompSize}->getPacked_V32() ; @@ -406,8 +535,8 @@ sub mkFinalTrailer $z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir $z64e .= pack 'V', 1 ; # Total number of disks - $cd_offset = 0xFFFFFFFF ; - $cd_len = 0xFFFFFFFF if $cd_len >= 0xFFFFFFFF ; + $cd_offset = MAX32 ; + $cd_len = MAX32 if isGeMax32 $cd_len ; $entries = 0xFFFF if $entries >= 0xFFFF ; } @@ -449,16 +578,20 @@ sub ckParams $got->value("CTime", $timeRef->[2]); } - # Unix2 Extended Attribute - if ($got->parsed('exUnix2') ) { - my $timeRef = $got->value('exUnix2'); - if ( defined $timeRef) { - return $self->saveErrorString(undef, "exUnix2 not a 2-element array ref") - if ref $timeRef ne 'ARRAY' || @$timeRef != 2; + # Unix2/3 Extended Attribute + for my $name (qw(exUnix2 exUnixN)) + { + if ($got->parsed($name) ) { + my $idRef = $got->value($name); + if ( defined $idRef) { + return $self->saveErrorString(undef, "$name not a 2-element array ref") + if ref $idRef ne 'ARRAY' || @$idRef != 2; + } + + $got->value("UID", $idRef->[0]); + $got->value("GID", $idRef->[1]); + $got->value("want_$name", $idRef); } - - $got->value("UID", $timeRef->[0]); - $got->value("GID", $timeRef->[1]); } *$self->{ZipData}{AnyZip64} = 1 @@ -475,9 +608,8 @@ sub ckParams ! defined $IO::Compress::Adapter::Bzip2::VERSION; return $self->saveErrorString(undef, "Lzma not available") - if $method == ZIP_CM_LZMA ; - #and - #! defined $IO::Compress::Adapter::Lzma::VERSION; + if $method == ZIP_CM_LZMA + and ! defined $IO::Compress::Adapter::Lzma::VERSION; *$self->{ZipData}{Method} = $method; @@ -499,9 +631,28 @@ sub ckParams if defined $IO::Compress::Bzip2::VERSION and ! IO::Compress::Bzip2::ckParams($self, $got); + if ($got->parsed('Sparse') ) { + *$self->{ZipData}{Sparse} = $got->value('Sparse') ; + *$self->{ZipData}{Method} = ZIP_CM_STORE; + } + + if ($got->parsed('FilterName')) { + my $v = $got->value('FilterName') ; + *$self->{ZipData}{FilterName} = $v + if ref $v eq 'CODE' ; + } + return 1 ; } +sub outputPayload +{ + my $self = shift ; + return 1 if *$self->{ZipData}{Sparse} ; + return $self->output(@_); +} + + #sub newHeader #{ # my $self = shift ; @@ -513,14 +664,14 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.024 qw(:Parse); - use Compress::Raw::Zlib 2.024 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); + use IO::Compress::Base::Common 2.048 qw(:Parse); + use Compress::Raw::Zlib 2.048 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); my @Bzip2 = (); @Bzip2 = IO::Compress::Bzip2::getExtraParams($self) if defined $IO::Compress::Bzip2::VERSION; - + return ( # zlib behaviour $self->getZlibParams(), @@ -535,16 +686,30 @@ sub getExtraParams 'Comment' => [0, 1, Parse_any, ''], 'ZipComment'=> [0, 1, Parse_any, ''], 'Name' => [0, 1, Parse_any, ''], + 'FilterName'=> [0, 1, Parse_code, undef], + 'CanonicalName'=> [0, 1, Parse_boolean, 0], + #'UTF8' => [0, 1, Parse_boolean, 0], 'Time' => [0, 1, Parse_any, undef], 'exTime' => [0, 1, Parse_any, undef], 'exUnix2' => [0, 1, Parse_any, undef], - 'ExtAttr' => [0, 1, Parse_any, 0], + 'exUnixN' => [0, 1, Parse_any, undef], + 'ExtAttr' => [0, 1, Parse_any, + $Compress::Raw::Zlib::gzip_os_code == 3 + ? 0100644 << 16 + : 0], 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], 'TextFlag' => [0, 1, Parse_boolean, 0], 'ExtraFieldLocal' => [0, 1, Parse_any, undef], 'ExtraFieldCentral'=> [0, 1, Parse_any, undef], + # Lzma + 'Preset' => [0, 1, Parse_unsigned, 6], + 'Extreme' => [1, 1, Parse_boolean, 0], + + # For internal use only + 'Sparse' => [0, 1, Parse_unsigned, 0], + @Bzip2, ); } @@ -561,8 +726,31 @@ sub getFileInfo my $params = shift; my $filename = shift ; - my ($mode, $uid, $gid, $atime, $mtime, $ctime) - = (stat($filename))[2, 4,5, 8,9,10] ; + if (isaScalar($filename)) + { + $params->value(Zip64 => 1) + if isGeMax32 length (${ $filename }) ; + + return ; + } + + my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ; + if ( $params->parsed('StoreLinks') ) + { + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + = (lstat($filename))[2, 4,5,7, 8,9,10] ; + } + else + { + ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) + = (stat($filename))[2, 4,5,7, 8,9,10] ; + } + + $params->value(TextFlag => -T $filename ) + if ! $params->parsed('TextFlag'); + + $params->value(Zip64 => 1) + if isGeMax32 $size ; $params->value('Name' => $filename) if ! $params->parsed('Name') ; @@ -575,13 +763,21 @@ sub getFileInfo $params->value('MTime' => $mtime) ; $params->value('ATime' => $atime) ; $params->value('CTime' => undef) ; # No Creation time - $params->value("exTime", [$mtime, $atime, undef]); + # TODO - see if can fillout creation time on non-Unix } # NOTE - Unix specific code alert - $params->value('ExtAttr' => $mode << 16) - if ! $params->parsed('ExtAttr'); + if (! $params->parsed('ExtAttr')) + { + use Fcntl qw(:mode) ; + my $attr = $mode << 16; + $attr |= ZIP_A_RONLY if ($mode & S_IWRITE) == 0 ; + $attr |= ZIP_A_DIR if ($mode & S_IFMT ) == S_IFDIR ; + + $params->value('ExtAttr' => $attr); + } + $params->value('want_exUnixN', [$uid, $gid]); $params->value('UID' => $uid) ; $params->value('GID' => $gid) ; @@ -622,11 +818,29 @@ sub mkUnix2Extra $ids); } +sub mkUnixNExtra +{ + my $uid = shift; + my $gid = shift; + + # Assumes UID/GID are 32-bit + my $ids ; + $ids .= pack "C", 1; # version + $ids .= pack "C", $Config{uidsize}; + $ids .= pack "V", $uid; + $ids .= pack "C", $Config{gidsize}; + $ids .= pack "V", $gid; + + return IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_INFO_ZIP_UNIXN, + $ids); +} + # from Archive::Zip sub _unixToDosTime # Archive::Zip::Member { my $time_t = shift; + # TODO - add something to cope with unix time < 1980 my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime($time_t); my $dt = 0; @@ -702,11 +916,14 @@ zip files and buffers. It is not a general-purpose file archiver. If that is what you want, check out C<Archive::Zip>. At present three compression methods are supported by IO::Compress::Zip, -namely Store (no compression at all), Deflate and Bzip2. +namely Store (no compression at all), Deflate, Bzip2 and LZMA. Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must be installed. +Note that to create LZMA content, the module C<IO::Compress::Lzma> must +be installed. + For reading zip files/buffers, see the companion module L<IO::Uncompress::Unzip|IO::Uncompress::Unzip>. @@ -770,8 +987,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<zip> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -779,10 +994,10 @@ See L<File::GlobMapper|File::GlobMapper> for more details. If the C<$input> parameter is any other type, C<undef> will be returned. In addition, if C<$input> is a simple filename, the default values for -the C<Name>, C<Time>, C<ExtAttr> and C<exTime> options will be sourced from that file. +the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options will be sourced from that file. If you do not want to use these defaults they can be overridden by -explicitly setting the C<Name>, C<Time>, C<ExtAttr> and C<exTime> options or by setting the +explicitly setting the C<Name>, C<Time>, C<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options or by setting the C<Minimal> parameter. =head3 The C<$output> parameter @@ -823,6 +1038,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -890,8 +1107,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all compressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all compressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -932,28 +1149,32 @@ compressed data to a buffer, C<$buffer>. zip $input => \$buffer or die "zip failed: $ZipError\n"; -To compress all files in the directory "/my/home" that match "*.txt" -and store the compressed data in the same directory +To create a zip file, C<output.zip>, that contains the compressed contents +of the files C<alpha.txt> and C<beta.txt> use strict ; use warnings ; use IO::Compress::Zip qw(zip $ZipError) ; - zip '</my/home/*.txt>' => '<*.zip>' + zip [ 'alpha.txt', 'beta.txt' ] => 'output.zip' or die "zip failed: $ZipError\n"; -and if you want to compress each file one at a time, this will do the trick +Alternatively, rather than having to explicitly name each of the files that +you want to compress, you could use a fileglob to select all the C<txt> +files in the current directory, as follows use strict ; use warnings ; use IO::Compress::Zip qw(zip $ZipError) ; - for my $input ( glob "/my/home/*.txt" ) - { - my $output = "$input.zip" ; - zip $input => $output - or die "Error compressing '$input': $ZipError\n"; - } + my @files = <*.txt>; + zip \@files => 'output.zip' + or die "zip failed: $ZipError\n"; + +or more succinctly + + zip [ <*.txt> ] => 'output.zip' + or die "zip failed: $ZipError\n"; =head1 OO Interface @@ -1051,15 +1272,76 @@ This parameter defaults to 0. =item C<< Name => $string >> -Stores the contents of C<$string> in the zip filename header field. If -C<Name> is not specified, no zip filename field will be created. +Stores the contents of C<$string> in the zip filename header field. + +If C<Name> is not specified and the C<$input> parameter is a filename, the +value of C<$input> will be used for the zip filename header field. + +If C<Name> is not specified and the C<$input> parameter is not a filename, +no zip filename field will be created. + +Note that both the C<CanonicalName> and C<FilterName> options +can modify the value used for the zip filename header field. + +=item C<< CanonicalName => 0|1 >> + +This option controls whether the filename field in the zip header is +I<normalized> into Unix format before being written to the zip file. + +It is recommended that you enable this option unless you really need +to create a non-standard Zip file. + +This is what APPNOTE.TXT has to say on what should be stored in the zip +filename header field. + + The name of the file, with optional relative path. + The path stored should not contain a drive or + device letter, or a leading slash. All slashes + should be forward slashes '/' as opposed to + backwards slashes '\' for compatibility with Amiga + and UNIX file systems etc. + +This option defaults to B<false>. + +=item C<< FilterName => sub { ... } >> + +This option allow the filename field in the zip header to be modified +before it is written to the zip file. + +This option takes a parameter that must be a reference to a sub. On entry +to the sub the C<$_> variable will contain the name to be filtered. If no +filename is available C<$_> will contain an empty string. + +The value of C<$_> when the sub returns will be stored in the filename +header field. + +Note that if C<CanonicalName> is enabled, a +normalized filename will be passed to the sub. + +If you use C<FilterName> to modify the filename, it is your responsibility +to keep the filename in Unix format. + +Although this option can be used with the OO ointerface, it is of most use +with the one-shot interface. For example, the code below shows how +C<FilterName> can be used to remove the path component from a series of +filenames before they are stored in C<$zipfile>. + + sub compressTxtFiles + { + my $zipfile = shift ; + my $dir = shift ; + + zip [ <$dir/*.txt> ] => $zipfile, + FilterName => sub { s[^$dir/][] } ; + } =item C<< Time => $number >> Sets the last modified time field in the zip header to $number. This field defaults to the time the C<IO::Compress::Zip> object was created -if this option is not specified. +if this option is not specified and the C<$input> parameter is not a +filename. =item C<< ExtAttr => $attr >> @@ -1068,10 +1350,10 @@ header of the zip file. This is a 4 byte field. If you are running a Unix derivative this value defaults to - 0666 << 16 + 0100644 << 16 This should allow read/write access to any files that are extracted from -the zip file/buffer. +the zip file/buffer`. For all other systems it defaults to 0. @@ -1098,18 +1380,37 @@ By default no extended time field is created. =item C<< exUnix2 => [$uid, $gid] >> This option expects an array reference with exactly two elements: C<$uid> -and C<$gid>. These values correspond to the numeric user ID and group ID -of the owner of the files respectively. +and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID +(GID) of the owner of the files respectively. When the C<exUnix2> option is present it will trigger the creation of a -Unix2 extra field (ID is "Ux") in the local zip. This will be populated -with C<$uid> and C<$gid>. In addition an empty Unix2 extra field will also -be created in the central zip header +Unix2 extra field (ID is "Ux") in the local zip header. This will be populated +with C<$uid> and C<$gid>. An empty Unix2 extra field will also +be created in the central zip header. + +Note - The UID & GID are stored as 16-bit +integers in the "Ux" field. Use C<< exUnixN >> if your UID or GID are +32-bit. If the C<Minimal> option is set to true, this option will be ignored. By default no Unix2 extra field is created. +=item C<< exUnixN => [$uid, $gid] >> + +This option expects an array reference with exactly two elements: C<$uid> +and C<$gid>. These values correspond to the numeric User ID (UID) and Group ID +(GID) of the owner of the files respectively. + +When the C<exUnixN> option is present it will trigger the creation of a +UnixN extra field (ID is "ux") in bothe the local and central zip headers. +This will be populated with C<$uid> and C<$gid>. +The UID & GID are stored as 32-bit integers. + +If the C<Minimal> option is set to true, this option will be ignored. + +By default no UnixN extra field is created. + =item C<< Comment => $comment >> Stores the contents of C<$comment> in the Central File Header of @@ -1126,12 +1427,12 @@ By default, no comment field is written to the zip file. =item C<< Method => $method >> -Controls which compression method is used. At present three compression -methods are supported, namely Store (no compression at all), Deflate and -Bzip2. +Controls which compression method is used. At present four compression +methods are supported, namely Store (no compression at all), Deflate, +Bzip2 and Lzma. -The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 are used to -select the compression method. +The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2 and ZIP_CM_LZMA +are used to select the compression method. These constants are not imported by C<IO::Compress::Zip> by default. @@ -1143,6 +1444,10 @@ Note that to create Bzip2 content, the module C<IO::Compress::Bzip2> must be installed. A fatal error will be thrown if you attempt to create Bzip2 content when C<IO::Compress::Bzip2> is not available. +Note that to create Lzma content, the module C<IO::Compress::Lzma> must +be installed. A fatal error will be thrown if you attempt to create Lzma +content when C<IO::Compress::Lzma> is not available. + The default method is ZIP_CM_DEFLATE. =item C<< Stream => 0|1 >> @@ -1157,11 +1462,14 @@ The default is 1. =item C<< Zip64 => 0|1 >> -Create a Zip64 zip file/buffer. This option should only be used if you want -to store files larger than 4 Gig. +Create a Zip64 zip file/buffer. This option is used if you want +to store files larger than 4 Gig. + +C<Zip64> will be automatically set, as needed, if working with the one-shot +interface when the input is either a filename or a scalar reference. If you intend to manipulate the Zip64 zip files created with this module -using an external zip/unzip make sure that it supports Zip64. +using an external zip/unzip, make sure that it supports Zip64. In particular, if you are using Info-Zip you need to have zip version 3.x or better to update a Zip64 archive and unzip version 6.x to read a zip64 @@ -1175,6 +1483,9 @@ This parameter controls the setting of a bit in the zip central header. It is used to signal that the data stored in the zip file/buffer is probably text. +In one-shot mode this flag will be set to true if the Perl C<-T> operator thinks +the file contains text. + The default is 0. =item C<< ExtraFieldLocal => $data >> @@ -1214,6 +1525,9 @@ Alternatively the list of subfields can by supplied as a scalar, thus ExtraField => $rawdata +In this case C<IO::Compress::Zip> will check that C<$rawdata> consists of +zero or more conformant sub-fields. + The Extended Time field (ID "UT"), set using the C<exTime> option, and the Unix2 extra field (ID "Ux), set using the C<exUnix2> option, are examples of extra fields. @@ -1226,7 +1540,8 @@ The maximum size of an extra field 65535 bytes. If specified, this option will disable the creation of all extra fields in the zip local and central headers. So the C<exTime>, C<exUnix2>, -C<ExtraFieldLocal> and C<ExtraFieldCentral> options will be ignored. +C<exUnixN>, C<ExtraFieldLocal> and C<ExtraFieldCentral> options will +be ignored. This parameter defaults to 0. @@ -1253,6 +1568,32 @@ otherwise. The default is 0. +=item C<< Preset => number >> + +Used to choose the LZMA compression preset. + +Valid values are 0-9 and C<LZMA_PRESET_DEFAULT>. + +0 is the fastest compression with the lowest memory usage and the lowest +compression. + +9 is the slowest compession with the highest memory usage but with the best +compression. + +This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored +otherwise. + +Defaults to C<LZMA_PRESET_DEFAULT> (6). + +=item C<< Extreme => 0|1 >> + +Makes LZMA compression a lot slower, but a small compression gain. + +This option is only valid if the C<Method> is ZIP_CM_LZMA. It is ignored +otherwise. + +Defaults to 0. + =item -Level Defines the compression level used by zlib. The value should either be @@ -1447,7 +1788,7 @@ If the C<$z> object is associated with a file or a filehandle, C<fileno> will return the underlying file descriptor. Once the C<close> method is called C<fileno> will return C<undef>. -If the C<$z> object is is associated with a buffer, this method will return +If the C<$z> object is associated with a buffer, this method will return C<undef>. =head2 close @@ -1566,8 +1907,6 @@ constructor. See L<IO::Compress::FAQ|IO::Compress::FAQ/"Apache::GZip Revisited"> - - =head2 Working with Net::FTP See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> @@ -1576,7 +1915,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<Compress::Zlib::FAQ|Compress::Zlib::FAQ> +L<IO::Compress::FAQ|IO::Compress::FAQ> L<File::GlobMapper|File::GlobMapper>, L<Archive::Zip|Archive::Zip>, L<Archive::Tar|Archive::Tar>, @@ -1605,7 +1944,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm index c8cb95342a2..8db079cb93d 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.024'; +$VERSION = '2.048'; @ISA = qw(Exporter); @@ -38,7 +38,9 @@ $VERSION = '2.024'; ZIP_EXTRA_ID_ZIP64 ZIP_EXTRA_ID_EXT_TIMESTAMP ZIP_EXTRA_ID_INFO_ZIP_UNIX2 - ZIP_EXTRA_ID_INFO_ZIP_UNIXn + ZIP_EXTRA_ID_INFO_ZIP_UNIXN + ZIP_EXTRA_ID_INFO_ZIP_Upath + ZIP_EXTRA_ID_INFO_ZIP_Ucom ZIP_EXTRA_ID_JAVA_EXE ZIP_OS_CODE_UNIX @@ -49,6 +51,12 @@ $VERSION = '2.024'; %ZIP_CM_MIN_VERSIONS ZIP64_MIN_VERSION + ZIP_A_RONLY + ZIP_A_HIDDEN + ZIP_A_SYSTEM + ZIP_A_LABEL + ZIP_A_DIR + ZIP_A_ARCHIVE ); # Compression types supported @@ -72,6 +80,7 @@ use constant ZIP_IFA_TEXT_MASK => 1; # Signatures for each of the headers use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; use constant ZIP_DATA_HDR_SIG => 0x08074b50; +use constant packed_ZIP_DATA_HDR_SIG => pack "V", ZIP_DATA_HDR_SIG; use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50; @@ -86,16 +95,27 @@ use constant ZIP_OS_CODE_DEFAULT => 3; use constant ZIP_EXTRA_ID_ZIP64 => pack "v", 1; use constant ZIP_EXTRA_ID_EXT_TIMESTAMP => "UT"; use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2 => "Ux"; -use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXn => "ux"; +use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN => "ux"; +use constant ZIP_EXTRA_ID_INFO_ZIP_Upath => "up"; +use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom => "uc"; use constant ZIP_EXTRA_ID_JAVA_EXE => pack "v", 0xCAFE; +# DOS Attributes +use constant ZIP_A_RONLY => 0x01; +use constant ZIP_A_HIDDEN => 0x02; +use constant ZIP_A_SYSTEM => 0x04; +use constant ZIP_A_LABEL => 0x08; +use constant ZIP_A_DIR => 0x10; +use constant ZIP_A_ARCHIVE => 0x20; + use constant ZIP64_MIN_VERSION => 45; %ZIP_CM_MIN_VERSIONS = ( - ZIP_CM_STORE() => 20, - ZIP_CM_DEFLATE() => 20, - ZIP_CM_BZIP2() => 46, - ZIP_CM_LZMA() => 63, + ZIP_CM_STORE() => 20, + ZIP_CM_DEFLATE() => 20, + ZIP_CM_BZIP2() => 46, + ZIP_CM_LZMA() => 63, + ZIP_CM_PPMD() => 63, ); diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm index 10fcf345f63..992b1b925f2 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.024'; +$VERSION = '2.048'; @ISA = qw(Exporter); diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm index 6812bb409dc..9e0be2e4b6c 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm @@ -1,6 +1,6 @@ package IO::Compress::Zlib::Extra; -require 5.004 ; +require 5.006 ; use strict ; use warnings; @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.024'; +$VERSION = '2.048'; -use IO::Compress::Gzip::Constants 2.024 ; +use IO::Compress::Gzip::Constants 2.048 ; sub ExtraFieldError { @@ -98,6 +98,38 @@ sub parseRawExtra return undef ; } +sub findID +{ + my $id_want = shift ; + my $data = shift; + + my $XLEN = length $data ; + + my $offset = 0 ; + while ($offset < $XLEN) { + + return undef + if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; + + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; + + my $subLen = unpack("v", substr($data, $offset, + GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); + $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; + + return undef + if $offset + $subLen > $XLEN ; + + return substr($data, $offset, $subLen) + if $id eq $id_want ; + + $offset += $subLen ; + } + + return undef ; +} + sub mkSubField { @@ -142,7 +174,6 @@ sub parseExtraField return parseRawExtra($dataRef, undef, 1, $gzipMode); } - #my $data = $$dataRef; my $data = $dataRef; my $out = '' ; @@ -163,7 +194,7 @@ sub parseExtraField return ExtraFieldError("Not even number of elements") unless @$data % 2 == 0; - for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) { + for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { my $bad = validateExtraFieldPair([$data->[$ix], $data->[$ix+1]], $strict, $gzipMode) ; diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm index 98677e3c09f..516c5dda4f0 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); -use Compress::Raw::Bzip2 2.024 ; +use Compress::Raw::Bzip2 2.048 ; our ($VERSION, @ISA); -$VERSION = '2.024'; +$VERSION = '2.048'; sub mkUncompObject { diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm index 27de6e0f36b..5d74d042124 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,47 +4,131 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); +use IO::Compress::Base::Common 2.048 qw(:Status); +use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.024'; +$VERSION = '2.048'; -use Compress::Raw::Zlib 2.024 (); +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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm index aac1e413ffe..c0f3542a98a 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status); -use Compress::Raw::Zlib 2.024 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.024'; +$VERSION = '2.048'; diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm index 68038f5d374..a6ab437159a 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm @@ -6,22 +6,22 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -use IO::Uncompress::Adapter::Inflate 2.024 (); +use IO::Uncompress::Adapter::Inflate 2.048 (); -use IO::Uncompress::Base 2.024 ; -use IO::Uncompress::Gunzip 2.024 ; -use IO::Uncompress::Inflate 2.024 ; -use IO::Uncompress::RawInflate 2.024 ; -use IO::Uncompress::Unzip 2.024 ; +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.024'; +$VERSION = '2.048'; $AnyInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -48,7 +48,7 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.024 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ) ; } @@ -256,8 +256,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<anyinflate> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -302,6 +300,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -371,8 +371,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -562,7 +562,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -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-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm index 5984921e25b..d9a48e6a240 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm @@ -4,16 +4,16 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject); -use IO::Uncompress::Base 2.024 ; +use IO::Uncompress::Base 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.024'; +$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.024 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.024 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.024 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.024 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.020 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.020 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.024 ;'; - eval ' use IO::Uncompress::UnLzop 2.024 ;'; - eval ' use IO::Uncompress::Gunzip 2.024 ;'; - eval ' use IO::Uncompress::Inflate 2.024 ;'; - eval ' use IO::Uncompress::RawInflate 2.024 ;'; - eval ' use IO::Uncompress::Unzip 2.024 ;'; - eval ' use IO::Uncompress::UnLzf 2.024 ;'; - eval ' use IO::Uncompress::UnLzma 2.024 ;'; - eval ' use IO::Uncompress::UnXz 2.024 ;'; + 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.024 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'RawInflate' => [1, 1, Parse_boolean, 0] , 'UnLzma' => [1, 1, Parse_boolean, 0] ) ; } @@ -365,8 +365,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<anyuncompress> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -411,6 +409,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -480,8 +480,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -671,7 +671,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -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-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Base.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Base.pm index 33f2ac23758..cb1e15e9aef 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Base.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Base.pm @@ -9,13 +9,12 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(Exporter IO::File); -$VERSION = '2.024'; +$VERSION = '2.048'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.024 ; -#use Parse::Parameters ; +use IO::Compress::Base::Common 2.048 ; use IO::File ; use Symbol; @@ -25,9 +24,6 @@ use Carp ; %EXPORT_TAGS = ( ); push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; -#Exporter::export_ok_tags('all') ; - - sub smartRead { @@ -37,6 +33,7 @@ sub smartRead $$out = "" ; my $offset = 0 ; + my $status = 1; if (defined *$self->{InputLength}) { @@ -46,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) { @@ -69,11 +65,12 @@ sub smartRead # because the filehandle may not support the offset parameter # An example is Net::FTP my $tmp = ''; - *$self->{FH}->read($tmp, $get_size) && - (substr($$out, $offset) = $tmp); + $status = *$self->{FH}->read($tmp, $get_size) ; + substr($$out, $offset) = $tmp + if defined $status && $status > 0 ; } else - { *$self->{FH}->read($$out, $get_size) } + { $status = *$self->{FH}->read($$out, $get_size) } } elsif (defined *$self->{InputEvent}) { my $got = 1 ; @@ -83,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)) = ''; } @@ -94,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) = '' } @@ -105,6 +100,11 @@ sub smartRead *$self->{InputLengthRemaining} -= length($$out) #- $offset if defined *$self->{InputLength}; + if (! defined $status) { + $self->saveStatus($!) ; + return STATUS_ERROR; + } + $self->saveStatus(length $$out < 0 ? STATUS_ERROR : STATUS_OK) ; return length $$out; @@ -140,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 ; @@ -191,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(); @@ -199,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}) @@ -236,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} } = '' ; @@ -251,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; } @@ -474,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}) ; } @@ -698,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} } = '' ; } @@ -717,7 +750,6 @@ sub _rd2 } last if $status < 0 || $z->smartEof(); - #last if $status < 0 ; last unless *$self->{MultiStream}; @@ -776,8 +808,8 @@ sub readBlock } my $status = $self->smartRead($buff, $size) ; - return $self->saveErrorString(STATUS_ERROR, "Error Reading Data") - if $status < 0 ; + return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!) + if $status == STATUS_ERROR ; if ($status == 0 ) { *$self->{Closed} = 1 ; @@ -803,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 ; @@ -814,7 +845,7 @@ sub _raw_read my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ; return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) - if $len < 0 ; + if $len == STATUS_ERROR ; if ($len == 0 ) { *$self->{EndStream} = 1 ; @@ -843,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 ; @@ -871,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); @@ -881,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} ; @@ -972,15 +1002,16 @@ 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} ) + if (! *$self->{Transparent} || $self->eof()) { *$self->{EndStream} = 1 ; return 0; @@ -1013,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 @@ -1022,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 ; @@ -1057,6 +1102,9 @@ sub read } } } + elsif (! defined $$buffer) { + $$buffer = '' ; + } return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ; @@ -1113,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) = '' ; @@ -1123,70 +1170,78 @@ sub read sub _getline { my $self = shift ; + my $status = 0 ; # Slurp Mode if ( ! defined $/ ) { my $data ; - 1 while $self->read($data) > 0 ; - return \$data ; + 1 while ($status = $self->read($data)) > 0 ; + return ($status, \$data); } # Record Mode if ( ref $/ eq 'SCALAR' && ${$/} =~ /^\d+$/ && ${$/} > 0) { my $reclen = ${$/} ; my $data ; - $self->read($data, $reclen) ; - return \$data ; + $status = $self->read($data, $reclen) ; + return ($status, \$data); } # Paragraph Mode if ( ! length $/ ) { my $paragraph ; - while ($self->read($paragraph) > 0 ) { + while (($status = $self->read($paragraph)) > 0 ) { if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; my $par = $1 ; - return \$par ; + return (1, \$par); } } - return \$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 ($self->read($line) > 0 ) { + 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 \$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 ; } @@ -1280,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(); @@ -1411,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" ; } ; } @@ -1445,13 +1498,13 @@ IO::Uncompress::Base - Base Class for IO::Uncompress modules =head1 DESCRIPTION This module is not intended for direct use in application code. Its sole -purpose if to to be sub-classed by IO::Unompress modules. +purpose if to to be sub-classed by IO::Uncompress modules. =head1 SEE ALSO L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<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>, @@ -1467,7 +1520,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm index b3988c41851..f53513a7e48 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); -use IO::Uncompress::Base 2.024 ; -use IO::Uncompress::Adapter::Bunzip2 2.024 ; +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.024'; +$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.024 qw(:Parse); + use IO::Compress::Base::Common 2.048 qw(:Parse); return ( 'Verbosity' => [1, 1, Parse_boolean, 0], diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm index f3e4e6561f0..bf803ae161b 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/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.024 ; +use IO::Uncompress::RawInflate 2.048 ; -use Compress::Raw::Zlib 2.024 qw( crc32 ) ; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.024 ; -use IO::Compress::Zlib::Extra 2.024 ; +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.024'; +$VERSION = '2.048'; sub new { @@ -47,7 +47,7 @@ sub gunzip sub getExtraParams { - use IO::Compress::Base::Common 2.024 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; @@ -392,8 +392,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<gunzip> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -438,6 +436,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -507,8 +507,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -698,7 +698,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -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-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm index 956f62e0835..7a40889fa84 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); -use IO::Compress::Zlib::Constants 2.024 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); +use IO::Compress::Zlib::Constants 2.048 ; -use IO::Uncompress::RawInflate 2.024 ; +use IO::Uncompress::RawInflate 2.048 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.024'; +$VERSION = '2.048'; $InflateError = ''; @ISA = qw( Exporter IO::Uncompress::RawInflate ); @@ -313,8 +313,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<inflate> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -359,6 +357,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -428,8 +428,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -619,7 +619,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -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-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm index f017fa0f599..0372ec72e35 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.024 ; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); +use Compress::Raw::Zlib 2.048 ; +use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject); -use IO::Uncompress::Base 2.024 ; -use IO::Uncompress::Adapter::Inflate 2.024 ; +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.024'; +$VERSION = '2.048'; $RawInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -461,8 +461,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<rawinflate> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -507,6 +505,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -576,8 +576,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -764,7 +764,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -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-2010 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/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm b/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm index e7d6849f66b..7b2121c4e75 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm +++ b/gnu/usr.bin/perl/cpan/IO-Compress/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.024 ; -use IO::Compress::Base::Common 2.024 qw(:Status createSelfTiedObject); -use IO::Uncompress::Adapter::Inflate 2.024 ; -use IO::Uncompress::Adapter::Identity 2.024 ; -use IO::Compress::Zlib::Extra 2.024 ; -use IO::Compress::Zip::Constants 2.024 ; +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.024 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.024'; +$VERSION = '2.048'; $UnzipError = ''; @ISA = qw(Exporter IO::Uncompress::RawInflate); @@ -63,15 +64,16 @@ sub unzip sub getExtraParams { - use IO::Compress::Base::Common 2.024 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; @@ -894,8 +1149,6 @@ If C<$input> is a string that is delimited by the characters "<" and ">" C<unzip> will assume that it is an I<input fileglob string>. The input is the list of files that match the fileglob. -If the fileglob does not match any files ... - See L<File::GlobMapper|File::GlobMapper> for more details. =back @@ -940,6 +1193,8 @@ output is the list of files that match the fileglob. When C<$output> is an fileglob string, C<$input> must also be a fileglob string. Anything else is an error. +See L<File::GlobMapper|File::GlobMapper> for more details. + =back If the C<$output> parameter is any other type, C<undef> will be returned. @@ -1009,8 +1264,8 @@ data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any uncompressed data. If the output is a filename, it will be opened for -appending. If the output is a buffer, all uncompressed data will be appened to -the existing buffer. +appending. If the output is a buffer, all uncompressed data will be +appended to the existing buffer. Conversely when C<Append> is not specified, or it is present and is set to false, it will operate as follows. @@ -1056,54 +1311,57 @@ C<InputLength> option. =head2 Examples -To read the contents of the file C<file1.txt.zip> and write the -uncompressed data to the file C<file1.txt>. +Say you have a zip file, C<file1.zip>, that only contains a +single member, you can read it and write the uncompressed data to the +file C<file1.txt> like this. use strict ; use warnings ; use IO::Uncompress::Unzip qw(unzip $UnzipError) ; - my $input = "file1.txt.zip"; + my $input = "file1.zip"; my $output = "file1.txt"; unzip $input => $output or die "unzip failed: $UnzipError\n"; -To read from an existing Perl filehandle, C<$input>, and write the -uncompressed data to a buffer, C<$buffer>. +If you have a zip file that contains multiple members and want to read a +specific member from the file, say C<"data1">, use the C<Name> option use strict ; use warnings ; use IO::Uncompress::Unzip qw(unzip $UnzipError) ; - use IO::File ; - my $input = new IO::File "<file1.txt.zip" - or die "Cannot open 'file1.txt.zip': $!\n" ; - my $buffer ; - unzip $input => \$buffer + my $input = "file1.zip"; + my $output = "file1.txt"; + unzip $input => $output, Name => "data1" or die "unzip failed: $UnzipError\n"; -To uncompress all files in the directory "/my/home" that match "*.txt.zip" and store the compressed data in the same directory +Alternatively, if you want to read the C<"data1"> member into memory, use +a scalar reference for the C<output> partameter. use strict ; use warnings ; use IO::Uncompress::Unzip qw(unzip $UnzipError) ; - unzip '</my/home/*.txt.zip>' => '</my/home/#1.txt>' + my $input = "file1.zip"; + my $output ; + unzip $input => \$output, Name => "data1" or die "unzip failed: $UnzipError\n"; + # $output now contains the uncompressed data -and if you want to compress each file one at a time, this will do the trick +To read from an existing Perl filehandle, C<$input>, and write the +uncompressed data to a buffer, C<$buffer>. use strict ; use warnings ; use IO::Uncompress::Unzip qw(unzip $UnzipError) ; + use IO::File ; - for my $input ( glob "/my/home/*.txt.zip" ) - { - my $output = $input; - $output =~ s/.zip// ; - unzip $input => $output - or die "Error compressing '$input': $UnzipError\n"; - } + my $input = new IO::File "<file1.zip" + or die "Cannot open 'file1.zip': $!\n" ; + my $buffer ; + unzip $input => \$buffer + or die "unzip failed: $UnzipError\n"; =head1 OO Interface @@ -1163,6 +1421,10 @@ OPTS is a combination of the following options: =over 5 +=item C<< Name => "membername" >> + +Open "membername" from the zip file for reading. + =item C<< AutoClose => 0|1 >> This option is only valid when the C<$input> parameter is a filehandle. If @@ -1199,7 +1461,7 @@ the module will allow reading of it anyway. In addition, if the input file/buffer does contain compressed data and there is non-compressed data immediately following it, setting this option -will make this module treat the whole file/bufffer as a single data stream. +will make this module treat the whole file/buffer as a single data stream. This option defaults to 1. @@ -1418,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 @@ -1509,11 +1771,48 @@ Same as doing this See L<IO::Uncompress::Unzip::FAQ|IO::Uncompress::Unzip::FAQ/"Compressed files and Net::FTP"> +=head2 Walking through a zip file + +The code below can be used to traverse a zip file, one compressed data +stream at a time. + + use IO::Uncompress::Unzip qw($UnzipError); + + my $zipfile = "somefile.zip"; + my $u = new IO::Uncompress::Unzip $zipfile + or die "Cannot open $zipfile: $UnzipError"; + + my $status; + for ($status = 1; $stream > 0; $status = $u->nextStream()) + { + + my $name = $u->getHeaderInfo()->{Name}; + warn "Processing member $name\n" ; + + my $buff; + while (($status = $u->read($buff)) > 0) { + # Do something here + } + + last if $status < 0; + } + + die "Error processing $zipfile: $!\n" + if $status < 0 ; + +Each individual compressed data stream is read until the logical +end-of-file is reached. Then C<nextStream> is called. This will skip to the +start of the next compressed data stream and clear the end-of-file flag. + +It is also worth noting that C<nextStream> can be called at any time -- you +don't have to wait until you have exhausted a compressed data stream before +skipping to the next one. + =head1 SEE ALSO L<Compress::Zlib>, L<IO::Compress::Gzip>, L<IO::Uncompress::Gunzip>, L<IO::Compress::Deflate>, L<IO::Uncompress::Inflate>, L<IO::Compress::RawDeflate>, L<IO::Uncompress::RawInflate>, L<IO::Compress::Bzip2>, L<IO::Uncompress::Bunzip2>, L<IO::Compress::Lzma>, L<IO::Uncompress::UnLzma>, L<IO::Compress::Xz>, L<IO::Uncompress::UnXz>, L<IO::Compress::Lzop>, L<IO::Uncompress::UnLzop>, L<IO::Compress::Lzf>, L<IO::Uncompress::UnLzf>, L<IO::Uncompress::AnyInflate>, L<IO::Uncompress::AnyUncompress> -L<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>, @@ -1542,7 +1841,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2010 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. |