package IO::Compress::RawDeflate ;
# create RFC1951
#
use strict ;
use warnings;
use bytes;
use IO::Compress::Base 2.021 ;
use IO::Compress::Base::Common 2.021 qw(:Status createSelfTiedObject);
use IO::Compress::Adapter::Deflate 2.021 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
$VERSION = '2.021';
$RawDeflateError = '';
@ISA = qw(Exporter IO::Compress::Base);
@EXPORT_OK = qw( $RawDeflateError rawdeflate ) ;
%EXPORT_TAGS = ( flush => [qw{
Z_NO_FLUSH
Z_PARTIAL_FLUSH
Z_SYNC_FLUSH
Z_FULL_FLUSH
Z_FINISH
Z_BLOCK
}],
level => [qw{
Z_NO_COMPRESSION
Z_BEST_SPEED
Z_BEST_COMPRESSION
Z_DEFAULT_COMPRESSION
}],
strategy => [qw{
Z_FILTERED
Z_HUFFMAN_ONLY
Z_RLE
Z_FIXED
Z_DEFAULT_STRATEGY
}],
);
{
my %seen;
foreach (keys %EXPORT_TAGS )
{
push @{$EXPORT_TAGS{constants}},
grep { !$seen{$_}++ }
@{ $EXPORT_TAGS{$_} }
}
$EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ;
}
%DEFLATE_CONSTANTS = %EXPORT_TAGS;
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
Exporter::export_ok_tags('all');
sub new
{
my $class = shift ;
my $obj = createSelfTiedObject($class, \$RawDeflateError);
return $obj->_create(undef, @_);
}
sub rawdeflate
{
my $obj = createSelfTiedObject(undef, \$RawDeflateError);
return $obj->_def(@_);
}
sub ckParams
{
my $self = shift ;
my $got = shift;
return 1 ;
}
sub mkComp
{
my $self = shift ;
my $got = shift ;
my ($obj, $errstr, $errno) = IO::Compress::Adapter::Deflate::mkCompObject(
$got->value('CRC32'),
$got->value('Adler32'),
$got->value('Level'),
$got->value('Strategy')
);
return $self->saveErrorString(undef, $errstr, $errno)
if ! defined $obj;
return $obj;
}
sub mkHeader
{
my $self = shift ;
return '';
}
sub mkTrailer
{
my $self = shift ;
return '';
}
sub mkFinalTrailer
{
return '';
}
#sub newHeader
#{
# my $self = shift ;
# return '';
#}
sub getExtraParams
{
my $self = shift ;
return $self->getZlibParams();
}
sub getZlibParams
{
my $self = shift ;
use IO::Compress::Base::Common 2.021 qw(:Parse);
use Compress::Raw::Zlib 2.021 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION 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],
);
}
sub getInverseClass
{
return ('IO::Uncompress::RawInflate',
\$IO::Uncompress::RawInflate::RawInflateError);
}
sub getFileInfo
{
my $self = shift ;
my $params = shift;
my $file = shift ;
}
use IO::Seekable qw(SEEK_SET);
sub createMerge
{
my $self = shift ;
my $outValue = shift ;
my $outType = shift ;
my ($invClass, $error_ref) = $self->getInverseClass();
eval "require $invClass"
or die "aaaahhhh" ;
my $inf = $invClass->new( $outValue,
Transparent => 0,
#Strict => 1,
AutoClose => 0,
Scan => 1)
or return $self->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) ;
my $end_offset = 0;
$inf->scan()
or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ;
$inf->zap($end_offset)
or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ;
my $def = *$self->{Compress} = $inf->createDeflate();
*$self->{Header} = *$inf->{Info}{Header};
*$self->{UnCompSize} = *$inf->{UnCompSize}->clone();
*$self->{CompSize} = *$inf->{CompSize}->clone();
# TODO -- fix this
#*$self->{CompSize} = new U64(0, *$self->{UnCompSize_32bit});
if ( $outType eq 'buffer')
{ substr( ${ *$self->{Buffer} }, $end_offset) = '' }
elsif ($outType eq 'handle' || $outType eq 'filename') {
*$self->{FH} = *$inf->{FH} ;
delete *$inf->{FH};
*$self->{FH}->flush() ;
*$self->{Handle} = 1 if $outType eq 'handle';
#seek(*$self->{FH}, $end_offset, SEEK_SET)
*$self->{FH}->seek($end_offset, SEEK_SET)
or return $self->saveErrorString(undef, $!, $!) ;
}
return $def ;
}
#### zlib specific methods
sub deflateParams
{
my $self = shift ;
my $level = shift ;
my $strategy = shift ;
my $status = *$self->{Compress}->deflateParams(Level => $level, Strategy => $strategy) ;
return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo})
if $status == STATUS_ERROR;
return 1;
}
1;
__END__
=head1 NAME
IO::Compress::RawDeflate - Write RFC 1951 files/buffers
=head1 SYNOPSIS
use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;
my $status = rawdeflate $input => $output [,OPTS]
or die "rawdeflate failed: $RawDeflateError\n";
my $z = new IO::Compress::RawDeflate $output [,OPTS]
or die "rawdeflate failed: $RawDeflateError\n";
$z->print($string);
$z->printf($format, $string);
$z->write($string);
$z->syswrite($string [, $length, $offset]);
$z->flush();
$z->tell();
$z->eof();
$z->seek($position, $whence);
$z->binmode();
$z->fileno();
$z->opened();
$z->autoflush();
$z->input_line_number();
$z->newStream( [OPTS] );
$z->deflateParams();
$z->close() ;
$RawDeflateError ;
# IO::File mode
print $z $string;
printf $z $format, $string;
tell $z
eof $z
seek $z, $position, $whence
binmode $z
fileno $z
close $z ;
=head1 DESCRIPTION
This module provides a Perl interface that allows writing compressed
data to files or buffer as defined in RFC 1951.
Note that RFC 1951 data is not a good choice of compression format
to use in isolation, especially if you want to auto-detect it.
For reading RFC 1951 files/buffers, see the companion module
L.
=head1 Functional Interface
A top-level function, C, is provided to carry out
"one-shot" compression between buffers and/or files. For finer
control over the compression process, see the L
section.
use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ;
rawdeflate $input => $output [,OPTS]
or die "rawdeflate failed: $RawDeflateError\n";
The functional interface needs Perl5.005 or better.
=head2 rawdeflate $input => $output [, OPTS]
C expects at least two parameters, C<$input> and C<$output>.
=head3 The C<$input> parameter
The parameter, C<$input>, is used to define the source of
the uncompressed data.
It can take one of the following forms:
=over 5
=item A filename
If the C<$input> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for reading and the input data
will be read from it.
=item A filehandle
If the C<$input> parameter is a filehandle, the input data will be
read from it.
The string '-' can be used as an alias for standard input.
=item A scalar reference
If C<$input> is a scalar reference, the input data will be read
from C<$$input>.
=item An array reference
If C<$input> is an array reference, each element in the array must be a
filename.
The input data will be read from each file in turn.
The complete array will be walked to ensure that it only
contains valid filenames before any data is compressed.
=item An Input FileGlob string
If C<$input> is a string that is delimited by the characters "<" and ">"
C will assume that it is an I. The
input is the list of files that match the fileglob.
If the fileglob does not match any files ...
See L for more details.
=back
If the C<$input> parameter is any other type, C will be returned.
=head3 The C<$output> parameter
The parameter C<$output> is used to control the destination of the
compressed data. This parameter can take one of these forms.
=over 5
=item A filename
If the C<$output> parameter is a simple scalar, it is assumed to be a
filename. This file will be opened for writing and the compressed
data will be written to it.
=item A filehandle
If the C<$output> parameter is a filehandle, the compressed data
will be written to it.
The string '-' can be used as an alias for standard output.
=item A scalar reference
If C<$output> is a scalar reference, the compressed data will be
stored in C<$$output>.
=item An Array Reference
If C<$output> is an array reference, the compressed data will be
pushed onto the array.
=item An Output FileGlob
If C<$output> is a string that is delimited by the characters "<" and ">"
C will assume that it is an I