summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IO/Compress
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
committerKarl Berry <karl@freefriends.org>2014-04-23 21:46:20 +0000
commit300c1eb6d37d46078d448d6d58938d5a80cd68ff (patch)
tree23a0a8b9f8f5460b405119c4d3c163d2d488ca5e /Master/tlpkg/tlperl/lib/IO/Compress
parented55d86b7c5e18f6eccce80a1fb1423ca40a23b5 (diff)
(tl)perl 5.18.2 for windows from siep
git-svn-id: svn://tug.org/texlive/trunk@33648 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Compress')
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Base.pm130
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm358
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm36
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm110
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm205
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm145
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm391
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm4
14 files changed, 724 insertions, 680 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm
index 452e12ef483..e665ca3cebf 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Bzip2.pm
@@ -4,12 +4,12 @@ use strict;
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.048 qw(:Status);
+use IO::Compress::Base::Common 2.060 qw(:Status);
-use Compress::Raw::Bzip2 2.048 ;
+use Compress::Raw::Bzip2 2.060 ;
our ($VERSION);
-$VERSION = '2.048';
+$VERSION = '2.060';
sub mkCompObject
{
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm
index 4a99c36cf7e..d064a141e73 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Deflate.pm
@@ -4,13 +4,13 @@ use strict;
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.048 qw(:Status);
-use Compress::Raw::Zlib 2.048 qw( !crc32 !adler32 ) ;
+use IO::Compress::Base::Common 2.060 qw(:Status);
+use Compress::Raw::Zlib 2.060 qw( !crc32 !adler32 ) ;
require Exporter;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
-$VERSION = '2.048';
+$VERSION = '2.060';
@ISA = qw(Exporter);
@EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
%EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
@@ -74,8 +74,7 @@ sub flush
return STATUS_ERROR;
}
- return STATUS_OK;
-
+ return STATUS_OK;
}
sub close
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm
index c7a0031a1d4..73d911f68e2 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Adapter/Identity.pm
@@ -4,10 +4,10 @@ use strict;
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.048 qw(:Status);
+use IO::Compress::Base::Common 2.060 qw(:Status);
our ($VERSION);
-$VERSION = '2.048';
+$VERSION = '2.060';
sub mkCompObject
{
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm
index 2137bbb8de2..9b8ef7552a5 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base.pm
@@ -6,21 +6,21 @@ require 5.006 ;
use strict ;
use warnings;
-use IO::Compress::Base::Common 2.048 ;
+use IO::Compress::Base::Common 2.060 ;
-use IO::File qw(SEEK_SET SEEK_END); ;
-use Scalar::Util qw(blessed readonly);
+use IO::File (); ;
+use Scalar::Util ();
#use File::Glob;
#require Exporter ;
use Carp() ;
use Symbol();
-use bytes;
+#use bytes;
our (@ISA, $VERSION);
@ISA = qw(Exporter IO::File);
-$VERSION = '2.048';
+$VERSION = '2.060';
#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.
@@ -92,11 +92,11 @@ sub writeAt
my $here = tell(*$self->{FH});
return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!)
if $here < 0 ;
- seek(*$self->{FH}, $offset, SEEK_SET)
+ seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET)
or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
defined *$self->{FH}->write($data, length $data)
or return $self->saveErrorString(undef, $!, $!) ;
- seek(*$self->{FH}, $here, SEEK_SET)
+ seek(*$self->{FH}, $here, IO::Handle::SEEK_SET)
or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
}
else {
@@ -143,10 +143,21 @@ sub output
sub getOneShotParams
{
- return ( 'MultiStream' => [1, 1, Parse_boolean, 1],
+ return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean, 1],
);
}
+our %PARAMS = (
+ # Generic Parameters
+ 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'encode' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'strict' => [IO::Compress::Base::Common::Parse_boolean, 1],
+ 'append' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'binmodein' => [IO::Compress::Base::Common::Parse_boolean, 0],
+
+ 'filtercontainer' => [IO::Compress::Base::Common::Parse_code, undef],
+ );
+
sub checkParams
{
my $self = shift ;
@@ -156,20 +167,14 @@ sub checkParams
$got->parse(
{
- # Generic Parameters
- 'AutoClose' => [1, 1, Parse_boolean, 0],
- #'Encode' => [1, 1, Parse_any, undef],
- 'Strict' => [0, 1, Parse_boolean, 1],
- 'Append' => [1, 1, Parse_boolean, 0],
- 'BinModeIn' => [1, 1, Parse_boolean, 0],
+ %PARAMS,
- 'FilterContainer' => [1, 1, Parse_code, undef],
$self->getExtraParams(),
*$self->{OneShot} ? $self->getOneShotParams()
: (),
},
- @_) or $self->croakError("${class}: $got->{Error}") ;
+ @_) or $self->croakError("${class}: " . $got->getError()) ;
return $got ;
}
@@ -195,9 +200,9 @@ sub _create
or return undef ;
}
- my $lax = ! $got->value('Strict') ;
+ my $lax = ! $got->getValue('strict') ;
- my $outType = whatIsOutput($outValue);
+ my $outType = IO::Compress::Base::Common::whatIsOutput($outValue);
$obj->ckOutputParam($class, $outValue)
or return undef ;
@@ -211,10 +216,10 @@ sub _create
}
# Merge implies Append
- my $merge = $got->value('Merge') ;
- my $appendOutput = $got->value('Append') || $merge ;
+ my $merge = $got->getValue('merge') ;
+ my $appendOutput = $got->getValue('append') || $merge ;
*$obj->{Append} = $appendOutput;
- *$obj->{FilterContainer} = $got->value('FilterContainer') ;
+ *$obj->{FilterContainer} = $got->getValue('filtercontainer') ;
if ($merge)
{
@@ -229,17 +234,18 @@ sub _create
#if ($outType eq 'filename' && -e $outValue && ! -w _)
# { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) }
-
-
- if ($got->parsed('Encode')) {
- my $want_encoding = $got->value('Encode');
- *$obj->{Encoding} = getEncoding($obj, $class, $want_encoding);
- }
-
$obj->ckParams($got)
or $obj->croakError("${class}: " . $obj->error());
-
+ if ($got->getValue('encode')) {
+ my $want_encoding = $got->getValue('encode');
+ *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding);
+ my $x = *$obj->{Encoding};
+ }
+ else {
+ *$obj->{Encoding} = undef;
+ }
+
$obj->saveStatus(STATUS_OK) ;
my $status ;
@@ -259,11 +265,11 @@ sub _create
if ($outType eq 'handle') {
*$obj->{FH} = $outValue ;
setBinModeOutput(*$obj->{FH}) ;
- $outValue->flush() ;
+ #$outValue->flush() ;
*$obj->{Handle} = 1 ;
if ($appendOutput)
{
- seek(*$obj->{FH}, 0, SEEK_END)
+ seek(*$obj->{FH}, 0, IO::Handle::SEEK_END)
or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ;
}
@@ -292,7 +298,7 @@ sub _create
}
*$obj->{Closed} = 0 ;
- *$obj->{AutoClose} = $got->value('AutoClose') ;
+ *$obj->{AutoClose} = $got->getValue('autoclose') ;
*$obj->{Output} = $outValue;
*$obj->{ClassName} = $class;
*$obj->{Got} = $got;
@@ -305,7 +311,7 @@ sub ckOutputParam
{
my $self = shift ;
my $from = shift ;
- my $outType = whatIsOutput($_[0]);
+ my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]);
$self->croakError("$from: output parameter not a filename, filehandle or scalar ref")
if ! $outType ;
@@ -314,7 +320,7 @@ sub ckOutputParam
#if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ;
$self->croakError("$from: output buffer is read-only")
- if $outType eq 'buffer' && readonly(${ $_[0] });
+ if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] });
return 1;
}
@@ -490,7 +496,7 @@ sub _wr2
$fh = new IO::File "<$input"
or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ;
}
- binmode $fh if *$self->{Got}->valueOrDefault('BinModeIn') ;
+ binmode $fh if *$self->{Got}->valueOrDefault('binmodein') ;
my $status ;
my $buff ;
@@ -523,7 +529,7 @@ sub addInterStream
my $input = shift ;
my $inputIsFilename = shift ;
- if (*$self->{Got}->value('MultiStream'))
+ if (*$self->{Got}->getValue('multistream'))
{
$self->getFileInfo(*$self->{Got}, $input)
#if isaFilename($input) and $inputIsFilename ;
@@ -532,7 +538,7 @@ sub addInterStream
# TODO -- newStream needs to allow gzip/zip header to be modified
return $self->newStream();
}
- elsif (*$self->{Got}->value('AutoFlush'))
+ elsif (*$self->{Got}->getValue('autoflush'))
{
#return $self->flush(Z_FULL_FLUSH);
}
@@ -589,10 +595,6 @@ sub syswrite
$buffer = \$_[0] ;
}
- $] >= 5.008 and ( utf8::downgrade($$buffer, 1)
- or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:");
-
-
if (@_ > 1) {
my $slen = defined $$buffer ? length($$buffer) : 0;
my $len = $slen;
@@ -614,11 +616,23 @@ sub syswrite
$buffer = \substr($$buffer, $offset, $len) ;
}
- return 0 if ! defined $$buffer || length $$buffer == 0 ;
-
- if (*$self->{Encoding}) {
+ return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending};
+
+# *$self->{Pending} .= $$buffer ;
+#
+# return length $$buffer
+# if (length *$self->{Pending} < 1024 * 16 && ! *$self->{FlushPending}) ;
+#
+# $$buffer = *$self->{Pending} ;
+# *$self->{Pending} = '';
+
+ if (*$self->{Encoding}) {
$$buffer = *$self->{Encoding}->encode($$buffer);
}
+ else {
+ $] >= 5.008 and ( utf8::downgrade($$buffer, 1)
+ or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:");
+ }
$self->filterUncompressed($buffer);
@@ -670,9 +684,7 @@ sub printf
defined $self->syswrite(sprintf($fmt, @_));
}
-
-
-sub flush
+sub _flushCompressed
{
my $self = shift ;
@@ -690,6 +702,15 @@ sub flush
$self->outputPayload($outBuffer)
or return 0;
+ return 1;
+}
+
+sub flush
+{
+ my $self = shift ;
+
+ $self->_flushCompressed(@_)
+ or return 0;
if ( defined *$self->{FH} ) {
defined *$self->{FH}->flush()
@@ -708,12 +729,22 @@ sub _newStream
my $self = shift ;
my $got = shift;
+ my $class = ref $self;
+
$self->_writeTrailer()
or return 0 ;
$self->ckParams($got)
or $self->croakError("newStream: $self->{Error}");
+ if ($got->getValue('encode')) {
+ my $want_encoding = $got->getValue('encode');
+ *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding);
+ }
+ else {
+ *$self->{Encoding} = undef;
+ }
+
*$self->{Compress} = $self->mkComp($got)
or return 0;
@@ -788,13 +819,13 @@ sub _writeFinalTrailer
sub close
{
my $self = shift ;
-
return 1 if *$self->{Closed} || ! *$self->{Compress} ;
*$self->{Closed} = 1 ;
untie *$self
if $] >= 5.008 ;
+ *$self->{FlushPending} = 1 ;
$self->_writeTrailer()
or return 0 ;
@@ -806,7 +837,6 @@ sub close
if (defined *$self->{FH}) {
- #if (! *$self->{Handle} || *$self->{AutoClose}) {
if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
$! = 0 ;
*$self->{FH}->close()
@@ -1011,7 +1041,7 @@ See the Changes file.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2012 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2013 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
index c6c38181ef8..cce097dd6dc 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
@@ -11,7 +11,7 @@ use File::GlobMapper;
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.048';
+$VERSION = '2.060';
@EXPORT = qw( isaFilehandle isaFilename isaScalar
whatIsInput whatIsOutput
@@ -19,8 +19,7 @@ $VERSION = '2.048';
setBinModeInput setBinModeOutput
ckInOutParams
createSelfTiedObject
- getEncoding
-
+
isGeMax32
MAX32
@@ -106,7 +105,7 @@ sub setBinModeOutput($)
{
my $handle = shift ;
- binmode $handle
+ binmode $handle
if $needBinmode;
}
@@ -377,10 +376,10 @@ sub IO::Compress::Base::Validator::validateInputFilenames
return $self->saveErrorString("input file '$filename' is a directory");
}
- if (! -r _ )
- {
- return $self->saveErrorString("cannot open file '$filename': $!");
- }
+# if (! -r _ )
+# {
+# return $self->saveErrorString("cannot open file '$filename': $!");
+# }
}
return 1 ;
@@ -472,7 +471,7 @@ $EXPORT_TAGS{Parse} = [qw( ParseParameters
Parse_any Parse_unsigned Parse_signed
Parse_boolean Parse_string
Parse_code
- Parse_multiple Parse_writable_scalar
+ Parse_writable_scalar
)
];
@@ -486,7 +485,7 @@ use constant Parse_string => 0x10;
use constant Parse_code => 0x20;
#use constant Parse_store_ref => 0x100 ;
-use constant Parse_multiple => 0x100 ;
+#use constant Parse_multiple => 0x100 ;
use constant Parse_writable => 0x200 ;
use constant Parse_writable_scalar => 0x400 | Parse_writable ;
@@ -494,10 +493,11 @@ use constant OFF_PARSED => 0 ;
use constant OFF_TYPE => 1 ;
use constant OFF_DEFAULT => 2 ;
use constant OFF_FIXED => 3 ;
-use constant OFF_FIRST_ONLY => 4 ;
-use constant OFF_STICKY => 5 ;
-
+#use constant OFF_FIRST_ONLY => 4 ;
+#use constant OFF_STICKY => 5 ;
+use constant IxError => 0;
+use constant IxGot => 1 ;
sub ParseParameters
{
@@ -511,27 +511,60 @@ sub ParseParameters
my $p = new IO::Compress::Base::Parameters() ;
$p->parse(@_)
- or croak "$sub: $p->{Error}" ;
+ or croak "$sub: $p->[IxError]" ;
return $p;
}
-#package IO::Compress::Base::Parameters;
use strict;
use warnings;
use Carp;
+
+sub Init
+{
+ my $default = shift ;
+ my %got ;
+
+ my $obj = IO::Compress::Base::Parameters::new();
+ while (my ($key, $v) = each %$default)
+ {
+ croak "need 2 params [@$v]"
+ if @$v != 2 ;
+
+ my ($type, $value) = @$v ;
+# my ($first_only, $sticky, $type, $value) = @$v ;
+ my $sticky = 0;
+ my $x ;
+ $obj->_checkType($key, \$value, $type, 0, \$x)
+ or return undef ;
+
+ $key = lc $key;
+
+# if (! $sticky) {
+# $x = []
+# if $type & Parse_multiple;
+
+# $got{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
+ $got{$key} = [0, $type, $value, $x] ;
+# }
+#
+# $got{$key}[OFF_PARSED] = 0 ;
+ }
+
+ return bless \%got, "IO::Compress::Base::Parameters::Defaults" ;
+}
+
sub IO::Compress::Base::Parameters::new
{
- my $class = shift ;
+ #my $class = shift ;
- my $obj = { Error => '',
- Got => {},
- } ;
+ my $obj;
+ $obj->[IxError] = '';
+ $obj->[IxGot] = {} ;
- #return bless $obj, ref($class) || $class || __PACKAGE__ ;
return bless $obj, 'IO::Compress::Base::Parameters' ;
}
@@ -541,25 +574,24 @@ sub IO::Compress::Base::Parameters::setError
my $error = shift ;
my $retval = @_ ? shift : undef ;
- $self->{Error} = $error ;
+
+ $self->[IxError] = $error ;
return $retval;
}
-#sub getError
-#{
-# my $self = shift ;
-# return $self->{Error} ;
-#}
+sub IO::Compress::Base::Parameters::getError
+{
+ my $self = shift ;
+ return $self->[IxError] ;
+}
sub IO::Compress::Base::Parameters::parse
{
my $self = shift ;
-
my $default = shift ;
- my $got = $self->{Got} ;
+ my $got = $self->[IxGot] ;
my $firstTime = keys %{ $got } == 0 ;
- my $other;
my (@Bad) ;
my @entered = () ;
@@ -581,63 +613,35 @@ sub IO::Compress::Base::Parameters::parse
}
}
else {
+
my $count = @_;
return $self->setError("Expected even number of parameters, got $count")
if $count % 2 != 0 ;
for my $i (0.. $count / 2 - 1) {
- if ($_[2 * $i] eq '__xxx__') {
- $other = $_[2 * $i + 1] ;
- }
- else {
- push @entered, $_[2 * $i] ;
- push @entered, \$_[2 * $i + 1] ;
- }
+ push @entered, $_[2 * $i] ;
+ push @entered, \$_[2 * $i + 1] ;
}
}
-
- while (my ($key, $v) = each %$default)
- {
- croak "need 4 params [@$v]"
- if @$v != 4 ;
-
- my ($first_only, $sticky, $type, $value) = @$v ;
- my $x ;
- $self->_checkType($key, \$value, $type, 0, \$x)
- or return undef ;
-
- $key = lc $key;
-
- if ($firstTime || ! $sticky) {
- $x = []
- if $type & Parse_multiple;
-
- $got->{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
+ foreach my $key (keys %$default)
+ {
+
+ my ($type, $value) = @{ $default->{$key} } ;
+
+ if ($firstTime) {
+ $got->{$key} = [0, $type, $value, $value] ;
+ }
+ else
+ {
+ $got->{$key}[OFF_PARSED] = 0 ;
+ }
}
- $got->{$key}[OFF_PARSED] = 0 ;
- }
my %parsed = ();
- if ($other)
- {
- for my $key (keys %$default)
- {
- my $canonkey = lc $key;
- if ($other->parsed($canonkey))
- {
- my $value = $other->value($canonkey);
-#print "SET '$canonkey' to $value [$$value]\n";
- ++ $parsed{$canonkey};
- $got->{$canonkey}[OFF_PARSED] = 1;
- $got->{$canonkey}[OFF_DEFAULT] = $value;
- $got->{$canonkey}[OFF_FIXED] = $value;
- }
- }
- }
-
+
for my $i (0.. @entered / 2 - 1) {
my $key = $entered[2* $i] ;
my $value = $entered[2* $i+1] ;
@@ -648,28 +652,22 @@ sub IO::Compress::Base::Parameters::parse
$key =~ s/^-// ;
my $canonkey = lc $key;
- if ($got->{$canonkey} && ($firstTime ||
- ! $got->{$canonkey}[OFF_FIRST_ONLY] ))
+ if ($got->{$canonkey})
{
my $type = $got->{$canonkey}[OFF_TYPE] ;
my $parsed = $parsed{$canonkey};
++ $parsed{$canonkey};
return $self->setError("Muliple instances of '$key' found")
- if $parsed && ($type & Parse_multiple) == 0 ;
+ if $parsed ;
my $s ;
$self->_checkType($key, $value, $type, 1, \$s)
or return undef ;
$value = $$value ;
- if ($type & Parse_multiple) {
- $got->{$canonkey}[OFF_PARSED] = 1;
- push @{ $got->{$canonkey}[OFF_FIXED] }, $s ;
- }
- else {
- $got->{$canonkey} = [1, $type, $value, $s] ;
- }
+ $got->{$canonkey} = [1, $type, $value, $s] ;
+
}
else
{ push (@Bad, $key) }
@@ -699,19 +697,19 @@ sub IO::Compress::Base::Parameters::_checkType
if ($type & Parse_writable_scalar)
{
return $self->setError("Parameter '$key' not writable")
- if $validate && readonly $$value ;
+ if readonly $$value ;
if (ref $$value)
{
return $self->setError("Parameter '$key' not a scalar reference")
- if $validate && ref $$value ne 'SCALAR' ;
+ if ref $$value ne 'SCALAR' ;
$$output = $$value ;
}
else
{
return $self->setError("Parameter '$key' not a scalar")
- if $validate && ref $value ne 'SCALAR' ;
+ if ref $value ne 'SCALAR' ;
$$output = $value ;
}
@@ -719,14 +717,6 @@ sub IO::Compress::Base::Parameters::_checkType
return 1;
}
-# if ($type & Parse_store_ref)
-# {
-# #$value = $$value
-# # if ref ${ $value } ;
-#
-# $$output = $value ;
-# return 1;
-# }
$value = $$value ;
@@ -737,20 +727,21 @@ sub IO::Compress::Base::Parameters::_checkType
}
elsif ($type & Parse_unsigned)
{
+
return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
- if $validate && ! defined $value ;
+ if ! defined $value ;
return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
- if $validate && $value !~ /^\d+$/;
-
+ if $value !~ /^\d+$/;
+
$$output = defined $value ? $value : 0 ;
return 1;
}
elsif ($type & Parse_signed)
{
return $self->setError("Parameter '$key' must be a signed int, got 'undef'")
- if $validate && ! defined $value ;
+ if ! defined $value ;
return $self->setError("Parameter '$key' must be a signed int, got '$value'")
- if $validate && $value !~ /^-?\d+$/;
+ if $value !~ /^-?\d+$/;
$$output = defined $value ? $value : 0 ;
return 1 ;
@@ -758,50 +749,50 @@ sub IO::Compress::Base::Parameters::_checkType
elsif ($type & Parse_boolean)
{
return $self->setError("Parameter '$key' must be an int, got '$value'")
- if $validate && defined $value && $value !~ /^\d*$/;
- $$output = defined $value ? $value != 0 : 0 ;
+ if defined $value && $value !~ /^\d*$/;
+
+ $$output = defined $value && $value != 0 ? 1 : 0 ;
return 1;
}
- elsif ($type & Parse_code)
+
+ elsif ($type & Parse_string)
{
- 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)
+ elsif ($type & Parse_code)
{
+ return $self->setError("Parameter '$key' must be a code reference, got '$value'")
+ if (! defined $value || ref $value ne 'CODE') ;
+
$$output = defined $value ? $value : "" ;
return 1;
}
-
+
$$output = $value ;
return 1;
}
-
-
sub IO::Compress::Base::Parameters::parsed
{
- my $self = shift ;
- my $name = shift ;
-
- return $self->{Got}{lc $name}[OFF_PARSED] ;
+ return $_[0]->[IxGot]{$_[1]}[OFF_PARSED] ;
}
-sub IO::Compress::Base::Parameters::value
-{
- my $self = shift ;
- my $name = shift ;
- if (@_)
- {
- $self->{Got}{lc $name}[OFF_PARSED] = 1;
- $self->{Got}{lc $name}[OFF_DEFAULT] = $_[0] ;
- $self->{Got}{lc $name}[OFF_FIXED] = $_[0] ;
- }
+sub IO::Compress::Base::Parameters::getValue
+{
+ return $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ;
+}
+sub IO::Compress::Base::Parameters::setValue
+{
+ $_[0]->[IxGot]{$_[1]}[OFF_PARSED] = 1;
+ $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] = $_[2] ;
+ $_[0]->[IxGot]{$_[1]}[OFF_FIXED] = $_[2] ;
+}
- return $self->{Got}{lc $name}[OFF_FIXED] ;
+sub IO::Compress::Base::Parameters::valueRef
+{
+ return $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ;
}
sub IO::Compress::Base::Parameters::valueOrDefault
@@ -810,33 +801,31 @@ sub IO::Compress::Base::Parameters::valueOrDefault
my $name = shift ;
my $default = shift ;
- my $value = $self->{Got}{lc $name}[OFF_DEFAULT] ;
-
+ my $value = $self->[IxGot]{$name}[OFF_DEFAULT] ;
+
return $value if defined $value ;
return $default ;
}
sub IO::Compress::Base::Parameters::wantValue
{
- my $self = shift ;
- my $name = shift ;
-
- return defined $self->{Got}{lc $name}[OFF_DEFAULT] ;
-
+ return defined $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] ;
}
sub IO::Compress::Base::Parameters::clone
{
my $self = shift ;
- my $obj = { };
+ my $obj = [] ;
my %got ;
- while (my ($k, $v) = each %{ $self->{Got} }) {
- $got{$k} = [ @$v ];
+ my $hash = $self->[IxGot] ;
+ for my $k (keys %{ $hash })
+ {
+ $got{$k} = [ @{ $hash->{$k} } ];
}
- $obj->{Error} = $self->{Error};
- $obj->{Got} = \%got ;
+ $obj->[IxError] = $self->[IxError];
+ $obj->[IxGot] = \%got ;
return bless $obj, 'IO::Compress::Base::Parameters' ;
}
@@ -850,27 +839,19 @@ use constant HIGH => 1;
sub new
{
- my $class = shift ;
-
- my $high = 0 ;
- my $low = 0 ;
-
- if (@_ == 2) {
- $high = shift ;
- $low = shift ;
- }
- elsif (@_ == 1) {
- $low = shift ;
- }
-
- bless [$low, $high], $class;
+ return bless [ 0, 0 ], $_[0]
+ if @_ == 1 ;
+
+ return bless [ $_[1], 0 ], $_[0]
+ if @_ == 2 ;
+
+ return bless [ $_[2], $_[1] ], $_[0]
+ if @_ == 3 ;
}
sub newUnpack_V64
{
- my $string = shift;
-
- my ($low, $hi) = unpack "V V", $string ;
+ my ($low, $hi) = unpack "V V", $_[0] ;
bless [ $low, $hi ], "U64";
}
@@ -884,64 +865,79 @@ sub newUnpack_V32
sub reset
{
- my $self = shift;
- $self->[HIGH] = $self->[LOW] = 0;
+ $_[0]->[HIGH] = $_[0]->[LOW] = 0;
}
sub clone
{
- my $self = shift;
- bless [ @$self ], ref $self ;
+ bless [ @{$_[0]} ], ref $_[0] ;
}
sub getHigh
{
- my $self = shift;
- return $self->[HIGH];
+ return $_[0]->[HIGH];
}
sub getLow
{
- my $self = shift;
- return $self->[LOW];
+ return $_[0]->[LOW];
}
sub get32bit
{
- my $self = shift;
- return $self->[LOW];
+ return $_[0]->[LOW];
}
sub get64bit
{
- my $self = shift;
# Not using << here because the result will still be
# a 32-bit value on systems where int size is 32-bits
- return $self->[HIGH] * HI_1 + $self->[LOW];
+ return $_[0]->[HIGH] * HI_1 + $_[0]->[LOW];
}
sub add
{
- my $self = shift;
- my $value = shift;
+# my $self = shift;
+ my $value = $_[1];
if (ref $value eq 'U64') {
- $self->[HIGH] += $value->[HIGH] ;
+ $_[0]->[HIGH] += $value->[HIGH] ;
$value = $value->[LOW];
}
elsif ($value > MAX32) {
- $self->[HIGH] += int($value / HI_1) ;
+ $_[0]->[HIGH] += int($value / HI_1) ;
+ $value = $value % HI_1;
+ }
+
+ my $available = MAX32 - $_[0]->[LOW] ;
+
+ if ($value > $available) {
+ ++ $_[0]->[HIGH] ;
+ $_[0]->[LOW] = $value - $available - 1;
+ }
+ else {
+ $_[0]->[LOW] += $value ;
+ }
+}
+
+sub add32
+{
+# my $self = shift;
+ my $value = $_[1];
+
+ if ($value > MAX32) {
+ $_[0]->[HIGH] += int($value / HI_1) ;
$value = $value % HI_1;
}
- my $available = MAX32 - $self->[LOW] ;
+ my $available = MAX32 - $_[0]->[LOW] ;
if ($value > $available) {
- ++ $self->[HIGH] ;
- $self->[LOW] = $value - $available - 1;
+ ++ $_[0]->[HIGH] ;
+ $_[0]->[LOW] = $value - $available - 1;
}
else {
- $self->[LOW] += $value ;
+ $_[0]->[LOW] += $value ;
}
}
@@ -1005,35 +1001,27 @@ sub cmp
sub is64bit
{
- my $self = shift;
- return $self->[HIGH] > 0 ;
+ return $_[0]->[HIGH] > 0 ;
}
sub isAlmost64bit
{
- my $self = shift;
- return $self->[HIGH] > 0 || $self->[LOW] == MAX32 ;
+ return $_[0]->[HIGH] > 0 || $_[0]->[LOW] == MAX32 ;
}
sub getPacked_V64
{
- my $self = shift;
-
- return pack "V V", @$self ;
+ return pack "V V", @{ $_[0] } ;
}
sub getPacked_V32
{
- my $self = shift;
-
- return pack "V", $self->[LOW] ;
+ return pack "V", $_[0]->[LOW] ;
}
sub pack_V64
{
- my $low = shift;
-
- return pack "V V", $low, 0;
+ return pack "V V", $_[0], 0;
}
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm
index dd9016bf834..7c5dc793e71 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Bzip2.pm
@@ -5,16 +5,16 @@ use warnings;
use bytes;
require Exporter ;
-use IO::Compress::Base 2.048 ;
+use IO::Compress::Base 2.060 ;
-use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject);
-use IO::Compress::Adapter::Bzip2 2.048 ;
+use IO::Compress::Base::Common 2.060 qw();
+use IO::Compress::Adapter::Bzip2 2.060 ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
-$VERSION = '2.048';
+$VERSION = '2.060';
$Bzip2Error = '';
@ISA = qw(Exporter IO::Compress::Base);
@@ -29,13 +29,13 @@ sub new
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$Bzip2Error);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bzip2Error);
return $obj->_create(undef, @_);
}
sub bzip2
{
- my $obj = createSelfTiedObject(undef, \$Bzip2Error);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bzip2Error);
$obj->_def(@_);
}
@@ -51,12 +51,12 @@ sub getExtraParams
{
my $self = shift ;
- use IO::Compress::Base::Common 2.048 qw(:Parse);
+ use IO::Compress::Base::Common 2.060 qw(:Parse);
- return (
- 'BlockSize100K' => [0, 1, Parse_unsigned, 1],
- 'WorkFactor' => [0, 1, Parse_unsigned, 0],
- 'Verbosity' => [0, 1, Parse_boolean, 0],
+ return (
+ 'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned, 1],
+ 'workfactor' => [IO::Compress::Base::Common::Parse_unsigned, 0],
+ 'verbosity' => [IO::Compress::Base::Common::Parse_boolean, 0],
);
}
@@ -68,16 +68,16 @@ sub ckParams
my $got = shift;
# check that BlockSize100K is a number between 1 & 9
- if ($got->parsed('BlockSize100K')) {
- my $value = $got->value('BlockSize100K');
+ if ($got->parsed('blocksize100k')) {
+ my $value = $got->getValue('blocksize100k');
return $self->saveErrorString(undef, "Parameter 'BlockSize100K' not between 1 and 9, got $value")
unless defined $value && $value >= 1 && $value <= 9;
}
# check that WorkFactor between 0 & 250
- if ($got->parsed('WorkFactor')) {
- my $value = $got->value('WorkFactor');
+ if ($got->parsed('workfactor')) {
+ my $value = $got->getValue('workfactor');
return $self->saveErrorString(undef, "Parameter 'WorkFactor' not between 0 and 250, got $value")
unless $value >= 0 && $value <= 250;
}
@@ -91,9 +91,9 @@ sub mkComp
my $self = shift ;
my $got = shift ;
- my $BlockSize100K = $got->value('BlockSize100K');
- my $WorkFactor = $got->value('WorkFactor');
- my $Verbosity = $got->value('Verbosity');
+ my $BlockSize100K = $got->getValue('blocksize100k');
+ my $WorkFactor = $got->getValue('workfactor');
+ my $Verbosity = $got->getValue('verbosity');
my ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
$BlockSize100K, $WorkFactor,
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm
index daa7d7aa258..d6158deb5bf 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Deflate.pm
@@ -8,16 +8,16 @@ use bytes;
require Exporter ;
-use IO::Compress::RawDeflate 2.048 ();
-use IO::Compress::Adapter::Deflate 2.048 ;
+use IO::Compress::RawDeflate 2.060 ();
+use IO::Compress::Adapter::Deflate 2.060 ;
-use IO::Compress::Zlib::Constants 2.048 ;
-use IO::Compress::Base::Common 2.048 qw(createSelfTiedObject);
+use IO::Compress::Zlib::Constants 2.060 ;
+use IO::Compress::Base::Common 2.060 qw();
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError);
-$VERSION = '2.048';
+$VERSION = '2.060';
$DeflateError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
@@ -32,13 +32,13 @@ sub new
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$DeflateError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$DeflateError);
return $obj->_create(undef, @_);
}
sub deflate
{
- my $obj = createSelfTiedObject(undef, \$DeflateError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$DeflateError);
return $obj->_def(@_);
}
@@ -85,8 +85,8 @@ sub mkHeader
my $self = shift ;
my $param = shift ;
- my $level = $param->value('Level');
- my $strategy = $param->value('Strategy');
+ my $level = $param->getValue('level');
+ my $strategy = $param->getValue('strategy');
my $lflag ;
$level = 6
@@ -119,7 +119,7 @@ sub ckParams
my $self = shift ;
my $got = shift;
- $got->value('ADLER32' => 1);
+ $got->setValue('adler32' => 1);
return 1 ;
}
@@ -233,19 +233,20 @@ section.
use IO::Compress::Deflate qw(deflate $DeflateError) ;
- deflate $input => $output [,OPTS]
+ deflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
or die "deflate failed: $DeflateError\n";
The functional interface needs Perl5.005 or better.
=head2 deflate $input => $output [, OPTS]
-C<deflate> expects at least two parameters, C<$input> and C<$output>.
+C<deflate> expects at least two parameters,
+C<$input_filename_or_reference> and C<$output_filename_or_reference>.
-=head3 The C<$input> parameter
+=head3 The C<$input_filename_or_reference> parameter
-The parameter, C<$input>, is used to define the source of
-the uncompressed data.
+The parameter, C<$input_filename_or_reference>, is used to define the
+source of the uncompressed data.
It can take one of the following forms:
@@ -253,25 +254,25 @@ It can take one of the following forms:
=item A filename
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
+If the <$input_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for reading and the
+input data will be read from it.
=item A filehandle
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
+If the C<$input_filename_or_reference> parameter is a filehandle, the input
+data will be read from it. The string '-' can be used as an alias for
+standard input.
=item A scalar reference
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
+If C<$input_filename_or_reference> is a scalar reference, the input data
+will be read from C<$$input_filename_or_reference>.
=item An array reference
-If C<$input> is an array reference, each element in the array must be a
-filename.
+If C<$input_filename_or_reference> is an array reference, each element in
+the array must be a filename.
The input data will be read from each file in turn.
@@ -280,65 +281,72 @@ contains valid filenames before any data is compressed.
=item An Input FileGlob string
-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 C<$input_filename_or_reference> 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.
See L<File::GlobMapper|File::GlobMapper> for more details.
=back
-If the C<$input> parameter is any other type, C<undef> will be returned.
+If the C<$input_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
-=head3 The C<$output> parameter
+=head3 The C<$output_filename_or_reference> parameter
-The parameter C<$output> is used to control the destination of the
-compressed data. This parameter can take one of these forms.
+The parameter C<$output_filename_or_reference> is used to control the
+destination of the compressed data. This parameter can take one of
+these forms.
=over 5
=item A filename
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed
-data will be written to it.
+If the C<$output_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for writing and the
+compressed data will be written to it.
=item A filehandle
-If the C<$output> parameter is a filehandle, the compressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
+If the C<$output_filename_or_reference> parameter is a filehandle, the
+compressed data will be written to it. The string '-' can be used as
+an alias for standard output.
=item A scalar reference
-If C<$output> is a scalar reference, the compressed data will be
-stored in C<$$output>.
+If C<$output_filename_or_reference> is a scalar reference, the
+compressed data will be stored in C<$$output_filename_or_reference>.
=item An Array Reference
-If C<$output> is an array reference, the compressed data will be
-pushed onto the array.
+If C<$output_filename_or_reference> is an array reference,
+the compressed data will be pushed onto the array.
=item An Output FileGlob
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<deflate> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
+If C<$output_filename_or_reference> is a string that is delimited by the
+characters "<" and ">" C<deflate> will assume that it is an
+I<output fileglob string>. The 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.
+When C<$output_filename_or_reference> is an fileglob string,
+C<$input_filename_or_reference> 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.
+If the C<$output_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
=head2 Notes
-When C<$input> maps to multiple files/buffers and C<$output> is a single
+When C<$input_filename_or_reference> maps to multiple files/buffers and
+C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
-in C<$output> as a concatenated series of compressed data streams.
+in C<$output_filename_or_reference> as a concatenated series of compressed data streams.
=head2 Optional Parameters
@@ -924,7 +932,7 @@ See the Changes file.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2012 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2013 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm
index 6530c2532de..21141530e7c 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip.pm
@@ -8,12 +8,12 @@ use bytes;
require Exporter ;
-use IO::Compress::RawDeflate 2.048 () ;
-use IO::Compress::Adapter::Deflate 2.048 ;
+use IO::Compress::RawDeflate 2.060 () ;
+use IO::Compress::Adapter::Deflate 2.060 ;
-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 ;
+use IO::Compress::Base::Common 2.060 qw(:Status );
+use IO::Compress::Gzip::Constants 2.060 ;
+use IO::Compress::Zlib::Extra 2.060 ;
BEGIN
{
@@ -25,7 +25,7 @@ BEGIN
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
-$VERSION = '2.048';
+$VERSION = '2.060';
$GzipError = '' ;
@ISA = qw(Exporter IO::Compress::RawDeflate);
@@ -39,7 +39,7 @@ sub new
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$GzipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError);
$obj->_create(undef, @_);
}
@@ -47,7 +47,7 @@ sub new
sub gzip
{
- my $obj = createSelfTiedObject(undef, \$GzipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError);
return $obj->_def(@_);
}
@@ -65,17 +65,17 @@ sub getExtraParams
return (
# zlib behaviour
$self->getZlibParams(),
-
+
# Gzip header fields
- 'Minimal' => [0, 1, Parse_boolean, 0],
- 'Comment' => [0, 1, Parse_any, undef],
- 'Name' => [0, 1, Parse_any, undef],
- 'Time' => [0, 1, Parse_any, undef],
- 'TextFlag' => [0, 1, Parse_boolean, 0],
- 'HeaderCRC' => [0, 1, Parse_boolean, 0],
- 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
- 'ExtraField'=> [0, 1, Parse_any, undef],
- 'ExtraFlags'=> [0, 1, Parse_any, undef],
+ 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'comment' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'name' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'time' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'headercrc' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
+ 'extrafield'=> [IO::Compress::Base::Common::Parse_any, undef],
+ 'extraflags'=> [IO::Compress::Base::Common::Parse_any, undef],
);
}
@@ -87,24 +87,24 @@ sub ckParams
my $got = shift ;
# gzip always needs crc32
- $got->value('CRC32' => 1);
+ $got->setValue('crc32' => 1);
return 1
- if $got->value('Merge') ;
+ if $got->getValue('merge') ;
- my $strict = $got->value('Strict') ;
+ my $strict = $got->getValue('strict') ;
{
- if (! $got->parsed('Time') ) {
+ if (! $got->parsed('time') ) {
# Modification time defaults to now.
- $got->value('Time' => time) ;
+ $got->setValue(time => time) ;
}
# Check that the Name & Comment don't have embedded NULLs
# Also check that they only contain ISO 8859-1 chars.
- if ($got->parsed('Name') && defined $got->value('Name')) {
- my $name = $got->value('Name');
+ if ($got->parsed('name') && defined $got->getValue('name')) {
+ my $name = $got->getValue('name');
return $self->saveErrorString(undef, "Null Character found in Name",
Z_DATA_ERROR)
@@ -115,8 +115,8 @@ sub ckParams
if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ;
}
- if ($got->parsed('Comment') && defined $got->value('Comment')) {
- my $comment = $got->value('Comment');
+ if ($got->parsed('comment') && defined $got->getValue('comment')) {
+ my $comment = $got->getValue('comment');
return $self->saveErrorString(undef, "Null Character found in Comment",
Z_DATA_ERROR)
@@ -127,8 +127,8 @@ sub ckParams
if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o;
}
- if ($got->parsed('OS_Code') ) {
- my $value = $got->value('OS_Code');
+ if ($got->parsed('os_code') ) {
+ my $value = $got->getValue('os_code');
return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'")
if $value < 0 || $value > 255 ;
@@ -136,22 +136,22 @@ sub ckParams
}
# gzip only supports Deflate at present
- $got->value('Method' => Z_DEFLATED) ;
+ $got->setValue('method' => Z_DEFLATED) ;
- if ( ! $got->parsed('ExtraFlags')) {
- $got->value('ExtraFlags' => 2)
- if $got->value('Level') == Z_BEST_COMPRESSION ;
- $got->value('ExtraFlags' => 4)
- if $got->value('Level') == Z_BEST_SPEED ;
+ if ( ! $got->parsed('extraflags')) {
+ $got->setValue('extraflags' => 2)
+ if $got->getValue('level') == Z_BEST_COMPRESSION ;
+ $got->setValue('extraflags' => 4)
+ if $got->getValue('level') == Z_BEST_SPEED ;
}
- my $data = $got->value('ExtraField') ;
+ my $data = $got->getValue('extrafield') ;
if (defined $data) {
my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ;
return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR)
if $bad ;
- $got->value('ExtraField', $data) ;
+ $got->setValue('extrafield' => $data) ;
}
}
@@ -177,15 +177,15 @@ sub getFileInfo
my $params = shift;
my $filename = shift ;
- return if isaScalar($filename);
+ return if IO::Compress::Base::Common::isaScalar($filename);
my $defaultTime = (stat($filename))[9] ;
- $params->value('Name' => $filename)
- if ! $params->parsed('Name') ;
+ $params->setValue('name' => $filename)
+ if ! $params->parsed('name') ;
- $params->value('Time' => $defaultTime)
- if ! $params->parsed('Time') ;
+ $params->setValue('time' => $defaultTime)
+ if ! $params->parsed('time') ;
}
@@ -195,27 +195,27 @@ sub mkHeader
my $param = shift ;
# stort-circuit if a minimal header is requested.
- return GZIP_MINIMUM_HEADER if $param->value('Minimal') ;
+ return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ;
# METHOD
- my $method = $param->valueOrDefault('Method', GZIP_CM_DEFLATED) ;
+ my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ;
# FLAGS
my $flags = GZIP_FLG_DEFAULT ;
- $flags |= GZIP_FLG_FTEXT if $param->value('TextFlag') ;
- $flags |= GZIP_FLG_FHCRC if $param->value('HeaderCRC') ;
- $flags |= GZIP_FLG_FEXTRA if $param->wantValue('ExtraField') ;
- $flags |= GZIP_FLG_FNAME if $param->wantValue('Name') ;
- $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('Comment') ;
+ $flags |= GZIP_FLG_FTEXT if $param->getValue('textflag') ;
+ $flags |= GZIP_FLG_FHCRC if $param->getValue('headercrc') ;
+ $flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ;
+ $flags |= GZIP_FLG_FNAME if $param->wantValue('name') ;
+ $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ;
# MTIME
- my $time = $param->valueOrDefault('Time', GZIP_MTIME_DEFAULT) ;
+ my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ;
# EXTRA FLAGS
- my $extra_flags = $param->valueOrDefault('ExtraFlags', GZIP_XFL_DEFAULT);
+ my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT);
# OS CODE
- my $os_code = $param->valueOrDefault('OS_Code', GZIP_OS_DEFAULT) ;
+ my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ;
my $out = pack("C4 V C C",
@@ -230,13 +230,13 @@ sub mkHeader
# EXTRA
if ($flags & GZIP_FLG_FEXTRA) {
- my $extra = $param->value('ExtraField') ;
+ my $extra = $param->getValue('extrafield') ;
$out .= pack("v", length $extra) . $extra ;
}
# NAME
if ($flags & GZIP_FLG_FNAME) {
- my $name .= $param->value('Name') ;
+ my $name .= $param->getValue('name') ;
$name =~ s/\x00.*$//;
$out .= $name ;
# Terminate the filename with NULL unless it already is
@@ -247,7 +247,7 @@ sub mkHeader
# COMMENT
if ($flags & GZIP_FLG_FCOMMENT) {
- my $comment .= $param->value('Comment') ;
+ my $comment .= $param->getValue('comment') ;
$comment =~ s/\x00.*$//;
$out .= $comment ;
# Terminate the comment with NULL unless it already is
@@ -257,7 +257,7 @@ sub mkHeader
}
# HEADER CRC
- $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->value('HeaderCRC') ;
+ $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->getValue('headercrc') ;
noUTF8($out);
@@ -342,19 +342,20 @@ section.
use IO::Compress::Gzip qw(gzip $GzipError) ;
- gzip $input => $output [,OPTS]
+ gzip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
or die "gzip failed: $GzipError\n";
The functional interface needs Perl5.005 or better.
=head2 gzip $input => $output [, OPTS]
-C<gzip> expects at least two parameters, C<$input> and C<$output>.
+C<gzip> expects at least two parameters,
+C<$input_filename_or_reference> and C<$output_filename_or_reference>.
-=head3 The C<$input> parameter
+=head3 The C<$input_filename_or_reference> parameter
-The parameter, C<$input>, is used to define the source of
-the uncompressed data.
+The parameter, C<$input_filename_or_reference>, is used to define the
+source of the uncompressed data.
It can take one of the following forms:
@@ -362,25 +363,25 @@ It can take one of the following forms:
=item A filename
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
+If the <$input_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for reading and the
+input data will be read from it.
=item A filehandle
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
+If the C<$input_filename_or_reference> parameter is a filehandle, the input
+data will be read from it. The string '-' can be used as an alias for
+standard input.
=item A scalar reference
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
+If C<$input_filename_or_reference> is a scalar reference, the input data
+will be read from C<$$input_filename_or_reference>.
=item An array reference
-If C<$input> is an array reference, each element in the array must be a
-filename.
+If C<$input_filename_or_reference> is an array reference, each element in
+the array must be a filename.
The input data will be read from each file in turn.
@@ -389,72 +390,80 @@ contains valid filenames before any data is compressed.
=item An Input FileGlob string
-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 C<$input_filename_or_reference> 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.
See L<File::GlobMapper|File::GlobMapper> for more details.
=back
-If the C<$input> parameter is any other type, C<undef> will be returned.
+If the C<$input_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
-In addition, if C<$input> is a simple filename, the default values for
+In addition, if C<$input_filename_or_reference> is a simple filename,
+the default values for
the C<Name> and C<Time> 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> and C<Time> options or by setting the
C<Minimal> parameter.
-=head3 The C<$output> parameter
+=head3 The C<$output_filename_or_reference> parameter
-The parameter C<$output> is used to control the destination of the
-compressed data. This parameter can take one of these forms.
+The parameter C<$output_filename_or_reference> is used to control the
+destination of the compressed data. This parameter can take one of
+these forms.
=over 5
=item A filename
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed
-data will be written to it.
+If the C<$output_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for writing and the
+compressed data will be written to it.
=item A filehandle
-If the C<$output> parameter is a filehandle, the compressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
+If the C<$output_filename_or_reference> parameter is a filehandle, the
+compressed data will be written to it. The string '-' can be used as
+an alias for standard output.
=item A scalar reference
-If C<$output> is a scalar reference, the compressed data will be
-stored in C<$$output>.
+If C<$output_filename_or_reference> is a scalar reference, the
+compressed data will be stored in C<$$output_filename_or_reference>.
=item An Array Reference
-If C<$output> is an array reference, the compressed data will be
-pushed onto the array.
+If C<$output_filename_or_reference> is an array reference,
+the compressed data will be pushed onto the array.
=item An Output FileGlob
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<gzip> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
+If C<$output_filename_or_reference> is a string that is delimited by the
+characters "<" and ">" C<gzip> will assume that it is an
+I<output fileglob string>. The 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.
+When C<$output_filename_or_reference> is an fileglob string,
+C<$input_filename_or_reference> 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.
+If the C<$output_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
=head2 Notes
-When C<$input> maps to multiple files/buffers and C<$output> is a single
+When C<$input_filename_or_reference> maps to multiple files/buffers and
+C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
-in C<$output> as a concatenated series of compressed data streams.
+in C<$output_filename_or_reference> as a concatenated series of compressed data streams.
=head2 Optional Parameters
@@ -1234,7 +1243,7 @@ See the Changes file.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2012 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2013 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm
index c218a31445c..b65f56b91f3 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Gzip/Constants.pm
@@ -9,7 +9,7 @@ require Exporter;
our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
-$VERSION = '2.048';
+$VERSION = '2.060';
@ISA = qw(Exporter);
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm
index 883a4eb2f72..0862e6e216d 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/RawDeflate.pm
@@ -6,16 +6,15 @@ use strict ;
use warnings;
use bytes;
-
-use IO::Compress::Base 2.048 ;
-use IO::Compress::Base::Common 2.048 qw(:Status createSelfTiedObject);
-use IO::Compress::Adapter::Deflate 2.048 ;
+use IO::Compress::Base 2.060 ;
+use IO::Compress::Base::Common 2.060 qw(:Status );
+use IO::Compress::Adapter::Deflate 2.060 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
-$VERSION = '2.048';
+$VERSION = '2.060';
$RawDeflateError = '';
@ISA = qw(Exporter IO::Compress::Base);
@@ -49,14 +48,14 @@ sub new
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$RawDeflateError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawDeflateError);
return $obj->_create(undef, @_);
}
sub rawdeflate
{
- my $obj = createSelfTiedObject(undef, \$RawDeflateError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawDeflateError);
return $obj->_def(@_);
}
@@ -74,10 +73,10 @@ sub mkComp
my $got = shift ;
my ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
- $got->value('CRC32'),
- $got->value('Adler32'),
- $got->value('Level'),
- $got->value('Strategy')
+ $got->getValue('crc32'),
+ $got->getValue('adler32'),
+ $got->getValue('level'),
+ $got->getValue('strategy')
);
return $self->saveErrorString(undef, $errstr, $errno)
@@ -114,30 +113,24 @@ sub mkFinalTrailer
sub getExtraParams
{
my $self = shift ;
- return $self->getZlibParams();
+ return getZlibParams();
}
-sub getZlibParams
-{
- my $self = shift ;
-
- use IO::Compress::Base::Common 2.048 qw(:Parse);
- use Compress::Raw::Zlib 2.048 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+use IO::Compress::Base::Common 2.060 qw(:Parse);
+use Compress::Raw::Zlib 2.060 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+our %PARAMS = (
+ #'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED],
+ 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION],
+ 'strategy' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_STRATEGY],
-
- return (
-
- # zlib behaviour
- #'Method' => [0, 1, Parse_unsigned, Z_DEFLATED],
- 'Level' => [0, 1, Parse_signed, Z_DEFAULT_COMPRESSION],
- 'Strategy' => [0, 1, Parse_signed, Z_DEFAULT_STRATEGY],
-
- 'CRC32' => [0, 1, Parse_boolean, 0],
- 'ADLER32' => [0, 1, Parse_boolean, 0],
- 'Merge' => [1, 1, Parse_boolean, 0],
+ 'crc32' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'adler32' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0],
);
-
-
+
+sub getZlibParams
+{
+ return %PARAMS;
}
sub getInverseClass
@@ -296,19 +289,20 @@ section.
use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;
- rawdeflate $input => $output [,OPTS]
+ rawdeflate $input_filename_or_reference => $output_filename_or_reference [,OPTS]
or die "rawdeflate failed: $RawDeflateError\n";
The functional interface needs Perl5.005 or better.
=head2 rawdeflate $input => $output [, OPTS]
-C<rawdeflate> expects at least two parameters, C<$input> and C<$output>.
+C<rawdeflate> expects at least two parameters,
+C<$input_filename_or_reference> and C<$output_filename_or_reference>.
-=head3 The C<$input> parameter
+=head3 The C<$input_filename_or_reference> parameter
-The parameter, C<$input>, is used to define the source of
-the uncompressed data.
+The parameter, C<$input_filename_or_reference>, is used to define the
+source of the uncompressed data.
It can take one of the following forms:
@@ -316,25 +310,25 @@ It can take one of the following forms:
=item A filename
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
+If the <$input_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for reading and the
+input data will be read from it.
=item A filehandle
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
+If the C<$input_filename_or_reference> parameter is a filehandle, the input
+data will be read from it. The string '-' can be used as an alias for
+standard input.
=item A scalar reference
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
+If C<$input_filename_or_reference> is a scalar reference, the input data
+will be read from C<$$input_filename_or_reference>.
=item An array reference
-If C<$input> is an array reference, each element in the array must be a
-filename.
+If C<$input_filename_or_reference> is an array reference, each element in
+the array must be a filename.
The input data will be read from each file in turn.
@@ -343,65 +337,72 @@ contains valid filenames before any data is compressed.
=item An Input FileGlob string
-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 C<$input_filename_or_reference> 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.
See L<File::GlobMapper|File::GlobMapper> for more details.
=back
-If the C<$input> parameter is any other type, C<undef> will be returned.
+If the C<$input_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
-=head3 The C<$output> parameter
+=head3 The C<$output_filename_or_reference> parameter
-The parameter C<$output> is used to control the destination of the
-compressed data. This parameter can take one of these forms.
+The parameter C<$output_filename_or_reference> is used to control the
+destination of the compressed data. This parameter can take one of
+these forms.
=over 5
=item A filename
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed
-data will be written to it.
+If the C<$output_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for writing and the
+compressed data will be written to it.
=item A filehandle
-If the C<$output> parameter is a filehandle, the compressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
+If the C<$output_filename_or_reference> parameter is a filehandle, the
+compressed data will be written to it. The string '-' can be used as
+an alias for standard output.
=item A scalar reference
-If C<$output> is a scalar reference, the compressed data will be
-stored in C<$$output>.
+If C<$output_filename_or_reference> is a scalar reference, the
+compressed data will be stored in C<$$output_filename_or_reference>.
=item An Array Reference
-If C<$output> is an array reference, the compressed data will be
-pushed onto the array.
+If C<$output_filename_or_reference> is an array reference,
+the compressed data will be pushed onto the array.
=item An Output FileGlob
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<rawdeflate> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
+If C<$output_filename_or_reference> is a string that is delimited by the
+characters "<" and ">" C<rawdeflate> will assume that it is an
+I<output fileglob string>. The 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.
+When C<$output_filename_or_reference> is an fileglob string,
+C<$input_filename_or_reference> 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.
+If the C<$output_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
=head2 Notes
-When C<$input> maps to multiple files/buffers and C<$output> is a single
+When C<$input_filename_or_reference> maps to multiple files/buffers and
+C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will be stored
-in C<$output> as a concatenated series of compressed data streams.
+in C<$output_filename_or_reference> as a concatenated series of compressed data streams.
=head2 Optional Parameters
@@ -987,7 +988,7 @@ See the Changes file.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2012 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2013 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm
index 9c2780a5e06..a5bf89ecc40 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip.pm
@@ -4,30 +4,30 @@ use strict ;
use warnings;
use bytes;
-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 IO::Compress::Base::Common 2.060 qw(:Status );
+use IO::Compress::RawDeflate 2.060 ();
+use IO::Compress::Adapter::Deflate 2.060 ;
+use IO::Compress::Adapter::Identity 2.060 ;
+use IO::Compress::Zlib::Extra 2.060 ;
+use IO::Compress::Zip::Constants 2.060 ;
use File::Spec();
use Config;
-use Compress::Raw::Zlib 2.048 ();
+use Compress::Raw::Zlib 2.060 ();
BEGIN
{
eval { require IO::Compress::Adapter::Bzip2 ;
- import IO::Compress::Adapter::Bzip2 2.048 ;
+ import IO::Compress::Adapter::Bzip2 2.060 ;
require IO::Compress::Bzip2 ;
- import IO::Compress::Bzip2 2.048 ;
+ import IO::Compress::Bzip2 2.060 ;
} ;
eval { require IO::Compress::Adapter::Lzma ;
- import IO::Compress::Adapter::Lzma 2.048 ;
+ import IO::Compress::Adapter::Lzma 2.060 ;
require IO::Compress::Lzma ;
- import IO::Compress::Lzma 2.048 ;
+ import IO::Compress::Lzma 2.060 ;
} ;
}
@@ -36,7 +36,7 @@ require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
-$VERSION = '2.048';
+$VERSION = '2.060';
$ZipError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
@@ -54,14 +54,14 @@ sub new
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$ZipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$ZipError);
$obj->_create(undef, @_);
}
sub zip
{
- my $obj = createSelfTiedObject(undef, \$ZipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$ZipError);
return $obj->_def(@_);
}
@@ -114,30 +114,30 @@ sub mkComp
if (*$self->{ZipData}{Method} == ZIP_CM_STORE) {
($obj, $errstr, $errno) = IO::Compress::Adapter::Identity::mkCompObject(
- $got->value('Level'),
- $got->value('Strategy')
+ $got->getValue('level'),
+ $got->getValue('strategy')
);
*$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
}
elsif (*$self->{ZipData}{Method} == ZIP_CM_DEFLATE) {
($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
- $got->value('CRC32'),
- $got->value('Adler32'),
- $got->value('Level'),
- $got->value('Strategy')
+ $got->getValue('crc32'),
+ $got->getValue('adler32'),
+ $got->getValue('level'),
+ $got->getValue('strategy')
);
}
elsif (*$self->{ZipData}{Method} == ZIP_CM_BZIP2) {
($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject(
- $got->value('BlockSize100K'),
- $got->value('WorkFactor'),
- $got->value('Verbosity')
+ $got->getValue('blocksize100k'),
+ $got->getValue('workfactor'),
+ $got->getValue('verbosity')
);
*$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'),
+ ($obj, $errstr, $errno) = IO::Compress::Adapter::Lzma::mkRawZipCompObject($got->getValue('preset'),
+ $got->getValue('extreme'),
);
*$self->{ZipData}{CRC32} = Compress::Raw::Zlib::crc32(undef);
}
@@ -230,39 +230,38 @@ sub mkHeader
my $self = shift;
my $param = shift ;
-
*$self->{ZipData}{LocalHdrOffset} = U64::clone(*$self->{ZipData}{Offset});
-
+
my $comment = '';
- $comment = $param->value('Comment') || '';
+ $comment = $param->valueOrDefault('comment') ;
my $filename = '';
- $filename = $param->value('Name') || '';
+ $filename = $param->valueOrDefault('name') ;
$filename = canonicalName($filename)
- if length $filename && $param->value('CanonicalName') ;
+ if length $filename && $param->getValue('canonicalname') ;
if (defined *$self->{ZipData}{FilterName} ) {
local *_ = \$filename ;
&{ *$self->{ZipData}{FilterName} }() ;
}
-# if ( $param->value('UTF8') ) {
+# if ( $param->getValue('utf8') ) {
# require Encode ;
# $filename = Encode::encode_utf8($filename)
# if length $filename ;
-# $comment = Encode::encode_utf8($filename)
+# $comment = Encode::encode_utf8($comment)
# if length $comment ;
# }
my $hdr = '';
- my $time = _unixToDosTime($param->value('Time'));
+ my $time = _unixToDosTime($param->getValue('time'));
my $extra = '';
my $ctlExtra = '';
my $empty = 0;
- my $osCode = $param->value('OS_Code') ;
+ my $osCode = $param->getValue('os_code') ;
my $extFileAttr = 0 ;
# This code assumes Unix.
@@ -271,7 +270,7 @@ sub mkHeader
if $osCode == ZIP_OS_CODE_UNIX ;
if (*$self->{ZipData}{Zip64}) {
- $empty = MAX32;
+ $empty = IO::Compress::Base::Common::MAX32;
my $x = '';
$x .= pack "V V", 0, 0 ; # uncompressedLength
@@ -279,40 +278,40 @@ sub mkHeader
$extra .= IO::Compress::Zlib::Extra::mkSubField(ZIP_EXTRA_ID_ZIP64, $x);
}
- if (! $param->value('Minimal')) {
- if ($param->parsed('MTime'))
+ if (! $param->getValue('minimal')) {
+ if ($param->parsed('mtime'))
{
- $extra .= mkExtendedTime($param->value('MTime'),
- $param->value('ATime'),
- $param->value('CTime'));
+ $extra .= mkExtendedTime($param->getValue('mtime'),
+ $param->getValue('atime'),
+ $param->getValue('ctime'));
- $ctlExtra .= mkExtendedTime($param->value('MTime'));
+ $ctlExtra .= mkExtendedTime($param->getValue('mtime'));
}
if ( $osCode == ZIP_OS_CODE_UNIX )
{
- if ( $param->value('want_exUnixN') )
+ if ( $param->getValue('want_exunixn') )
{
- my $ux3 = mkUnixNExtra( @{ $param->value('want_exUnixN') });
+ my $ux3 = mkUnixNExtra( @{ $param->getValue('want_exunixn') });
$extra .= $ux3;
$ctlExtra .= $ux3;
}
- if ( $param->value('exUnix2') )
+ if ( $param->getValue('exunix2') )
{
- $extra .= mkUnix2Extra( @{ $param->value('exUnix2') });
+ $extra .= mkUnix2Extra( @{ $param->getValue('exunix2') });
$ctlExtra .= mkUnix2Extra();
}
}
- $extFileAttr = $param->value('ExtAttr')
- if defined $param->value('ExtAttr') ;
+ $extFileAttr = $param->getValue('extattr')
+ if defined $param->getValue('extattr') ;
- $extra .= $param->value('ExtraFieldLocal')
- if defined $param->value('ExtraFieldLocal');
+ $extra .= $param->getValue('extrafieldlocal')
+ if defined $param->getValue('extrafieldlocal');
- $ctlExtra .= $param->value('ExtraFieldCentral')
- if defined $param->value('ExtraFieldCentral');
+ $ctlExtra .= $param->getValue('extrafieldcentral')
+ if defined $param->getValue('extrafieldcentral');
}
my $method = *$self->{ZipData}{Method} ;
@@ -323,14 +322,14 @@ sub mkHeader
$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);
+# $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING
+# if $param->getValue('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 $madeBy = ($param->getValue('os_code') << 8) + $version;
my $extract = $version;
*$self->{ZipData}{Version} = $version;
@@ -338,7 +337,7 @@ sub mkHeader
my $ifa = 0;
$ifa |= ZIP_IFA_TEXT_MASK
- if $param->value('TextFlag');
+ if $param->getValue('textflag');
$hdr .= pack "V", ZIP_LOCAL_HDR_SIG ; # signature
$hdr .= pack 'v', $extract ; # extract Version & OS
@@ -391,7 +390,7 @@ sub mkHeader
# offset to local hdr
if (*$self->{ZipData}{LocalHdrOffset}->is64bit() ) {
- $ctl .= pack 'V', MAX32 ;
+ $ctl .= pack 'V', IO::Compress::Base::Common::MAX32 ;
}
else {
$ctl .= *$self->{ZipData}{LocalHdrOffset}->getPacked_V32() ;
@@ -401,7 +400,7 @@ sub mkHeader
$ctl .= $ctlExtra ;
$ctl .= $comment ;
- *$self->{ZipData}{Offset}->add(length $hdr) ;
+ *$self->{ZipData}{Offset}->add32(length $hdr) ;
*$self->{ZipData}{CentralHeader} = $ctl;
@@ -489,7 +488,7 @@ sub mkTrailer
*$self->{ZipData}{AnyZip64} = 1;
}
- *$self->{ZipData}{Offset}->add(length($hdr));
+ *$self->{ZipData}{Offset}->add32(length($hdr));
*$self->{ZipData}{Offset}->add( *$self->{CompSize} );
push @{ *$self->{ZipData}{CentralDir} }, $ctl ;
@@ -499,13 +498,17 @@ sub mkTrailer
sub mkFinalTrailer
{
my $self = shift ;
-
+
my $comment = '';
$comment = *$self->{ZipData}{ZipComment} ;
my $cd_offset = *$self->{ZipData}{Offset}->get32bit() ; # offset to start central dir
my $entries = @{ *$self->{ZipData}{CentralDir} };
+
+ *$self->{ZipData}{AnyZip64} = 1
+ if *$self->{ZipData}{Offset}->is64bit || $entries >= 0xFFFF ;
+
my $cd = join '', @{ *$self->{ZipData}{CentralDir} };
my $cd_len = length $cd ;
@@ -528,15 +531,15 @@ sub mkFinalTrailer
. U64::pack_V64(length $z64e)
. $z64e ;
- *$self->{ZipData}{Offset}->add(length $cd) ;
+ *$self->{ZipData}{Offset}->add32(length $cd) ;
$z64e .= pack "V", ZIP64_END_CENTRAL_LOC_HDR_SIG; # signature
$z64e .= pack 'V', 0 ; # number of disk with central dir
$z64e .= *$self->{ZipData}{Offset}->getPacked_V64() ; # offset to end zip64 central dir
$z64e .= pack 'V', 1 ; # Total number of disks
- $cd_offset = MAX32 ;
- $cd_len = MAX32 if isGeMax32 $cd_len ;
+ $cd_offset = IO::Compress::Base::Common::MAX32 ;
+ $cd_len = IO::Compress::Base::Common::MAX32 if IO::Compress::Base::Common::isGeMax32 $cd_len ;
$entries = 0xFFFF if $entries >= 0xFFFF ;
}
@@ -559,47 +562,47 @@ sub ckParams
my $self = shift ;
my $got = shift;
- $got->value('CRC32' => 1);
+ $got->setValue('crc32' => 1);
- if (! $got->parsed('Time') ) {
+ if (! $got->parsed('time') ) {
# Modification time defaults to now.
- $got->value('Time' => time) ;
+ $got->setValue('time' => time) ;
}
- if ($got->parsed('exTime') ) {
- my $timeRef = $got->value('exTime');
+ if ($got->parsed('extime') ) {
+ my $timeRef = $got->getValue('extime');
if ( defined $timeRef) {
return $self->saveErrorString(undef, "exTime not a 3-element array ref")
if ref $timeRef ne 'ARRAY' || @$timeRef != 3;
}
- $got->value("MTime", $timeRef->[1]);
- $got->value("ATime", $timeRef->[0]);
- $got->value("CTime", $timeRef->[2]);
+ $got->setValue("mtime", $timeRef->[1]);
+ $got->setValue("atime", $timeRef->[0]);
+ $got->setValue("ctime", $timeRef->[2]);
}
# Unix2/3 Extended Attribute
- for my $name (qw(exUnix2 exUnixN))
+ for my $name (qw(exunix2 exunixn))
{
if ($got->parsed($name) ) {
- my $idRef = $got->value($name);
+ my $idRef = $got->getValue($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->setValue("uid", $idRef->[0]);
+ $got->setValue("gid", $idRef->[1]);
+ $got->setValue("want_$name", $idRef);
}
}
*$self->{ZipData}{AnyZip64} = 1
- if $got->value('Zip64');
- *$self->{ZipData}{Zip64} = $got->value('Zip64');
- *$self->{ZipData}{Stream} = $got->value('Stream');
+ if $got->getValue('zip64');
+ *$self->{ZipData}{Zip64} = $got->getValue('zip64');
+ *$self->{ZipData}{Stream} = $got->getValue('stream');
- my $method = $got->value('Method');
+ my $method = $got->getValue('method');
return $self->saveErrorString(undef, "Unknown Method '$method'")
if ! defined $ZIP_CM_MIN_VERSIONS{$method};
@@ -613,17 +616,17 @@ sub ckParams
*$self->{ZipData}{Method} = $method;
- *$self->{ZipData}{ZipComment} = $got->value('ZipComment') ;
+ *$self->{ZipData}{ZipComment} = $got->getValue('zipcomment') ;
- for my $name (qw( ExtraFieldLocal ExtraFieldCentral ))
+ for my $name (qw( extrafieldlocal extrafieldcentral ))
{
- my $data = $got->value($name) ;
+ my $data = $got->getValue($name) ;
if (defined $data) {
my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, 1, 0) ;
return $self->saveErrorString(undef, "Error with $name Parameter: $bad")
if $bad ;
- $got->value($name, $data) ;
+ $got->setValue($name, $data) ;
}
}
@@ -631,13 +634,13 @@ 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') ;
+ if ($got->parsed('sparse') ) {
+ *$self->{ZipData}{Sparse} = $got->getValue('sparse') ;
*$self->{ZipData}{Method} = ZIP_CM_STORE;
}
- if ($got->parsed('FilterName')) {
- my $v = $got->value('FilterName') ;
+ if ($got->parsed('filtername')) {
+ my $v = $got->getValue('filtername') ;
*$self->{ZipData}{FilterName} = $v
if ref $v eq 'CODE' ;
}
@@ -660,58 +663,53 @@ sub outputPayload
# return $self->mkHeader(*$self->{Got});
#}
-sub getExtraParams
-{
- my $self = shift ;
-
- 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(),
-
- 'Stream' => [1, 1, Parse_boolean, 1],
- #'Store' => [0, 1, Parse_boolean, 0],
- 'Method' => [0, 1, Parse_unsigned, ZIP_CM_DEFLATE],
+our %PARAMS = (
+ 'stream' => [IO::Compress::Base::Common::Parse_boolean, 1],
+ #'store' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'method' => [IO::Compress::Base::Common::Parse_unsigned, ZIP_CM_DEFLATE],
# # Zip header fields
- 'Minimal' => [0, 1, Parse_boolean, 0],
- 'Zip64' => [0, 1, Parse_boolean, 0],
- 'Comment' => [0, 1, Parse_any, ''],
- 'ZipComment'=> [0, 1, Parse_any, ''],
- 'Name' => [0, 1, Parse_any, ''],
- 'FilterName'=> [0, 1, Parse_code, undef],
- 'CanonicalName'=> [0, 1, Parse_boolean, 0],
- #'UTF8' => [0, 1, Parse_boolean, 0],
- 'Time' => [0, 1, Parse_any, undef],
- 'exTime' => [0, 1, Parse_any, undef],
- 'exUnix2' => [0, 1, Parse_any, undef],
- 'exUnixN' => [0, 1, Parse_any, undef],
- 'ExtAttr' => [0, 1, Parse_any,
+ 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'zip64' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'comment' => [IO::Compress::Base::Common::Parse_any, ''],
+ 'zipcomment'=> [IO::Compress::Base::Common::Parse_any, ''],
+ 'name' => [IO::Compress::Base::Common::Parse_any, ''],
+ 'filtername'=> [IO::Compress::Base::Common::Parse_code, undef],
+ 'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean, 0],
+# 'utf8' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'time' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'extime' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'exunix2' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'exunixn' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'extattr' => [IO::Compress::Base::Common::Parse_any,
$Compress::Raw::Zlib::gzip_os_code == 3
? 0100644 << 16
: 0],
- 'OS_Code' => [0, 1, Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code],
+ 'os_code' => [IO::Compress::Base::Common::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],
+ 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0],
+ 'extrafieldlocal' => [IO::Compress::Base::Common::Parse_any, undef],
+ 'extrafieldcentral'=> [IO::Compress::Base::Common::Parse_any, undef],
# Lzma
- 'Preset' => [0, 1, Parse_unsigned, 6],
- 'Extreme' => [1, 1, Parse_boolean, 0],
+ 'preset' => [IO::Compress::Base::Common::Parse_unsigned, 6],
+ 'extreme' => [IO::Compress::Base::Common::Parse_boolean, 0],
# For internal use only
- 'Sparse' => [0, 1, Parse_unsigned, 0],
+ 'sparse' => [IO::Compress::Base::Common::Parse_unsigned, 0],
- @Bzip2,
- );
+ IO::Compress::RawDeflate::getZlibParams(),
+ defined $IO::Compress::Bzip2::VERSION
+ ? IO::Compress::Bzip2::getExtraParams()
+ : ()
+
+
+ );
+
+sub getExtraParams
+{
+ return %PARAMS ;
}
sub getInverseClass
@@ -726,16 +724,16 @@ sub getFileInfo
my $params = shift;
my $filename = shift ;
- if (isaScalar($filename))
+ if (IO::Compress::Base::Common::isaScalar($filename))
{
- $params->value(Zip64 => 1)
- if isGeMax32 length (${ $filename }) ;
+ $params->setValue(zip64 => 1)
+ if IO::Compress::Base::Common::isGeMax32 length (${ $filename }) ;
return ;
}
my ($mode, $uid, $gid, $size, $atime, $mtime, $ctime) ;
- if ( $params->parsed('StoreLinks') )
+ if ( $params->parsed('storelinks') )
{
($mode, $uid, $gid, $size, $atime, $mtime, $ctime)
= (lstat($filename))[2, 4,5,7, 8,9,10] ;
@@ -746,40 +744,40 @@ sub getFileInfo
= (stat($filename))[2, 4,5,7, 8,9,10] ;
}
- $params->value(TextFlag => -T $filename )
- if ! $params->parsed('TextFlag');
+ $params->setValue(textflag => -T $filename )
+ if ! $params->parsed('textflag');
- $params->value(Zip64 => 1)
- if isGeMax32 $size ;
+ $params->setValue(zip64 => 1)
+ if IO::Compress::Base::Common::isGeMax32 $size ;
- $params->value('Name' => $filename)
- if ! $params->parsed('Name') ;
+ $params->setValue('name' => $filename)
+ if ! $params->parsed('name') ;
- $params->value('Time' => $mtime)
- if ! $params->parsed('Time') ;
+ $params->setValue('time' => $mtime)
+ if ! $params->parsed('time') ;
- if ( ! $params->parsed('exTime'))
+ if ( ! $params->parsed('extime'))
{
- $params->value('MTime' => $mtime) ;
- $params->value('ATime' => $atime) ;
- $params->value('CTime' => undef) ; # No Creation time
+ $params->setValue('mtime' => $mtime) ;
+ $params->setValue('atime' => $atime) ;
+ $params->setValue('ctime' => undef) ; # No Creation time
# TODO - see if can fillout creation time on non-Unix
}
# NOTE - Unix specific code alert
- 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->setValue('extattr' => $attr);
}
- $params->value('want_exUnixN', [$uid, $gid]);
- $params->value('UID' => $uid) ;
- $params->value('GID' => $gid) ;
+ $params->setValue('want_exunixn', [$uid, $gid]);
+ $params->setValue('uid' => $uid) ;
+ $params->setValue('gid' => $gid) ;
}
@@ -936,19 +934,20 @@ section.
use IO::Compress::Zip qw(zip $ZipError) ;
- zip $input => $output [,OPTS]
+ zip $input_filename_or_reference => $output_filename_or_reference [,OPTS]
or die "zip failed: $ZipError\n";
The functional interface needs Perl5.005 or better.
=head2 zip $input => $output [, OPTS]
-C<zip> expects at least two parameters, C<$input> and C<$output>.
+C<zip> expects at least two parameters,
+C<$input_filename_or_reference> and C<$output_filename_or_reference>.
-=head3 The C<$input> parameter
+=head3 The C<$input_filename_or_reference> parameter
-The parameter, C<$input>, is used to define the source of
-the uncompressed data.
+The parameter, C<$input_filename_or_reference>, is used to define the
+source of the uncompressed data.
It can take one of the following forms:
@@ -956,25 +955,25 @@ It can take one of the following forms:
=item A filename
-If the C<$input> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for reading and the input data
-will be read from it.
+If the <$input_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for reading and the
+input data will be read from it.
=item A filehandle
-If the C<$input> parameter is a filehandle, the input data will be
-read from it.
-The string '-' can be used as an alias for standard input.
+If the C<$input_filename_or_reference> parameter is a filehandle, the input
+data will be read from it. The string '-' can be used as an alias for
+standard input.
=item A scalar reference
-If C<$input> is a scalar reference, the input data will be read
-from C<$$input>.
+If C<$input_filename_or_reference> is a scalar reference, the input data
+will be read from C<$$input_filename_or_reference>.
=item An array reference
-If C<$input> is an array reference, each element in the array must be a
-filename.
+If C<$input_filename_or_reference> is an array reference, each element in
+the array must be a filename.
The input data will be read from each file in turn.
@@ -983,72 +982,80 @@ contains valid filenames before any data is compressed.
=item An Input FileGlob string
-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 C<$input_filename_or_reference> 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.
See L<File::GlobMapper|File::GlobMapper> for more details.
=back
-If the C<$input> parameter is any other type, C<undef> will be returned.
+If the C<$input_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
-In addition, if C<$input> is a simple filename, the default values for
+In addition, if C<$input_filename_or_reference> is a simple filename,
+the default values for
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<TextFlag>, C<ExtAttr>, C<exUnixN> and C<exTime> options or by setting the
C<Minimal> parameter.
-=head3 The C<$output> parameter
+=head3 The C<$output_filename_or_reference> parameter
-The parameter C<$output> is used to control the destination of the
-compressed data. This parameter can take one of these forms.
+The parameter C<$output_filename_or_reference> is used to control the
+destination of the compressed data. This parameter can take one of
+these forms.
=over 5
=item A filename
-If the C<$output> parameter is a simple scalar, it is assumed to be a
-filename. This file will be opened for writing and the compressed
-data will be written to it.
+If the C<$output_filename_or_reference> parameter is a simple scalar, it is
+assumed to be a filename. This file will be opened for writing and the
+compressed data will be written to it.
=item A filehandle
-If the C<$output> parameter is a filehandle, the compressed data
-will be written to it.
-The string '-' can be used as an alias for standard output.
+If the C<$output_filename_or_reference> parameter is a filehandle, the
+compressed data will be written to it. The string '-' can be used as
+an alias for standard output.
=item A scalar reference
-If C<$output> is a scalar reference, the compressed data will be
-stored in C<$$output>.
+If C<$output_filename_or_reference> is a scalar reference, the
+compressed data will be stored in C<$$output_filename_or_reference>.
=item An Array Reference
-If C<$output> is an array reference, the compressed data will be
-pushed onto the array.
+If C<$output_filename_or_reference> is an array reference,
+the compressed data will be pushed onto the array.
=item An Output FileGlob
-If C<$output> is a string that is delimited by the characters "<" and ">"
-C<zip> will assume that it is an I<output fileglob string>. The
-output is the list of files that match the fileglob.
+If C<$output_filename_or_reference> is a string that is delimited by the
+characters "<" and ">" C<zip> will assume that it is an
+I<output fileglob string>. The 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.
+When C<$output_filename_or_reference> is an fileglob string,
+C<$input_filename_or_reference> 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.
+If the C<$output_filename_or_reference> parameter is any other type,
+C<undef> will be returned.
=head2 Notes
-When C<$input> maps to multiple files/buffers and C<$output> is a single
+When C<$input_filename_or_reference> maps to multiple files/buffers and
+C<$output_filename_or_reference> is a single
file/buffer the input files/buffers will each be stored
-in C<$output> as a distinct entry.
+in C<$output_filename_or_reference> as a distinct entry.
=head2 Optional Parameters
@@ -1463,7 +1470,8 @@ The default is 1.
=item C<< Zip64 => 0|1 >>
Create a Zip64 zip file/buffer. This option is used if you want
-to store files larger than 4 Gig.
+to store files larger than 4 Gig or store more than 64K files in a single
+zip archive..
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.
@@ -1489,6 +1497,7 @@ the file contains text.
The default is 0.
=item C<< ExtraFieldLocal => $data >>
+
=item C<< ExtraFieldCentral => $data >>
The C<ExtraFieldLocal> option is used to store additional metadata in the
@@ -1944,7 +1953,7 @@ See the Changes file.
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2005-2012 Paul Marquess. All rights reserved.
+Copyright (c) 2005-2013 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm
index 8db079cb93d..64cfc2685c6 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zip/Constants.pm
@@ -7,7 +7,7 @@ require Exporter;
our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
-$VERSION = '2.048';
+$VERSION = '2.060';
@ISA = qw(Exporter);
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm
index 992b1b925f2..328fc4aa8e6 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Constants.pm
@@ -9,7 +9,7 @@ require Exporter;
our ($VERSION, @ISA, @EXPORT);
-$VERSION = '2.048';
+$VERSION = '2.060';
@ISA = qw(Exporter);
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm
index 9e0be2e4b6c..d320dccabd4 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Zlib/Extra.pm
@@ -8,9 +8,9 @@ use bytes;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.048';
+$VERSION = '2.060';
-use IO::Compress::Gzip::Constants 2.048 ;
+use IO::Compress::Gzip::Constants 2.060 ;
sub ExtraFieldError
{