summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2020-03-07 22:52:33 +0000
committerKarl Berry <karl@freefriends.org>2020-03-07 22:52:33 +0000
commit11c6e5fc65f26ba5219997d19707b998a9abf26d (patch)
treea1dc8073a679611d3f09c01eda006cc3f6f846b1 /Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
parenta6593bd4f2eb12ae25540de026f7f9ebcf230a2f (diff)
tl20 perl 5.30.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@54166 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm188
1 files changed, 98 insertions, 90 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
index c82c99a441d..53232898c47 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
@@ -11,15 +11,15 @@ use File::GlobMapper;
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.074';
+$VERSION = '2.084';
@EXPORT = qw( isaFilehandle isaFilename isaScalar
- whatIsInput whatIsOutput
+ whatIsInput whatIsOutput
isaFileGlobString cleanFileGlobString oneTarget
setBinModeInput setBinModeOutput
- ckInOutParams
+ ckInOutParams
createSelfTiedObject
-
+
isGeMax32
MAX32
@@ -33,7 +33,7 @@ $VERSION = '2.074';
STATUS_ENDSTREAM
STATUS_EOF
STATUS_ERROR
- );
+ );
%EXPORT_TAGS = ( Status => [qw( STATUS_OK
STATUS_ENDSTREAM
@@ -41,15 +41,15 @@ $VERSION = '2.074';
STATUS_ERROR
)]);
-
+
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
-
+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
{
@@ -89,7 +89,7 @@ sub getEncoding($$$)
}
our ($needBinmode);
-$needBinmode = ($^O eq 'MSWin32' ||
+$needBinmode = ($^O eq 'MSWin32' ||
($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} '))
? 1 : 1 ;
@@ -97,7 +97,7 @@ sub setBinModeInput($)
{
my $handle = shift ;
- binmode $handle
+ binmode $handle
if $needBinmode;
}
@@ -112,10 +112,10 @@ sub setBinModeOutput($)
sub isaFilehandle($)
{
use utf8; # Pragma needed to keep Perl 5.6.0 happy
- return (defined $_[0] and
- (UNIVERSAL::isa($_[0],'GLOB') or
+ return (defined $_[0] and
+ (UNIVERSAL::isa($_[0],'GLOB') or
UNIVERSAL::isa($_[0],'IO::Handle') or
- UNIVERSAL::isa(\$_[0],'GLOB'))
+ UNIVERSAL::isa(\$_[0],'GLOB'))
)
}
@@ -126,8 +126,8 @@ sub isaScalar
sub isaFilename($)
{
- return (defined $_[0] and
- ! ref $_[0] and
+ return (defined $_[0] and
+ ! ref $_[0] and
UNIVERSAL::isa(\$_[0], 'SCALAR'));
}
@@ -154,7 +154,7 @@ use constant WANT_HASH => 0 ;
sub whatIsInput($;$)
{
my $got = whatIs(@_);
-
+
if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
{
#use IO::File;
@@ -169,14 +169,14 @@ sub whatIsInput($;$)
sub whatIsOutput($;$)
{
my $got = whatIs(@_);
-
+
if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-')
{
$got = 'handle';
$_[0] = *STDOUT;
#$_[0] = new IO::File(">-");
}
-
+
return $got;
}
@@ -218,9 +218,9 @@ sub IO::Compress::Base::Validator::new
my $error_ref = shift ;
my $reportClass = shift ;
- my %data = (Class => $Class,
+ my %data = (Class => $Class,
Error => $error_ref,
- reportClass => $reportClass,
+ reportClass => $reportClass,
) ;
my $obj = bless \%data, $class ;
@@ -237,7 +237,7 @@ sub IO::Compress::Base::Validator::new
{
$obj->croakError("$reportClass: illegal input parameter") ;
#return undef ;
- }
+ }
# if ($inType eq 'hash')
# {
@@ -250,18 +250,18 @@ sub IO::Compress::Base::Validator::new
{
$obj->croakError("$reportClass: illegal output parameter") ;
#return undef ;
- }
+ }
if ($inType ne 'fileglob' && $outType eq 'fileglob')
{
$obj->croakError("Need input fileglob for outout fileglob");
- }
+ }
# if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' )
# {
# $obj->croakError("input must ne filename or fileglob when output is a hash");
-# }
+# }
if ($inType eq 'fileglob' && $outType eq 'fileglob')
{
@@ -276,7 +276,7 @@ sub IO::Compress::Base::Validator::new
return $obj;
}
-
+
$obj->croakError("$reportClass: input and output $inType are identical")
if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ;
@@ -334,7 +334,7 @@ sub IO::Compress::Base::Validator::new
}
}
}
-
+
return $obj ;
}
@@ -343,7 +343,7 @@ sub IO::Compress::Base::Validator::saveErrorString
my $self = shift ;
${ $self->{Error} } = shift ;
return undef;
-
+
}
sub IO::Compress::Base::Validator::croakError
@@ -392,16 +392,16 @@ sub IO::Compress::Base::Validator::validateInputArray
if ( @{ $_[0] } == 0 )
{
return $self->saveErrorString("empty array reference") ;
- }
+ }
foreach my $element ( @{ $_[0] } )
{
my $inType = whatIsInput($element);
-
+
if (! $inType)
{
$self->croakError("unknown input parameter") ;
- }
+ }
elsif($inType eq 'filename')
{
$self->validateInputFilenames($element)
@@ -429,13 +429,13 @@ sub IO::Compress::Base::Validator::validateInputArray
# if ($ktype ne 'filename')
# {
# return $self->saveErrorString("hash key not filename") ;
-# }
+# }
#
# my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ;
# if (! $valid{$vtype})
# {
# return $self->saveErrorString("hash value not ok") ;
-# }
+# }
# }
#
# return $self ;
@@ -467,13 +467,13 @@ sub createSelfTiedObject
#$VERSION = '2.000_08';
#@ISA = qw(Exporter);
-$EXPORT_TAGS{Parse} = [qw( ParseParameters
- Parse_any Parse_unsigned Parse_signed
+$EXPORT_TAGS{Parse} = [qw( ParseParameters
+ Parse_any Parse_unsigned Parse_signed
Parse_boolean Parse_string
Parse_code
Parse_writable_scalar
)
- ];
+ ];
push @EXPORT, @{ $EXPORT_TAGS{Parse} } ;
@@ -501,15 +501,15 @@ use constant IxGot => 1 ;
sub ParseParameters
{
- my $level = shift || 0 ;
+ my $level = shift || 0 ;
my $sub = (caller($level + 1))[3] ;
local $Carp::CarpLevel = 1 ;
-
+
return $_[1]
if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters");
-
- my $p = new IO::Compress::Base::Parameters() ;
+
+ my $p = new IO::Compress::Base::Parameters() ;
$p->parse(@_)
or croak "$sub: $p->[IxError]" ;
@@ -527,7 +527,7 @@ sub Init
{
my $default = shift ;
my %got ;
-
+
my $obj = IO::Compress::Base::Parameters::new();
while (my ($key, $v) = each %$default)
{
@@ -538,7 +538,7 @@ sub Init
# my ($first_only, $sticky, $type, $value) = @$v ;
my $sticky = 0;
my $x ;
- $obj->_checkType($key, \$value, $type, 0, \$x)
+ $obj->_checkType($key, \$value, $type, 0, \$x)
or return undef ;
$key = lc $key;
@@ -548,12 +548,12 @@ sub Init
# if $type & Parse_multiple;
# $got{$key} = [0, $type, $value, $x, $first_only, $sticky] ;
- $got{$key} = [0, $type, $value, $x] ;
+ $got{$key} = [0, $type, $value, $x] ;
# }
#
# $got{$key}[OFF_PARSED] = 0 ;
}
-
+
return bless \%got, "IO::Compress::Base::Parameters::Defaults" ;
}
@@ -563,7 +563,7 @@ sub IO::Compress::Base::Parameters::new
my $obj;
$obj->[IxError] = '';
- $obj->[IxGot] = {} ;
+ $obj->[IxGot] = {} ;
return bless $obj, 'IO::Compress::Base::Parameters' ;
}
@@ -578,13 +578,13 @@ sub IO::Compress::Base::Parameters::setError
$self->[IxError] = $error ;
return $retval;
}
-
+
sub IO::Compress::Base::Parameters::getError
{
my $self = shift ;
return $self->[IxError] ;
}
-
+
sub IO::Compress::Base::Parameters::parse
{
my $self = shift ;
@@ -603,21 +603,21 @@ sub IO::Compress::Base::Parameters::parse
}
elsif (@_ == 1) {
my $href = $_[0] ;
-
+
return $self->setError("Expected even number of parameters, got 1")
if ! defined $href or ! ref $href or ref $href ne "HASH" ;
-
+
foreach my $key (keys %$href) {
push @entered, $key ;
push @entered, \$href->{$key} ;
}
}
else {
-
+
my $count = @_;
return $self->setError("Expected even number of parameters, got $count")
if $count % 2 != 0 ;
-
+
for my $i (0.. $count / 2 - 1) {
push @entered, $_[2 * $i] ;
push @entered, \$_[2 * $i + 1] ;
@@ -626,22 +626,22 @@ sub IO::Compress::Base::Parameters::parse
foreach my $key (keys %$default)
{
-
+
my ($type, $value) = @{ $default->{$key} } ;
-
- if ($firstTime) {
- $got->{$key} = [0, $type, $value, $value] ;
+
+ if ($firstTime) {
+ $got->{$key} = [0, $type, $value, $value] ;
}
else
{
- $got->{$key}[OFF_PARSED] = 0 ;
- }
+ $got->{$key}[OFF_PARSED] = 0 ;
+ }
}
my %parsed = ();
-
-
+
+
for my $i (0.. @entered / 2 - 1) {
my $key = $entered[2* $i] ;
my $value = $entered[2* $i+1] ;
@@ -651,15 +651,15 @@ sub IO::Compress::Base::Parameters::parse
$key =~ s/^-// ;
my $canonkey = lc $key;
-
- if ($got->{$canonkey})
+
+ 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 ;
+ return $self->setError("Muliple instances of '$key' found")
+ if $parsed ;
my $s ;
$self->_checkType($key, $value, $type, 1, \$s)
@@ -672,7 +672,7 @@ sub IO::Compress::Base::Parameters::parse
else
{ push (@Bad, $key) }
}
-
+
if (@Bad) {
my ($bad) = join(", ", @Bad) ;
return $self->setError("unknown key value(s) $bad") ;
@@ -699,14 +699,14 @@ sub IO::Compress::Base::Parameters::_checkType
return $self->setError("Parameter '$key' not writable")
if readonly $$value ;
- if (ref $$value)
+ if (ref $$value)
{
return $self->setError("Parameter '$key' not a scalar reference")
if ref $$value ne 'SCALAR' ;
$$output = $$value ;
}
- else
+ else
{
return $self->setError("Parameter '$key' not a scalar")
if ref $value ne 'SCALAR' ;
@@ -727,13 +727,13 @@ sub IO::Compress::Base::Parameters::_checkType
}
elsif ($type & Parse_unsigned)
{
-
+
return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'")
if ! defined $value ;
return $self->setError("Parameter '$key' must be an unsigned int, got '$value'")
if $value !~ /^\d+$/;
-
- $$output = defined $value ? $value : 0 ;
+
+ $$output = defined $value ? $value : 0 ;
return 1;
}
elsif ($type & Parse_signed)
@@ -743,7 +743,7 @@ sub IO::Compress::Base::Parameters::_checkType
return $self->setError("Parameter '$key' must be a signed int, got '$value'")
if $value !~ /^-?\d+$/;
- $$output = defined $value ? $value : 0 ;
+ $$output = defined $value ? $value : 0 ;
return 1 ;
}
elsif ($type & Parse_boolean)
@@ -751,13 +751,13 @@ sub IO::Compress::Base::Parameters::_checkType
return $self->setError("Parameter '$key' must be an int, got '$value'")
if defined $value && $value !~ /^\d*$/;
- $$output = defined $value && $value != 0 ? 1 : 0 ;
+ $$output = defined $value && $value != 0 ? 1 : 0 ;
return 1;
}
elsif ($type & Parse_string)
{
- $$output = defined $value ? $value : "" ;
+ $$output = defined $value ? $value : "" ;
return 1;
}
elsif ($type & Parse_code)
@@ -765,10 +765,10 @@ sub IO::Compress::Base::Parameters::_checkType
return $self->setError("Parameter '$key' must be a code reference, got '$value'")
if (! defined $value || ref $value ne 'CODE') ;
- $$output = defined $value ? $value : "" ;
+ $$output = defined $value ? $value : "" ;
return 1;
}
-
+
$$output = $value ;
return 1;
}
@@ -787,7 +787,7 @@ sub IO::Compress::Base::Parameters::setValue
{
$_[0]->[IxGot]{$_[1]}[OFF_PARSED] = 1;
$_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] = $_[2] ;
- $_[0]->[IxGot]{$_[1]}[OFF_FIXED] = $_[2] ;
+ $_[0]->[IxGot]{$_[1]}[OFF_FIXED] = $_[2] ;
}
sub IO::Compress::Base::Parameters::valueRef
@@ -802,7 +802,7 @@ sub IO::Compress::Base::Parameters::valueOrDefault
my $default = shift ;
my $value = $self->[IxGot]{$name}[OFF_DEFAULT] ;
-
+
return $value if defined $value ;
return $default ;
}
@@ -841,12 +841,12 @@ sub new
{
return bless [ 0, 0 ], $_[0]
if @_ == 1 ;
-
+
return bless [ $_[1], 0 ], $_[0]
if @_ == 2 ;
-
- return bless [ $_[2], $_[1] ], $_[0]
- if @_ == 3 ;
+
+ return bless [ $_[2], $_[1] ], $_[0]
+ if @_ == 3 ;
}
sub newUnpack_V64
@@ -870,7 +870,7 @@ sub reset
sub clone
{
- bless [ @{$_[0]} ], ref $_[0] ;
+ bless [ @{$_[0]} ], ref $_[0] ;
}
sub getHigh
@@ -904,13 +904,13 @@ sub add
$_[0]->[HIGH] += $value->[HIGH] ;
$value = $value->[LOW];
}
- elsif ($value > MAX32) {
+ elsif ($value > MAX32) {
$_[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;
@@ -925,13 +925,13 @@ sub add32
# my $self = shift;
my $value = $_[1];
- if ($value > MAX32) {
+ if ($value > MAX32) {
$_[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;
@@ -977,6 +977,14 @@ sub equal
$self->[HIGH] == $other->[HIGH] ;
}
+sub isZero
+{
+ my $self = shift;
+
+ return $self->[LOW] == 0 &&
+ $self->[HIGH] == 0 ;
+}
+
sub gt
{
my $self = shift;
@@ -997,7 +1005,7 @@ sub cmp
return $self->[LOW] - $other->[LOW] ;
}
}
-
+
sub is64bit
{
@@ -1025,7 +1033,7 @@ sub pack_V64
}
-sub full32
+sub full32
{
return $_[0] == MAX32 ;
}