'IO-Compress' => {
'MAINTAINER' => 'pmqs',
- 'DISTRIBUTION' => 'PMQS/IO-Compress-2.055.tar.gz',
+ 'DISTRIBUTION' => 'PMQS/IO-Compress-2.057.tar.gz',
'FILES' => q[cpan/IO-Compress],
'EXCLUDED' => [qr{t/Test/}],
'UPSTREAM' => 'cpan',
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
use strict ;
require 5.006 ;
-$::VERSION = '2.055' ;
+$::VERSION = '2.057' ;
use private::MakeUtil;
use ExtUtils::MakeMaker 5.16 ;
: ()
),
- INSTALLDIRS => ($] >= 5.009 ? 'perl' : 'site'),
+ INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'),
EXE_FILES => ['bin/zipdetails'],
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
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
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;
{
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 ;
{
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) ;
package Compress::Zlib ;
-use IO::Compress::Gzip::Constants 2.055 ;
+use IO::Compress::Gzip::Constants 2.057 ;
sub memGzip($)
{
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
{
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;
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
{
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 ;
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.
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 {
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 ;
$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 ;
}
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 ;
}
# 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)
{
- 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->{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: $!", $!) ;
}
}
*$obj->{Closed} = 0 ;
- *$obj->{AutoClose} = $got->value('AutoClose') ;
+ *$obj->{AutoClose} = $got->getValue('autoclose') ;
*$obj->{Output} = $outValue;
*$obj->{ClassName} = $class;
*$obj->{Got} = $got;
{
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 ;
#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;
}
$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 ;
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 ;
# 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);
}
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
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 ;
Parse_any Parse_unsigned Parse_signed
Parse_boolean Parse_string
Parse_code
- Parse_multiple Parse_writable_scalar
+ Parse_writable_scalar
)
];
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 ;
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
{
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' ;
}
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 = () ;
}
}
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] ;
$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) }
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 ;
}
return 1;
}
-# if ($type & Parse_store_ref)
-# {
-# #$value = $$value
-# # if ref ${ $value } ;
-#
-# $$output = $value ;
-# return 1;
-# }
$value = $$value ;
}
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 ;
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
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' ;
}
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";
}
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 ;
}
}
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;
}
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);
{
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(@_);
}
{
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],
);
}
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;
}
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,
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);
{
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(@_);
}
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
my $self = shift ;
my $got = shift;
- $got->value('ADLER32' => 1);
+ $got->setValue('adler32' => 1);
return 1 ;
}
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
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
-$VERSION = '2.055';
+$VERSION = '2.057';
$GzipError = '' ;
@ISA = qw(Exporter IO::Compress::RawDeflate);
{
my $class = shift ;
- my $obj = createSelfTiedObject($class, \$GzipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError);
$obj->_create(undef, @_);
}
sub gzip
{
- my $obj = createSelfTiedObject(undef, \$GzipError);
+ my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError);
return $obj->_def(@_);
}
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],
);
}
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)
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)
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 ;
}
# 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) ;
}
}
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') ;
}
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",
# 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
# 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
}
# 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);
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);
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);
{
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(@_);
}
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)
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
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 ;
} ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
-$VERSION = '2.055';
+$VERSION = '2.057';
$ZipError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
{
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(@_);
}
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);
}
*$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 ;
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.
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
$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} ;
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;
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
# 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() ;
$ctl .= $ctlExtra ;
$ctl .= $comment ;
- *$self->{ZipData}{Offset}->add(length $hdr) ;
+ *$self->{ZipData}{Offset}->add32(length $hdr) ;
*$self->{ZipData}{CentralHeader} = $ctl;
*$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 ;
. 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 ;
}
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};
*$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) ;
}
}
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' ;
}
# 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
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] ;
= (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) ;
}
our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
-$VERSION = '2.055';
+$VERSION = '2.057';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT);
-$VERSION = '2.055';
+$VERSION = '2.057';
@ISA = qw(Exporter);
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
{
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
{
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
{
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';
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 );
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
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;
}
my @possible = qw( Inflate Gunzip Unzip );
unshift @possible, 'RawInflate'
- if 1 || $got->value('RawInflate');
+ if 1 || $got->getValue('rawinflate');
my $magic = $self->ckMagic( @possible );
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.
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 );
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
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;
}
my @possible = qw( Inflate Gunzip Unzip );
unshift @possible, 'RawInflate'
- if $got->value('RawInflate');
+ if $got->getValue('rawinflate');
$magic = $self->ckMagic( @possible );
}
}
- 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();
my @possible = qw( UnLzma );
#unshift @possible, 'RawInflate'
- # if $got->value('RawInflate');
+ # if $got->getValue('rawinflate');
if ( *$self->{Info} = $self->ckMagic( @possible ))
{
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.
@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 = ( );
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} ) {
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;
}
my $inValue = shift ;
- *$obj->{OneShot} = 0 ;
+ *$obj->{OneShot} = 0 ;
if (! $got)
{
# 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': $!", $!) ;
*$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;
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 ;
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: $!") ;
}
elsif ($x->{outType} eq 'buffer' )
{
$$output = ''
- unless $x->{Got}->value('Append');
+ unless $x->{Got}->getValue('append');
$x->{buff} = $output ;
}
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};
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 ;
*$self->{CompressedInputLengthDone} = 1;
return STATUS_OK ;
}
- $size = min($size, *$self->{CompressedInputLengthRemaining} );
+ $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} );
*$self->{CompressedInputLengthRemaining} -= $size ;
}
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' ;
}
else {
$self->croakError(*$self->{ClassName} . "::read: buffer parameter is read-only")
- if readonly($_[0]);
+ if Scalar::Util::readonly($_[0]);
$buffer = \$_[0] ;
}
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 ;
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 );
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],
);
}
*$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);
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 ;
$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
my $got = shift ;
# gunzip always needs crc32
- $got->value('CRC32' => 1);
+ $got->setValue('crc32' => 1);
return 1;
}
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.
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 );
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(@_);
}
my $got = shift ;
# gunzip always needs adler32
- $got->value('ADLER32' => 1);
+ $got->setValue('adler32' => 1);
return 1;
}
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.
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 );
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(@_);
}
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)
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 ;
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.
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 } ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
-$VERSION = '2.055';
+$VERSION = '2.057';
$UnzipError = '';
@ISA = qw(Exporter IO::Uncompress::RawInflate);
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
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;
}
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.
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
$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)) ;
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'";
+}
$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');
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'";
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;
+ }
+
}
projects / platform / upstream / perl.git / commitdiff