diff options
| author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-11-10 23:57:07 +0000 |
|---|---|---|
| committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-11-11 00:18:54 +0000 |
| commit | be0289ac5c2b662422f64a227eaf31bc406df15c (patch) | |
| tree | 8bb297a4e890bb4a56f9da423e8be68d4498532e /cpan/IO-Compress | |
| parent | 14c0f22a0f8ffd6e3f345a58a7f0022484e138ac (diff) | |
| download | perl-be0289ac5c2b662422f64a227eaf31bc406df15c.tar.gz | |
Update IO-Compress to CPAN version 2.057
[DELTA]
2.057 10 November 2012
* IO::Compress::Zip
Allow member name & Zip Comment to be "0"
* IO::Compress::Base::Common
Remove "-r" test - the file open will catch this.
RT# 80855: IO::Compress::Base::Common returns that it cannot read readable files in NFS
* RT# 79820: Install to 'site' instead of 'perl' when perl version is 5.11+
* General Performance improvements.
Diffstat (limited to 'cpan/IO-Compress')
32 files changed, 829 insertions, 751 deletions
diff --git a/cpan/IO-Compress/Changes b/cpan/IO-Compress/Changes index d02b19fcae..8ad6fe73a4 100644 --- a/cpan/IO-Compress/Changes +++ b/cpan/IO-Compress/Changes @@ -1,6 +1,19 @@ CHANGES ------- + 2.057 10 November 2012 + + * IO::Compress::Zip + Allow member name & Zip Comment to be "0" + + * IO::Compress::Base::Common + Remove "-r" test - the file open will catch this. + RT# 80855: IO::Compress::Base::Common returns that it cannot read readable files in NFS + + * RT# 79820: Install to 'site' instead of 'perl' when perl version is 5.11+ + + * General Performance improvements. + 2.055 5 August 2012 * FAQ diff --git a/cpan/IO-Compress/Makefile.PL b/cpan/IO-Compress/Makefile.PL index 9252165c9a..9a7e31fe82 100644 --- a/cpan/IO-Compress/Makefile.PL +++ b/cpan/IO-Compress/Makefile.PL @@ -3,7 +3,7 @@ use strict ; require 5.006 ; -$::VERSION = '2.055' ; +$::VERSION = '2.057' ; use private::MakeUtil; use ExtUtils::MakeMaker 5.16 ; @@ -39,7 +39,7 @@ WriteMakefile( : () ), - INSTALLDIRS => ($] >= 5.009 ? 'perl' : 'site'), + INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'), EXE_FILES => ['bin/zipdetails'], diff --git a/cpan/IO-Compress/README b/cpan/IO-Compress/README index af73e99f98..8973f7c1f3 100644 --- a/cpan/IO-Compress/README +++ b/cpan/IO-Compress/README @@ -1,9 +1,9 @@ IO-Compress - Version 2.055 + Version 2.057 - 5th August 2012 + 10th November 2012 Copyright (c) 1995-2012 Paul Marquess. All rights reserved. This program is free software; you can redistribute it @@ -89,7 +89,7 @@ To help me help you, I need all of the following information: If you haven't installed IO-Compress then search IO::Compress::Gzip.pm for a line like this: - $VERSION = "2.055" ; + $VERSION = "2.057" ; 2. If you are having problems building IO-Compress, send me a complete log of what happened. Start by unpacking the IO-Compress diff --git a/cpan/IO-Compress/lib/Compress/Zlib.pm b/cpan/IO-Compress/lib/Compress/Zlib.pm index 3f28578fd8..ac43436308 100644 --- a/cpan/IO-Compress/lib/Compress/Zlib.pm +++ b/cpan/IO-Compress/lib/Compress/Zlib.pm @@ -7,17 +7,17 @@ use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); -use IO::Compress::Base::Common 2.055 ; -use Compress::Raw::Zlib 2.055 ; -use IO::Compress::Gzip 2.055 ; -use IO::Uncompress::Gunzip 2.055 ; +use IO::Compress::Base::Common 2.057 ; +use Compress::Raw::Zlib 2.057 ; +use IO::Compress::Gzip 2.057 ; +use IO::Uncompress::Gunzip 2.057 ; use strict ; use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.055'; +$VERSION = '2.057'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -365,31 +365,31 @@ sub deflateInit(@) { my ($got) = ParseParameters(0, { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], - 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'MemLevel' => [1, 1, Parse_unsigned, MAX_MEM_LEVEL()], - 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], - 'Dictionary' => [1, 1, Parse_any, ""], + 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], + 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION()], + 'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED()], + 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], + 'memlevel' => [IO::Compress::Base::Common::Parse_unsigned, MAX_MEM_LEVEL()], + 'strategy' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFAULT_STRATEGY()], + 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_ ) ; croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; + $got->getValue('bufsize') + unless $got->getValue('bufsize') >= 1; my $obj ; my $status = 0 ; ($obj, $status) = Compress::Raw::Zlib::_deflateInit(0, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; + $got->getValue('level'), + $got->getValue('method'), + $got->getValue('windowbits'), + $got->getValue('memlevel'), + $got->getValue('strategy'), + $got->getValue('bufsize'), + $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; return wantarray ? ($x, $status) : $x ; @@ -399,22 +399,22 @@ sub inflateInit(@) { my ($got) = ParseParameters(0, { - 'Bufsize' => [1, 1, Parse_unsigned, 4096], - 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], - 'Dictionary' => [1, 1, Parse_any, ""], + 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], + 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], + 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_) ; croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . - $got->value('Bufsize') - unless $got->value('Bufsize') >= 1; + $got->getValue('bufsize') + unless $got->getValue('bufsize') >= 1; my $status = 0 ; my $obj ; ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, - $got->value('WindowBits'), - $got->value('Bufsize'), - $got->value('Dictionary')) ; + $got->getValue('windowbits'), + $got->getValue('bufsize'), + $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; @@ -461,7 +461,7 @@ sub inflate package Compress::Zlib ; -use IO::Compress::Gzip::Constants 2.055 ; +use IO::Compress::Gzip::Constants 2.057 ; sub memGzip($) { diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm index 162801781a..2971e92e7c 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); +use IO::Compress::Base::Common 2.057 qw(:Status); -use Compress::Raw::Bzip2 2.055 ; +use Compress::Raw::Bzip2 2.057 ; our ($VERSION); -$VERSION = '2.055'; +$VERSION = '2.057'; sub mkCompObject { diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm index 1bb20131b0..b3b9f53b5a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm @@ -4,13 +4,13 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); -use Compress::Raw::Zlib 2.055 qw( !crc32 !adler32 ) ; +use IO::Compress::Base::Common 2.057 qw(:Status); +use Compress::Raw::Zlib 2.057 qw( !crc32 !adler32 ) ; require Exporter; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); -$VERSION = '2.055'; +$VERSION = '2.057'; @ISA = qw(Exporter); @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm index e15e1074cf..3e8c4c885e 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); +use IO::Compress::Base::Common 2.057 qw(:Status); our ($VERSION); -$VERSION = '2.055'; +$VERSION = '2.057'; sub mkCompObject { diff --git a/cpan/IO-Compress/lib/IO/Compress/Base.pm b/cpan/IO-Compress/lib/IO/Compress/Base.pm index 6427eea71f..a18793e046 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Base.pm @@ -6,10 +6,10 @@ require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.055 ; +use IO::Compress::Base::Common 2.057 ; -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 ; @@ -20,7 +20,7 @@ use bytes; our (@ISA, $VERSION); @ISA = qw(Exporter IO::File); -$VERSION = '2.055'; +$VERSION = '2.057'; #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) { @@ -231,8 +236,8 @@ sub _create - if ($got->parsed('Encode')) { - my $want_encoding = $got->value('Encode'); + if ($got->parsed('encode')) { + my $want_encoding = $got->getValue('encode'); *$obj->{Encoding} = getEncoding($obj, $class, $want_encoding); } @@ -263,7 +268,7 @@ sub _create *$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 +297,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 +310,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 +319,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 +495,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 +528,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 +537,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); } diff --git a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm index a125ca515a..deb545dfa4 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm +++ b/cpan/IO-Compress/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.055'; +$VERSION = '2.057'; @EXPORT = qw( isaFilehandle isaFilename isaScalar whatIsInput whatIsOutput @@ -377,10 +377,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 +472,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 +486,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 +494,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 +512,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 +575,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 +614,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 +653,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 +698,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 +718,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 +728,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 +750,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 +802,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 +840,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 +866,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 +1002,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/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm index f96d28d9c5..5500527886 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.055 ; +use IO::Compress::Base 2.057 ; -use IO::Compress::Base::Common 2.055 qw(createSelfTiedObject); -use IO::Compress::Adapter::Bzip2 2.055 ; +use IO::Compress::Base::Common 2.057 qw(); +use IO::Compress::Adapter::Bzip2 2.057 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.055'; +$VERSION = '2.057'; $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.055 qw(:Parse); + use IO::Compress::Base::Common 2.057 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/cpan/IO-Compress/lib/IO/Compress/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm index 825d2ded73..e169b192f8 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm @@ -8,16 +8,16 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.055 (); -use IO::Compress::Adapter::Deflate 2.055 ; +use IO::Compress::RawDeflate 2.057 (); +use IO::Compress::Adapter::Deflate 2.057 ; -use IO::Compress::Zlib::Constants 2.055 ; -use IO::Compress::Base::Common 2.055 qw(createSelfTiedObject); +use IO::Compress::Zlib::Constants 2.057 ; +use IO::Compress::Base::Common 2.057 qw(); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.055'; +$VERSION = '2.057'; $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 ; } diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm index 1dd7ca71c4..702c6c72fb 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm @@ -8,12 +8,12 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.055 () ; -use IO::Compress::Adapter::Deflate 2.055 ; +use IO::Compress::RawDeflate 2.057 () ; +use IO::Compress::Adapter::Deflate 2.057 ; -use IO::Compress::Base::Common 2.055 qw(:Status :Parse isaScalar createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.055 ; -use IO::Compress::Zlib::Extra 2.055 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Compress::Gzip::Constants 2.057 ; +use IO::Compress::Zlib::Extra 2.057 ; BEGIN { @@ -25,7 +25,7 @@ BEGIN our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.055'; +$VERSION = '2.057'; $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); diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm index 598d720726..d86624bda1 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.055'; +$VERSION = '2.057'; @ISA = qw(Exporter); diff --git a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm index de33a02d42..d3f432c2b1 100644 --- a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm @@ -6,16 +6,15 @@ use strict ; use warnings; use bytes; - -use IO::Compress::Base 2.055 ; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); -use IO::Compress::Adapter::Deflate 2.055 ; +use IO::Compress::Base 2.057 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Compress::Adapter::Deflate 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.055'; +$VERSION = '2.057'; $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.055 qw(:Parse); - use Compress::Raw::Zlib 2.055 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); +use IO::Compress::Base::Common 2.057 qw(:Parse); +use Compress::Raw::Zlib 2.057 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 diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip.pm b/cpan/IO-Compress/lib/IO/Compress/Zip.pm index e25b8fd9b2..3c66ae75ef 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip.pm @@ -4,30 +4,30 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status MAX32 isGeMax32 isaScalar createSelfTiedObject); -use IO::Compress::RawDeflate 2.055 (); -use IO::Compress::Adapter::Deflate 2.055 ; -use IO::Compress::Adapter::Identity 2.055 ; -use IO::Compress::Zlib::Extra 2.055 ; -use IO::Compress::Zip::Constants 2.055 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Compress::RawDeflate 2.057 (); +use IO::Compress::Adapter::Deflate 2.057 ; +use IO::Compress::Adapter::Identity 2.057 ; +use IO::Compress::Zlib::Extra 2.057 ; +use IO::Compress::Zip::Constants 2.057 ; use File::Spec(); use Config; -use Compress::Raw::Zlib 2.055 (); +use Compress::Raw::Zlib 2.057 (); BEGIN { eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.055 ; + import IO::Compress::Adapter::Bzip2 2.057 ; require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.055 ; + import IO::Compress::Bzip2 2.057 ; } ; eval { require IO::Compress::Adapter::Lzma ; - import IO::Compress::Adapter::Lzma 2.055 ; + import IO::Compress::Adapter::Lzma 2.057 ; require IO::Compress::Lzma ; - import IO::Compress::Lzma 2.055 ; + import IO::Compress::Lzma 2.057 ; } ; } @@ -36,7 +36,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.055'; +$VERSION = '2.057'; $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); } @@ -233,20 +233,20 @@ sub mkHeader *$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 ; @@ -256,12 +256,12 @@ sub mkHeader 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. @@ -270,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 @@ -278,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,13 +323,13 @@ sub mkHeader if $method == ZIP_CM_LZMA ; #$gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING - #if $param->value('UTF8') && length($filename) + length($comment); + #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; @@ -337,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 @@ -390,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() ; @@ -400,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; @@ -488,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 ; @@ -531,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 ; } @@ -562,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}; @@ -616,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) ; } } @@ -634,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' ; } @@ -663,58 +663,53 @@ sub outputPayload # return $self->mkHeader(*$self->{Got}); #} -sub getExtraParams -{ - my $self = shift ; - - use IO::Compress::Base::Common 2.055 qw(:Parse); - use Compress::Raw::Zlib 2.055 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], + + IO::Compress::RawDeflate::getZlibParams(), + defined $IO::Compress::Bzip2::VERSION + ? IO::Compress::Bzip2::getExtraParams() + : () + + + ); - @Bzip2, - ); +sub getExtraParams +{ + return %PARAMS ; } sub getInverseClass @@ -729,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] ; @@ -749,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) ; } diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm index 390f10527f..3e1a0a0be9 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.055'; +$VERSION = '2.057'; @ISA = qw(Exporter); diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm index 693b435b2c..a1b22d3a1b 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.055'; +$VERSION = '2.057'; @ISA = qw(Exporter); diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm index 98873144d2..8b840fff3a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.055'; +$VERSION = '2.057'; -use IO::Compress::Gzip::Constants 2.055 ; +use IO::Compress::Gzip::Constants 2.057 ; sub ExtraFieldError { diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm index 35ed15f322..c4c5e5c1a0 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); +use IO::Compress::Base::Common 2.057 qw(:Status); -use Compress::Raw::Bzip2 2.055 ; +use Compress::Raw::Bzip2 2.057 ; our ($VERSION, @ISA); -$VERSION = '2.055'; +$VERSION = '2.057'; sub mkUncompObject { diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm index bd33ebc76a..c4345bba3f 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,14 +4,14 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); +use IO::Compress::Base::Common 2.057 qw(:Status); use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.055'; +$VERSION = '2.057'; -use Compress::Raw::Zlib 2.055 (); +use Compress::Raw::Zlib 2.057 (); sub mkUncompObject { diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm index cfa4e98d50..f65ed67279 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status); -use Compress::Raw::Zlib 2.055 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common 2.057 qw(:Status); +use Compress::Raw::Zlib 2.057 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); -$VERSION = '2.055'; +$VERSION = '2.057'; diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm index 7a971fc3ed..d6602f0e22 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm @@ -6,22 +6,22 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.057 (); -use IO::Uncompress::Adapter::Inflate 2.055 (); +use IO::Uncompress::Adapter::Inflate 2.057 (); -use IO::Uncompress::Base 2.055 ; -use IO::Uncompress::Gunzip 2.055 ; -use IO::Uncompress::Inflate 2.055 ; -use IO::Uncompress::RawInflate 2.055 ; -use IO::Uncompress::Unzip 2.055 ; +use IO::Uncompress::Base 2.057 ; +use IO::Uncompress::Gunzip 2.057 ; +use IO::Uncompress::Inflate 2.057 ; +use IO::Uncompress::RawInflate 2.057 ; +use IO::Uncompress::Unzip 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.055'; +$VERSION = '2.057'; $AnyInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -36,20 +36,20 @@ Exporter::export_ok_tags('all'); sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$AnyInflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError); $obj->_create(undef, 0, @_); } sub anyinflate { - my $obj = createSelfTiedObject(undef, \$AnyInflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyInflateError); return $obj->_inf(@_) ; } sub getExtraParams { - use IO::Compress::Base::Common 2.055 qw(:Parse); - return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ) ; + use IO::Compress::Base::Common 2.057 qw(:Parse); + return ( 'rawinflate' => [Parse_boolean, 0] ) ; } sub ckParams @@ -58,8 +58,8 @@ sub ckParams my $got = shift ; # any always needs both crc32 and adler32 - $got->value('CRC32' => 1); - $got->value('ADLER32' => 1); + $got->setValue('crc32' => 1); + $got->setValue('adler32' => 1); return 1; } @@ -78,7 +78,7 @@ sub mkUncomp my @possible = qw( Inflate Gunzip Unzip ); unshift @possible, 'RawInflate' - if 1 || $got->value('RawInflate'); + if 1 || $got->getValue('rawinflate'); my $magic = $self->ckMagic( @possible ); @@ -799,6 +799,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm index 1d93c4f018..53c9091100 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm @@ -4,16 +4,16 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(createSelfTiedObject); +use IO::Compress::Base::Common 2.057 (); -use IO::Uncompress::Base 2.055 ; +use IO::Uncompress::Base 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.055'; +$VERSION = '2.057'; $AnyUncompressError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -27,42 +27,41 @@ Exporter::export_ok_tags('all'); BEGIN { - eval ' use IO::Uncompress::Adapter::Inflate 2.055 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.055 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.055 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.055 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.055 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.055 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.055 ;'; - eval ' use IO::Uncompress::UnLzop 2.055 ;'; - eval ' use IO::Uncompress::Gunzip 2.055 ;'; - eval ' use IO::Uncompress::Inflate 2.055 ;'; - eval ' use IO::Uncompress::RawInflate 2.055 ;'; - eval ' use IO::Uncompress::Unzip 2.055 ;'; - eval ' use IO::Uncompress::UnLzf 2.055 ;'; - eval ' use IO::Uncompress::UnLzma 2.055 ;'; - eval ' use IO::Uncompress::UnXz 2.055 ;'; + eval ' use IO::Uncompress::Adapter::Inflate 2.057 ;'; + eval ' use IO::Uncompress::Adapter::Bunzip2 2.057 ;'; + eval ' use IO::Uncompress::Adapter::LZO 2.057 ;'; + eval ' use IO::Uncompress::Adapter::Lzf 2.057 ;'; + eval ' use IO::Uncompress::Adapter::UnLzma 2.057 ;'; + eval ' use IO::Uncompress::Adapter::UnXz 2.057 ;'; + + eval ' use IO::Uncompress::Bunzip2 2.057 ;'; + eval ' use IO::Uncompress::UnLzop 2.057 ;'; + eval ' use IO::Uncompress::Gunzip 2.057 ;'; + eval ' use IO::Uncompress::Inflate 2.057 ;'; + eval ' use IO::Uncompress::RawInflate 2.057 ;'; + eval ' use IO::Uncompress::Unzip 2.057 ;'; + eval ' use IO::Uncompress::UnLzf 2.057 ;'; + eval ' use IO::Uncompress::UnLzma 2.057 ;'; + eval ' use IO::Uncompress::UnXz 2.057 ;'; } sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$AnyUncompressError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyUncompressError); $obj->_create(undef, 0, @_); } sub anyuncompress { - my $obj = createSelfTiedObject(undef, \$AnyUncompressError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyUncompressError); return $obj->_inf(@_) ; } sub getExtraParams -{ - use IO::Compress::Base::Common 2.055 qw(:Parse); - return ( 'RawInflate' => [1, 1, Parse_boolean, 0] , - 'UnLzma' => [1, 1, Parse_boolean, 0] ) ; +{ + return ( 'rawinflate' => [IO::Compress::Base::Common::Parse_boolean, 0] , + 'unlzma' => [IO::Compress::Base::Common::Parse_boolean, 0] ) ; } sub ckParams @@ -71,8 +70,8 @@ sub ckParams my $got = shift ; # any always needs both crc32 and adler32 - $got->value('CRC32' => 1); - $got->value('ADLER32' => 1); + $got->setValue('crc32' => 1); + $got->setValue('adler32' => 1); return 1; } @@ -96,7 +95,7 @@ sub mkUncomp my @possible = qw( Inflate Gunzip Unzip ); unshift @possible, 'RawInflate' - if $got->value('RawInflate'); + if $got->getValue('rawinflate'); $magic = $self->ckMagic( @possible ); @@ -108,7 +107,7 @@ sub mkUncomp } } - if (defined $IO::Uncompress::UnLzma::VERSION && $got->value('UnLzma')) + if (defined $IO::Uncompress::UnLzma::VERSION && $got->getValue('unlzma')) { my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnLzma::mkUncompObject(); @@ -119,7 +118,7 @@ sub mkUncomp my @possible = qw( UnLzma ); #unshift @possible, 'RawInflate' - # if $got->value('RawInflate'); + # if $got->getValue('rawinflate'); if ( *$self->{Info} = $self->ckMagic( @possible )) { @@ -847,6 +846,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm index 0b66385b25..5c34b819e8 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm @@ -9,17 +9,17 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(Exporter IO::File); -$VERSION = '2.055'; +$VERSION = '2.057'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.055 ; +use IO::Compress::Base::Common 2.057 ; use IO::File ; use Symbol; -use Scalar::Util qw(readonly); -use List::Util qw(min); +use Scalar::Util (); +use List::Util (); use Carp ; %EXPORT_TAGS = ( ); @@ -39,7 +39,7 @@ sub smartRead if (defined *$self->{InputLength}) { return 0 if *$self->{InputLengthRemaining} <= 0 ; - $size = min($size, *$self->{InputLengthRemaining}); + $size = List::Util::min($size, *$self->{InputLengthRemaining}); } if ( length *$self->{Prime} ) { @@ -348,34 +348,34 @@ sub checkParams my $got = shift || IO::Compress::Base::Parameters::new(); my $Valid = { - 'BlockSize' => [1, 1, Parse_unsigned, 16 * 1024], - 'AutoClose' => [1, 1, Parse_boolean, 0], - 'Strict' => [1, 1, Parse_boolean, 0], - 'Append' => [1, 1, Parse_boolean, 0], - 'Prime' => [1, 1, Parse_any, undef], - 'MultiStream' => [1, 1, Parse_boolean, 0], - 'Transparent' => [1, 1, Parse_any, 1], - 'Scan' => [1, 1, Parse_boolean, 0], - 'InputLength' => [1, 1, Parse_unsigned, undef], - 'BinModeOut' => [1, 1, Parse_boolean, 0], - #'Encode' => [1, 1, Parse_any, undef], - - #'ConsumeInput' => [1, 1, Parse_boolean, 0], - + 'blocksize' => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024], + 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'strict' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'append' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'prime' => [IO::Compress::Base::Common::Parse_any, undef], + 'multistream' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'transparent' => [IO::Compress::Base::Common::Parse_any, 1], + 'scan' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'inputlength' => [IO::Compress::Base::Common::Parse_unsigned, undef], + 'binmodeout' => [IO::Compress::Base::Common::Parse_boolean, 0], + #'encode' => [IO::Compress::Base::Common::Parse_any, undef], + + #'consumeinput' => [IO::Compress::Base::Common::Parse_boolean, 0], + $self->getExtraParams(), #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0, # ContinueAfterEof } ; - $Valid->{TrailingData} = [1, 1, Parse_writable_scalar, undef] + $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef] if *$self->{OneShot} ; $got->parse($Valid, @_ ) - or $self->croakError("${class}: $got->{Error}") ; + or $self->croakError("${class}: " . $got->getError()) ; $self->postCheckParams($got) - or $self->croakError("${class}: " . $self->error()) ; + or $self->croakError("${class}: " . $self->error()) ; return $got; } @@ -392,7 +392,7 @@ sub _create my $inValue = shift ; - *$obj->{OneShot} = 0 ; + *$obj->{OneShot} = 0 ; if (! $got) { @@ -422,12 +422,12 @@ sub _create # Need to rewind for Scan *$obj->{FH}->seek(0, SEEK_SET) - if $got->value('Scan'); + if $got->getValue('scan'); } else { no warnings ; my $mode = '<'; - $mode = '+<' if $got->value('Scan'); + $mode = '+<' if $got->getValue('scan'); *$obj->{StdIO} = ($inValue eq '-'); *$obj->{FH} = new IO::File "$mode $inValue" or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ; @@ -440,32 +440,32 @@ sub _create *$obj->{Buffer} = \$buff ; } - if ($got->parsed('Encode')) { - my $want_encoding = $got->value('Encode'); + if ($got->parsed('encode')) { + my $want_encoding = $got->getValue('encode'); *$obj->{Encoding} = getEncoding($obj, $class, $want_encoding); } - *$obj->{InputLength} = $got->parsed('InputLength') - ? $got->value('InputLength') + *$obj->{InputLength} = $got->parsed('inputlength') + ? $got->getValue('inputlength') : undef ; - *$obj->{InputLengthRemaining} = $got->value('InputLength'); + *$obj->{InputLengthRemaining} = $got->getValue('inputlength'); *$obj->{BufferOffset} = 0 ; - *$obj->{AutoClose} = $got->value('AutoClose'); - *$obj->{Strict} = $got->value('Strict'); - *$obj->{BlockSize} = $got->value('BlockSize'); - *$obj->{Append} = $got->value('Append'); - *$obj->{AppendOutput} = $append_mode || $got->value('Append'); - *$obj->{ConsumeInput} = $got->value('ConsumeInput'); - *$obj->{Transparent} = $got->value('Transparent'); - *$obj->{MultiStream} = $got->value('MultiStream'); + *$obj->{AutoClose} = $got->getValue('autoclose'); + *$obj->{Strict} = $got->getValue('strict'); + *$obj->{BlockSize} = $got->getValue('blocksize'); + *$obj->{Append} = $got->getValue('append'); + *$obj->{AppendOutput} = $append_mode || $got->getValue('append'); + *$obj->{ConsumeInput} = $got->getValue('consumeinput'); + *$obj->{Transparent} = $got->getValue('transparent'); + *$obj->{MultiStream} = $got->getValue('multistream'); # TODO - move these two into RawDeflate - *$obj->{Scan} = $got->value('Scan'); - *$obj->{ParseExtra} = $got->value('ParseExtra') - || $got->value('Strict') ; + *$obj->{Scan} = $got->getValue('scan'); + *$obj->{ParseExtra} = $got->getValue('parseextra') + || $got->getValue('strict') ; *$obj->{Type} = ''; - *$obj->{Prime} = $got->value('Prime') || '' ; + *$obj->{Prime} = $got->getValue('prime') || '' ; *$obj->{Pending} = ''; *$obj->{Plain} = 0; *$obj->{PlainBytesRead} = 0; @@ -577,13 +577,36 @@ sub _inf my $got = $obj->checkParams($name, undef, @_) or return undef ; - if ($got->parsed('TrailingData')) + if ($got->parsed('trailingdata')) { - *$obj->{TrailingData} = $got->value('TrailingData'); +# my $value = $got->valueRef('TrailingData'); +# warn "TD $value "; +# #$value = $$value; +## warn "TD $value $$value "; +# +# return retErr($obj, "Parameter 'TrailingData' not writable") +# if readonly $$value ; +# +# if (ref $$value) +# { +# return retErr($obj,"Parameter 'TrailingData' not a scalar reference") +# if ref $$value ne 'SCALAR' ; +# +# *$obj->{TrailingData} = $$value ; +# } +# else +# { +# return retErr($obj,"Parameter 'TrailingData' not a scalar") +# if ref $value ne 'SCALAR' ; +# +# *$obj->{TrailingData} = $value ; +# } + + *$obj->{TrailingData} = $got->getValue('trailingdata'); } - *$obj->{MultiStream} = $got->value('MultiStream'); - $got->value('MultiStream', 0); + *$obj->{MultiStream} = $got->getValue('multistream'); + $got->setValue('multistream', 0); $x->{Got} = $got ; @@ -663,17 +686,17 @@ sub _singleTarget if ($x->{outType} eq 'filename') { my $mode = '>' ; $mode = '>>' - if $x->{Got}->value('Append') ; + if $x->{Got}->getValue('append') ; $x->{fh} = new IO::File "$mode $output" or return retErr($x, "cannot open file '$output': $!") ; - binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut'); + binmode $x->{fh} if $x->{Got}->valueOrDefault('binmodeout'); } elsif ($x->{outType} eq 'handle') { $x->{fh} = $output; - binmode $x->{fh} if $x->{Got}->valueOrDefault('BinModeOut'); - if ($x->{Got}->value('Append')) { + binmode $x->{fh} if $x->{Got}->valueOrDefault('binmodeout'); + if ($x->{Got}->getValue('append')) { seek($x->{fh}, 0, SEEK_END) or return retErr($x, "Cannot seek to end of output filehandle: $!") ; } @@ -683,7 +706,7 @@ sub _singleTarget elsif ($x->{outType} eq 'buffer' ) { $$output = '' - unless $x->{Got}->value('Append'); + unless $x->{Got}->getValue('append'); $x->{buff} = $output ; } @@ -703,7 +726,7 @@ sub _singleTarget if ( ($x->{outType} eq 'filename' && $output ne '-') || - ($x->{outType} eq 'handle' && $x->{Got}->value('AutoClose'))) { + ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) { $x->{fh}->close() or return retErr($x, $!); delete $x->{fh}; @@ -719,7 +742,7 @@ sub _rd2 my $input = shift; my $output = shift; - my $z = createSelfTiedObject($x->{Class}, *$self->{Error}); + my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error}); $z->_create($x->{Got}, 1, $input, @_) or return undef ; @@ -803,7 +826,7 @@ sub readBlock *$self->{CompressedInputLengthDone} = 1; return STATUS_OK ; } - $size = min($size, *$self->{CompressedInputLengthRemaining} ); + $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} ); *$self->{CompressedInputLengthRemaining} -= $size ; } @@ -1073,7 +1096,7 @@ sub read if (ref $_[0] ) { $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only") - if readonly(${ $_[0] }); + if Scalar::Util::readonly(${ $_[0] }); $self->croakError(*$self->{ClassName} . "::read: not a scalar reference $_[0]" ) unless ref $_[0] eq 'SCALAR' ; @@ -1081,7 +1104,7 @@ sub read } else { $self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only") - if readonly($_[0]); + if Scalar::Util::readonly($_[0]); $buffer = \$_[0] ; } @@ -1402,7 +1425,7 @@ sub seek my $offset = $target - $here ; my $got; - while (($got = $self->read(my $buffer, min($offset, *$self->{BlockSize})) ) > 0) + while (($got = $self->read(my $buffer, List::Util::min($offset, *$self->{BlockSize})) ) > 0) { $offset -= $got; last if $offset == 0 ; diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm index 4797c9c4c4..199d0ee373 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); +use IO::Compress::Base::Common 2.057 qw(:Status ); -use IO::Uncompress::Base 2.055 ; -use IO::Uncompress::Adapter::Bunzip2 2.055 ; +use IO::Uncompress::Base 2.057 ; +use IO::Uncompress::Adapter::Bunzip2 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error); -$VERSION = '2.055'; +$VERSION = '2.057'; $Bunzip2Error = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -25,26 +25,22 @@ push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$Bunzip2Error); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bunzip2Error); $obj->_create(undef, 0, @_); } sub bunzip2 { - my $obj = createSelfTiedObject(undef, \$Bunzip2Error); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bunzip2Error); return $obj->_inf(@_); } sub getExtraParams { - my $self = shift ; - - use IO::Compress::Base::Common 2.055 qw(:Parse); - return ( - 'Verbosity' => [1, 1, Parse_boolean, 0], - 'Small' => [1, 1, Parse_boolean, 0], + 'verbosity' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'small' => [IO::Compress::Base::Common::Parse_boolean, 0], ); } @@ -68,8 +64,8 @@ sub mkUncomp *$self->{Info} = $self->readHeader($magic) or return undef ; - my $Small = $got->value('Small'); - my $Verbosity = $got->value('Verbosity'); + my $Small = $got->getValue('small'); + my $Verbosity = $got->getValue('verbosity'); my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Bunzip2::mkUncompObject( $Small, $Verbosity); diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm index 2d190f45f5..b57b96f2ae 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm @@ -9,12 +9,12 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.055 ; +use IO::Uncompress::RawInflate 2.057 ; -use Compress::Raw::Zlib 2.055 () ; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); -use IO::Compress::Gzip::Constants 2.055 ; -use IO::Compress::Zlib::Extra 2.055 ; +use Compress::Raw::Zlib 2.057 () ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Compress::Gzip::Constants 2.057 ; +use IO::Compress::Zlib::Extra 2.057 ; require Exporter ; @@ -28,27 +28,26 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.055'; +$VERSION = '2.057'; sub new { my $class = shift ; $GunzipError = ''; - my $obj = createSelfTiedObject($class, \$GunzipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GunzipError); $obj->_create(undef, 0, @_); } sub gunzip { - my $obj = createSelfTiedObject(undef, \$GunzipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GunzipError); return $obj->_inf(@_) ; } sub getExtraParams { - use IO::Compress::Base::Common 2.055 qw(:Parse); - return ( 'ParseExtra' => [1, 1, Parse_boolean, 0] ) ; + return ( 'parseextra' => [IO::Compress::Base::Common::Parse_boolean, 0] ) ; } sub ckParams @@ -57,7 +56,7 @@ sub ckParams my $got = shift ; # gunzip always needs crc32 - $got->value('CRC32' => 1); + $got->setValue('crc32' => 1); return 1; } @@ -923,6 +922,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm index 433172dc5d..621049dfe8 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); -use IO::Compress::Zlib::Constants 2.055 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Compress::Zlib::Constants 2.057 ; -use IO::Uncompress::RawInflate 2.055 ; +use IO::Uncompress::RawInflate 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.055'; +$VERSION = '2.057'; $InflateError = ''; @ISA = qw( Exporter IO::Uncompress::RawInflate ); @@ -26,14 +26,14 @@ Exporter::export_ok_tags('all'); sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$InflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$InflateError); $obj->_create(undef, 0, @_); } sub inflate { - my $obj = createSelfTiedObject(undef, \$InflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$InflateError); return $obj->_inf(@_); } @@ -48,7 +48,7 @@ sub ckParams my $got = shift ; # gunzip always needs adler32 - $got->value('ADLER32' => 1); + $got->setValue('adler32' => 1); return 1; } @@ -794,6 +794,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm index 9d5e2c81c1..9dae685abc 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.055 ; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); +use Compress::Raw::Zlib 2.057 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); -use IO::Uncompress::Base 2.055 ; -use IO::Uncompress::Adapter::Inflate 2.055 ; +use IO::Uncompress::Base 2.057 ; +use IO::Uncompress::Adapter::Inflate 2.057 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.055'; +$VERSION = '2.057'; $RawInflateError = ''; @ISA = qw( Exporter IO::Uncompress::Base ); @@ -45,13 +45,13 @@ Exporter::export_ok_tags('all'); sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$RawInflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$RawInflateError); $obj->_create(undef, 0, @_); } sub rawinflate { - my $obj = createSelfTiedObject(undef, \$RawInflateError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$RawInflateError); return $obj->_inf(@_); } @@ -74,9 +74,9 @@ sub mkUncomp my $got = shift ; my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject( - $got->value('CRC32'), - $got->value('ADLER32'), - $got->value('Scan'), + $got->getValue('crc32'), + $got->getValue('adler32'), + $got->getValue('scan'), ); return $self->saveErrorString(undef, $errstr, $errno) @@ -332,8 +332,8 @@ sub createDeflate my ($def, $status) = *$self->{Uncomp}->createDeflateStream( -AppendOutput => 1, -WindowBits => - MAX_WBITS, - -CRC32 => *$self->{Params}->value('CRC32'), - -ADLER32 => *$self->{Params}->value('ADLER32'), + -CRC32 => *$self->{Params}->getValue('crc32'), + -ADLER32 => *$self->{Params}->getValue('adler32'), ); return wantarray ? ($status, $def) : $def ; @@ -922,6 +922,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm index 7d770ba682..84375f2362 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm @@ -9,21 +9,21 @@ use warnings; use bytes; use IO::File; -use IO::Uncompress::RawInflate 2.055 ; -use IO::Compress::Base::Common 2.055 qw(:Status createSelfTiedObject); -use IO::Uncompress::Adapter::Inflate 2.055 ; -use IO::Uncompress::Adapter::Identity 2.055 ; -use IO::Compress::Zlib::Extra 2.055 ; -use IO::Compress::Zip::Constants 2.055 ; +use IO::Uncompress::RawInflate 2.057 ; +use IO::Compress::Base::Common 2.057 qw(:Status ); +use IO::Uncompress::Adapter::Inflate 2.057 ; +use IO::Uncompress::Adapter::Identity 2.057 ; +use IO::Compress::Zlib::Extra 2.057 ; +use IO::Compress::Zip::Constants 2.057 ; -use Compress::Raw::Zlib 2.055 () ; +use Compress::Raw::Zlib 2.057 () ; BEGIN { - eval { require IO::Uncompress::Adapter::Bunzip2 ; + eval{ require IO::Uncompress::Adapter::Bunzip2 ; import IO::Uncompress::Adapter::Bunzip2 } ; - eval { require IO::Uncompress::Adapter::UnLzma ; - import IO::Uncompress::Adapter::UnLzma } ; + eval{ require IO::Uncompress::Adapter::UnLzma ; + import IO::Uncompress::Adapter::UnLzma } ; } @@ -31,7 +31,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.055'; +$VERSION = '2.057'; $UnzipError = ''; @ISA = qw(Exporter IO::Uncompress::RawInflate); @@ -52,27 +52,25 @@ Exporter::export_ok_tags('all'); sub new { my $class = shift ; - my $obj = createSelfTiedObject($class, \$UnzipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$UnzipError); $obj->_create(undef, 0, @_); } sub unzip { - my $obj = createSelfTiedObject(undef, \$UnzipError); + my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$UnzipError); return $obj->_inf(@_) ; } sub getExtraParams { - use IO::Compress::Base::Common 2.055 qw(:Parse); - - + return ( # # Zip header fields - 'Name' => [1, 1, Parse_any, undef], - - 'Stream' => [1, 1, Parse_boolean, 0], + 'name' => [IO::Compress::Base::Common::Parse_any, undef], + 'stream' => [IO::Compress::Base::Common::Parse_boolean, 0], + # TODO - This means reading the central directory to get # 1. the local header offsets # 2. The compressed data length @@ -85,9 +83,9 @@ sub ckParams my $got = shift ; # unzip always needs crc32 - $got->value('CRC32' => 1); + $got->setValue('crc32' => 1); - *$self->{UnzipData}{Name} = $got->value('Name'); + *$self->{UnzipData}{Name} = $got->getValue('name'); return 1; } @@ -1623,6 +1621,13 @@ Provides a sub-set of the C<seek> functionality, with the restriction that it is only legal to seek forward in the input file/buffer. It is a fatal error to attempt to seek backward. +Note that the implementation of C<seek> in this module does not provide +true random access to a compressed file/buffer. It works by uncompressing +data from the current offset in the file/buffer until it reaches the +ucompressed offset specified in the parameters to C<seek>. For very small +files this may be acceptable behaviour. For large files it may cause an +unacceptable delay. + The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. diff --git a/cpan/IO-Compress/t/000prereq.t b/cpan/IO-Compress/t/000prereq.t index 46e1054870..0751b1b892 100644 --- a/cpan/IO-Compress/t/000prereq.t +++ b/cpan/IO-Compress/t/000prereq.t @@ -25,7 +25,7 @@ BEGIN if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - my $VERSION = '2.055'; + my $VERSION = '2.057'; my @NAMES = qw( Compress::Raw::Bzip2 Compress::Raw::Zlib diff --git a/cpan/IO-Compress/t/006zip.t b/cpan/IO-Compress/t/006zip.t index b4d1e649fb..ad05cef376 100644 --- a/cpan/IO-Compress/t/006zip.t +++ b/cpan/IO-Compress/t/006zip.t @@ -19,7 +19,7 @@ BEGIN { $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 95 + $extra ; + plan tests => 101 + $extra ; use_ok('IO::Compress::Zip', qw(:all)) ; use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; @@ -330,3 +330,31 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available"; } + +{ + title "Memember & Comment 0"; + + my $lex = new LexFile my $file1; + + my $content = 'hello' ; + + + my $zip = new IO::Compress::Zip $file1, + Name => "0", Comment => "0" ; + isa_ok $zip, "IO::Compress::Zip"; + + is $zip->write($content), length($content), "write"; + + ok $zip->close(), "closed"; + + + + my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_ + or die "Cannot open $file1: $UnzipError"; + + isa_ok $u, "IO::Uncompress::Unzip"; + + my $name = $u->getHeaderInfo()->{Name}; + + is $u->getHeaderInfo()->{Name}, "0", "Name is '0'"; +} diff --git a/cpan/IO-Compress/t/01misc.t b/cpan/IO-Compress/t/01misc.t index 528b71f034..987e067341 100644 --- a/cpan/IO-Compress/t/01misc.t +++ b/cpan/IO-Compress/t/01misc.t @@ -19,7 +19,7 @@ BEGIN { $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - plan tests => 140 + $extra ; + plan tests => 150 + $extra ; use_ok('Scalar::Util'); use_ok('IO::Compress::Base::Common'); @@ -47,24 +47,24 @@ sub My::testParseParameters() like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_boolean, 0]}, Fred => 'joe') ; }; - like $@, mkErr("Parameter 'Fred' must be an int, got 'joe'"), + eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; }; + like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), "wanted unsigned, got undef"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_unsigned, 0]}, Fred => undef) ; }; - like $@, mkErr("Parameter 'Fred' must be an unsigned int, got 'undef'"), + eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; }; + like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), "wanted unsigned, got undef"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_signed, 0]}, Fred => undef) ; }; - like $@, mkErr("Parameter 'Fred' must be a signed int, got 'undef'"), + eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; }; + like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), "wanted signed, got undef"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_signed, 0]}, Fred => 'abc') ; }; - like $@, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"), + eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; }; + like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), "wanted signed, got 'abc'"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_code, undef]}, Fred => 'abc') ; }; - like $@, mkErr("Parameter 'Fred' must be a code reference, got 'abc'"), + eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; }; + like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), "wanted code, got 'abc'"; @@ -75,86 +75,84 @@ sub My::testParseParameters() skip 'readonly + threads', 1 if $Config{useithreads}; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => 'abc') ; }; - like $@, mkErr("Parameter 'Fred' not writable"), + eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; }; + like $@, mkErr("Parameter 'fred' not writable"), "wanted writable, got readonly"; } + eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; }; + like $@, mkErr("Parameter 'fred' not writable"), + "wanted writable, got readonly"; + my @xx; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => \@xx) ; }; - like $@, mkErr("Parameter 'Fred' not a scalar reference"), + eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; }; + like $@, mkErr("Parameter 'fred' not a scalar reference"), "wanted scalar reference"; local *ABC; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, 0]}, Fred => *ABC) ; }; - like $@, mkErr("Parameter 'Fred' not a scalar"), + eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; }; + like $@, mkErr("Parameter 'fred' not a scalar"), "wanted scalar"; - eval { ParseParameters(1, {'Fred' => [1, 1, Parse_any, 0]}, Fred => 1, Fred => 2) ; }; - like $@, mkErr("Muliple instances of 'Fred' found"), + eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; }; + like $@, mkErr("Muliple instances of 'fred' found"), "multiple instances"; - my $g = ParseParameters(1, {'Fred' => [1, 1, Parse_unsigned|Parse_multiple, 7]}, Fred => 1, Fred => 2) ; - is_deeply $g->value('Fred'), [ 1, 2 ] ; +# my $g = ParseParameters(1, {'fred' => [Parse_unsigned|Parse_multiple, 7]}, fred => 1, fred => 2) ; +# is_deeply $g->value('fred'), [ 1, 2 ] ; + ok 1; #ok 1; - my $got = ParseParameters(1, {'Fred' => [1, 1, 0x1000000, 0]}, Fred => 'abc') ; - is $got->value('Fred'), "abc", "other" ; + my $got = ParseParameters(1, {'fred' => [0x1000000, 0]}, fred => 'abc') ; + is $got->getValue('fred'), "abc", "other" ; - $got = ParseParameters(1, {'Fred' => [0, 1, Parse_any, undef]}, Fred => undef) ; - ok $got->parsed('Fred'), "undef" ; - ok ! defined $got->value('Fred'), "undef" ; + $got = ParseParameters(1, {'fred' => [Parse_any, undef]}, fred => undef) ; + ok $got->parsed('fred'), "undef" ; + ok ! defined $got->getValue('fred'), "undef" ; - $got = ParseParameters(1, {'Fred' => [0, 1, Parse_string, undef]}, Fred => undef) ; - ok $got->parsed('Fred'), "undef" ; - is $got->value('Fred'), "", "empty string" ; + $got = ParseParameters(1, {'fred' => [Parse_string, undef]}, fred => undef) ; + ok $got->parsed('fred'), "undef" ; + is $got->getValue('fred'), "", "empty string" ; my $xx; - $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => $xx) ; + $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => $xx) ; - ok $got->parsed('Fred'), "parsed" ; - my $xx_ref = $got->value('Fred'); + ok $got->parsed('fred'), "parsed" ; + my $xx_ref = $got->getValue('fred'); $$xx_ref = 77 ; is $xx, 77; - $got = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, Fred => \$xx) ; + $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => \$xx) ; - ok $got->parsed('Fred'), "parsed" ; - $xx_ref = $got->value('Fred'); + ok $got->parsed('fred'), "parsed" ; + $xx_ref = $got->getValue('fred'); $$xx_ref = 666 ; is $xx, 666; { - my $got1 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, $got) ; + my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ; is $got1, $got, "Same object"; - ok $got1->parsed('Fred'), "parsed" ; - $xx_ref = $got1->value('Fred'); + ok $got1->parsed('fred'), "parsed" ; + $xx_ref = $got1->getValue('fred'); $$xx_ref = 777 ; is $xx, 777; } + + for my $type (Parse_unsigned, Parse_signed, Parse_any) + { + my $value = 0; + my $got1 ; + eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ; -## my $got2 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, '__xxx__' => $got) ; -## isnt $got2, $got, "not the Same object"; -## -## ok $got2->parsed('Fred'), "parsed" ; -## $xx_ref = $got2->value('Fred'); -## $$xx_ref = 888 ; -## is $xx, 888; -## -## my $other; -## my $got3 = ParseParameters(1, {'Fred' => [1, 1, Parse_writable_scalar, undef]}, '__xxx__' => $got, Fred => \$other) ; -## isnt $got3, $got, "not the Same object"; -## -## exit; -## ok $got3->parsed('Fred'), "parsed" ; -## $xx_ref = $got3->value('Fred'); -## $$xx_ref = 999 ; -## is $other, 999; -## is $xx, 888; + ok ! $@; + ok $got1->parsed('fred'), "parsed ok" ; + is $got1->getValue('fred'), 0; + } + } |