summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
committerKarl Berry <karl@freefriends.org>2012-11-20 18:08:54 +0000
commitc5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch)
tree02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
parent6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff)
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm111
1 files changed, 106 insertions, 5 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
index 1b38c59846a..c6c38181ef8 100644
--- a/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
+++ b/Master/tlpkg/tlperl/lib/IO/Compress/Base/Common.pm
@@ -11,15 +11,20 @@ use File::GlobMapper;
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.033';
+$VERSION = '2.048';
-@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput
+@EXPORT = qw( isaFilehandle isaFilename isaScalar
+ whatIsInput whatIsOutput
isaFileGlobString cleanFileGlobString oneTarget
setBinModeInput setBinModeOutput
ckInOutParams
createSelfTiedObject
getEncoding
+ isGeMax32
+
+ MAX32
+
WANT_CODE
WANT_EXT
WANT_UNDEF
@@ -42,7 +47,16 @@ use constant STATUS_OK => 0;
use constant STATUS_ENDSTREAM => 1;
use constant STATUS_EOF => 2;
use constant STATUS_ERROR => -1;
+use constant MAX16 => 0xFFFF ;
+use constant MAX32 => 0xFFFFFFFF ;
+use constant MAX32cmp => 0xFFFFFFFF + 1 - 1; # for 5.6.x on 32-bit need to force an non-IV value
+
+sub isGeMax32
+{
+ return $_[0] >= MAX32cmp ;
+}
+
sub hasEncode()
{
if (! defined $HAS_ENCODE) {
@@ -106,6 +120,11 @@ sub isaFilehandle($)
)
}
+sub isaScalar
+{
+ return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ;
+}
+
sub isaFilename($)
{
return (defined $_[0] and
@@ -451,7 +470,8 @@ sub createSelfTiedObject
$EXPORT_TAGS{Parse} = [qw( ParseParameters
Parse_any Parse_unsigned Parse_signed
- Parse_boolean Parse_custom Parse_string
+ Parse_boolean Parse_string
+ Parse_code
Parse_multiple Parse_writable_scalar
)
];
@@ -463,7 +483,7 @@ use constant Parse_unsigned => 0x02;
use constant Parse_signed => 0x04;
use constant Parse_boolean => 0x08;
use constant Parse_string => 0x10;
-use constant Parse_custom => 0x12;
+use constant Parse_code => 0x20;
#use constant Parse_store_ref => 0x100 ;
use constant Parse_multiple => 0x100 ;
@@ -499,6 +519,7 @@ sub ParseParameters
#package IO::Compress::Base::Parameters;
use strict;
+
use warnings;
use Carp;
@@ -741,6 +762,13 @@ sub IO::Compress::Base::Parameters::_checkType
$$output = defined $value ? $value != 0 : 0 ;
return 1;
}
+ elsif ($type & Parse_code)
+ {
+ return $self->setError("Parameter '$key' must be a code reference, got '$value'")
+ if $validate && (! defined $value || ref $value ne 'CODE') ;
+ $$output = defined $value ? $value : "" ;
+ return 1;
+ }
elsif ($type & Parse_string)
{
$$output = defined $value ? $value : "" ;
@@ -901,9 +929,13 @@ sub add
$self->[HIGH] += $value->[HIGH] ;
$value = $value->[LOW];
}
+ elsif ($value > MAX32) {
+ $self->[HIGH] += int($value / HI_1) ;
+ $value = $value % HI_1;
+ }
my $available = MAX32 - $self->[LOW] ;
-
+
if ($value > $available) {
++ $self->[HIGH] ;
$self->[LOW] = $value - $available - 1;
@@ -911,7 +943,33 @@ sub add
else {
$self->[LOW] += $value ;
}
+}
+
+sub subtract
+{
+ my $self = shift;
+ my $value = shift;
+ if (ref $value eq 'U64') {
+
+ if ($value->[HIGH]) {
+ die "bad"
+ if $self->[HIGH] == 0 ||
+ $value->[HIGH] > $self->[HIGH] ;
+
+ $self->[HIGH] -= $value->[HIGH] ;
+ }
+
+ $value = $value->[LOW] ;
+ }
+
+ if ($value > $self->[LOW]) {
+ -- $self->[HIGH] ;
+ $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ;
+ }
+ else {
+ $self->[LOW] -= $value;
+ }
}
sub equal
@@ -923,12 +981,40 @@ sub equal
$self->[HIGH] == $other->[HIGH] ;
}
+sub gt
+{
+ my $self = shift;
+ my $other = shift;
+
+ return $self->cmp($other) > 0 ;
+}
+
+sub cmp
+{
+ my $self = shift;
+ my $other = shift ;
+
+ if ($self->[LOW] == $other->[LOW]) {
+ return $self->[HIGH] - $other->[HIGH] ;
+ }
+ else {
+ return $self->[LOW] - $other->[LOW] ;
+ }
+}
+
+
sub is64bit
{
my $self = shift;
return $self->[HIGH] > 0 ;
}
+sub isAlmost64bit
+{
+ my $self = shift;
+ return $self->[HIGH] > 0 || $self->[LOW] == MAX32 ;
+}
+
sub getPacked_V64
{
my $self = shift;
@@ -951,6 +1037,21 @@ sub pack_V64
}
+sub full32
+{
+ return $_[0] == MAX32 ;
+}
+
+sub Value_VV64
+{
+ my $buffer = shift;
+
+ my ($lo, $hi) = unpack ("V V" , $buffer);
+ no warnings 'uninitialized';
+ return $hi * HI_1 + $lo;
+}
+
+
package IO::Compress::Base::Common;
1;