diff options
Diffstat (limited to 'cpan/IO-Compress/lib/IO/Compress/Base/Common.pm')
-rw-r--r-- | cpan/IO-Compress/lib/IO/Compress/Base/Common.pm | 180 |
1 files changed, 90 insertions, 90 deletions
diff --git a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm index c82c99a441..bd260d5354 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm +++ b/cpan/IO-Compress/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.081'; @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; @@ -997,7 +997,7 @@ sub cmp return $self->[LOW] - $other->[LOW] ; } } - + sub is64bit { @@ -1025,7 +1025,7 @@ sub pack_V64 } -sub full32 +sub full32 { return $_[0] == MAX32 ; } |