'IO-Compress' =>
{
'MAINTAINER' => 'pmqs',
- 'DISTRIBUTION' => 'PMQS/IO-Compress-2.033.tar.gz',
+ 'DISTRIBUTION' => 'PMQS/IO-Compress-2.035.tar.gz',
'FILES' => q[cpan/IO-Compress],
'EXCLUDED' => [ qr{t/Test/} ],
'UPSTREAM' => 'cpan',
CHANGES
-------
+ 2.035 6 May 2011
+
+ * RT #67931: Test failure on Windows
+
+ 2.034 2 May 2011
+
+ * Compress::Zlib
+ - Silence pod warnings.
+ [RT# 64876]
+
+ - Removed duplicate words in pod.
+
+ * IO::Compress::Base
+
+ - RT #56942: Testsuite fails when being run in parallel
+
+ - Reduce symbol import - patch from J. Nick Koston
+
+ - If the output buffer parameter passed to read has a value of
+ undef, and Append mode was specified when the file was opened,
+ and eof is reached, then the buffer paramer was left as undef.
+ This is different from when Append isn't specified - the buffer
+ parameter is set to an empty string.
+
+ - There area couple of issues with reading a file that contains an
+ empty file that is compressed.
+ Create with -- touch /tmp/empty; gzip /tmp/empty.
+ Issue 1 - eof is not true immediately. Have to read from the file
+ to trigger eof.
+ Issue 2 - readline incorrectly returns an empty string the first
+ time it is called, and (correctly) undef thereafter.
+ [RT #67554]
+
2.033 11 Jan 2011
+
* Fixed typos & spelling errors.
[perl# 81816]
use strict ;
require 5.004 ;
-$::VERSION = '2.033' ;
+$::VERSION = '2.035' ;
use private::MakeUtil;
use ExtUtils::MakeMaker 5.16 ;
IO-Compress
- Version 2.033
+ Version 2.035
- 11th January 2011
+ 6th May 2011
Copyright (c) 1995-2011 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.033" ;
+ $VERSION = "2.035" ;
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.033 ;
-use Compress::Raw::Zlib 2.033 ;
-use IO::Compress::Gzip 2.033 ;
-use IO::Uncompress::Gunzip 2.033 ;
+use IO::Compress::Base::Common 2.035 ;
+use Compress::Raw::Zlib 2.035 ;
+use IO::Compress::Gzip 2.035 ;
+use IO::Uncompress::Gunzip 2.035 ;
use strict ;
use warnings ;
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.033';
+$VERSION = '2.035';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
_set_gzerr(@_);
return undef;
}
+
sub _save_gzerr
{
my $gz = shift ;
my $test_eof = shift ;
my $value = $gz->errorNo() || 0 ;
+ my $eof = $gz->eof() ;
if ($test_eof) {
- #my $gz = $self->[0] ;
# gzread uses Z_STREAM_END to denote a successful end
$value = Z_STREAM_END() if $gz->eof() && $value == 0 ;
}
my $len = defined $_[1] ? $_[1] : 4096 ;
+ my $gz = $self->[0] ;
if ($self->gzeof() || $len == 0) {
# Zap the output buffer to match ver 1 behaviour.
$_[0] = "" ;
+ _save_gzerr($gz, 1);
return 0 ;
}
- my $gz = $self->[0] ;
my $status = $gz->read($_[0], $len) ;
_save_gzerr($gz, 1);
return $status ;
package Compress::Zlib ;
-use IO::Compress::Gzip::Constants 2.033 ;
+use IO::Compress::Gzip::Constants 2.035 ;
sub memGzip($)
{
=item 1
-If you want to to open either STDIN or STDOUT with C<gzopen>, you can now
+If you want to open either STDIN or STDOUT with C<gzopen>, you can now
optionally use the special filename "C<->" as a synonym for C<\*STDIN> and
C<\*STDOUT>.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
+use IO::Compress::Base::Common 2.035 qw(:Status);
#use Compress::Bzip2 ;
-use Compress::Raw::Bzip2 2.033 ;
+use Compress::Raw::Bzip2 2.035 ;
our ($VERSION);
-$VERSION = '2.033';
+$VERSION = '2.035';
sub mkCompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
+use IO::Compress::Base::Common 2.035 qw(:Status);
-use Compress::Raw::Zlib 2.033 qw(Z_OK Z_FINISH MAX_WBITS) ;
+use Compress::Raw::Zlib 2.035 qw(Z_OK Z_FINISH MAX_WBITS) ;
our ($VERSION);
-$VERSION = '2.033';
+$VERSION = '2.035';
sub mkCompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
+use IO::Compress::Base::Common 2.035 qw(:Status);
our ($VERSION);
-$VERSION = '2.033';
+$VERSION = '2.035';
sub mkCompObject
{
use strict ;
use warnings;
-use IO::Compress::Base::Common 2.033 ;
+use IO::Compress::Base::Common 2.035 ;
-use IO::File ;
+use IO::File qw(SEEK_SET SEEK_END); ;
use Scalar::Util qw(blessed readonly);
#use File::Glob;
#require Exporter ;
-use Carp ;
-use Symbol;
+use Carp() ;
+use Symbol();
use bytes;
our (@ISA, $VERSION);
@ISA = qw(Exporter IO::File);
-$VERSION = '2.033';
+$VERSION = '2.035';
#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 $self = shift ;
$self->saveErrorString(0, $_[0]);
- croak $_[0];
+ Carp::croak $_[0];
}
sub closeError
# finally the 1 to 1 and n to 1
return $obj->_singleTarget($x, 1, $input, $output, @_);
- croak "should not be here" ;
+ Carp::croak "should not be here" ;
}
sub _singleTarget
return $count ;
}
- croak "Should not be here";
+ Carp::croak "Should not be here";
return undef;
}
}
$] >= 5.008 and ( utf8::downgrade($$buffer, 1)
- or croak "Wide character in " . *$self->{ClassName} . "::write:");
+ or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:");
if (@_ > 1) {
sub _notAvailable
{
my $name = shift ;
- return sub { croak "$name Not Available: File opened only for output" ; } ;
+ return sub { Carp::croak "$name Not Available: File opened only for output" ; } ;
}
*read = _notAvailable('read');
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.033';
+$VERSION = '2.035';
@EXPORT = qw( isaFilehandle isaFilename whatIsInput whatIsOutput
isaFileGlobString cleanFileGlobString oneTarget
use bytes;
require Exporter ;
-use IO::Compress::Base 2.033 ;
+use IO::Compress::Base 2.035 ;
-use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject);
-use IO::Compress::Adapter::Bzip2 2.033 ;
+use IO::Compress::Base::Common 2.035 qw(createSelfTiedObject);
+use IO::Compress::Adapter::Bzip2 2.035 ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
-$VERSION = '2.033';
+$VERSION = '2.035';
$Bzip2Error = '';
@ISA = qw(Exporter IO::Compress::Base);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return (
'BlockSize100K' => [0, 1, Parse_unsigned, 1],
require Exporter ;
-use IO::Compress::RawDeflate 2.033 ;
+use IO::Compress::RawDeflate 2.035 ;
-use Compress::Raw::Zlib 2.033 ;
-use IO::Compress::Zlib::Constants 2.033 ;
-use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject);
+use Compress::Raw::Zlib 2.035 ;
+use IO::Compress::Zlib::Constants 2.035 ;
+use IO::Compress::Base::Common 2.035 qw(createSelfTiedObject);
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $DeflateError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$DeflateError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use bytes;
-use IO::Compress::RawDeflate 2.033 ;
+use IO::Compress::RawDeflate 2.035 ;
-use Compress::Raw::Zlib 2.033 ;
-use IO::Compress::Base::Common 2.033 qw(:Status :Parse createSelfTiedObject);
-use IO::Compress::Gzip::Constants 2.033 ;
-use IO::Compress::Zlib::Extra 2.033 ;
+use Compress::Raw::Zlib 2.035 ;
+use IO::Compress::Base::Common 2.035 qw(:Status :Parse createSelfTiedObject);
+use IO::Compress::Gzip::Constants 2.035 ;
+use IO::Compress::Zlib::Extra 2.035 ;
BEGIN
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $GzipError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$GzipError = '' ;
@ISA = qw(Exporter IO::Compress::RawDeflate);
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
-$VERSION = '2.033';
+$VERSION = '2.035';
@ISA = qw(Exporter);
use bytes;
-use IO::Compress::Base 2.033 ;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
-use IO::Compress::Adapter::Deflate 2.033 ;
+use IO::Compress::Base 2.035 ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
+use IO::Compress::Adapter::Deflate 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$RawDeflateError = '';
@ISA = qw(Exporter IO::Compress::Base);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.033 qw(:Parse);
- use Compress::Raw::Zlib 2.033 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
+ use Compress::Raw::Zlib 2.035 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
return (
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
-use IO::Compress::RawDeflate 2.033 ;
-use IO::Compress::Adapter::Deflate 2.033 ;
-use IO::Compress::Adapter::Identity 2.033 ;
-use IO::Compress::Zlib::Extra 2.033 ;
-use IO::Compress::Zip::Constants 2.033 ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
+use IO::Compress::RawDeflate 2.035 ;
+use IO::Compress::Adapter::Deflate 2.035 ;
+use IO::Compress::Adapter::Identity 2.035 ;
+use IO::Compress::Zlib::Extra 2.035 ;
+use IO::Compress::Zip::Constants 2.035 ;
-use Compress::Raw::Zlib 2.033 qw(crc32) ;
+use Compress::Raw::Zlib 2.035 qw(crc32) ;
BEGIN
{
eval { require IO::Compress::Adapter::Bzip2 ;
- import IO::Compress::Adapter::Bzip2 2.033 ;
+ import IO::Compress::Adapter::Bzip2 2.035 ;
require IO::Compress::Bzip2 ;
- import IO::Compress::Bzip2 2.033 ;
+ import IO::Compress::Bzip2 2.035 ;
} ;
# eval { require IO::Compress::Adapter::Lzma ;
# import IO::Compress::Adapter::Lzma 2.020 ;
# require IO::Compress::Lzma ;
-# import IO::Compress::Lzma 2.033 ;
+# import IO::Compress::Lzma 2.035 ;
# } ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $ZipError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$ZipError = '';
@ISA = qw(Exporter IO::Compress::RawDeflate);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.033 qw(:Parse);
- use Compress::Raw::Zlib 2.033 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
+ use Compress::Raw::Zlib 2.035 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
my @Bzip2 = ();
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
-$VERSION = '2.033';
+$VERSION = '2.035';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT);
-$VERSION = '2.033';
+$VERSION = '2.035';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.033';
+$VERSION = '2.035';
-use IO::Compress::Gzip::Constants 2.033 ;
+use IO::Compress::Gzip::Constants 2.035 ;
sub ExtraFieldError
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
+use IO::Compress::Base::Common 2.035 qw(:Status);
-use Compress::Raw::Bzip2 2.033 ;
+use Compress::Raw::Bzip2 2.035 ;
our ($VERSION, @ISA);
-$VERSION = '2.033';
+$VERSION = '2.035';
sub mkUncompObject
{
use strict;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
+use IO::Compress::Base::Common 2.035 qw(:Status);
our ($VERSION);
-$VERSION = '2.033';
+$VERSION = '2.035';
-use Compress::Raw::Zlib 2.033 ();
+use Compress::Raw::Zlib 2.035 ();
sub mkUncompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status);
-use Compress::Raw::Zlib 2.033 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
+use IO::Compress::Base::Common 2.035 qw(:Status);
+use Compress::Raw::Zlib 2.035 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
our ($VERSION);
-$VERSION = '2.033';
+$VERSION = '2.035';
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject);
+use IO::Compress::Base::Common 2.035 qw(createSelfTiedObject);
-use IO::Uncompress::Adapter::Inflate 2.033 ();
+use IO::Uncompress::Adapter::Inflate 2.035 ();
-use IO::Uncompress::Base 2.033 ;
-use IO::Uncompress::Gunzip 2.033 ;
-use IO::Uncompress::Inflate 2.033 ;
-use IO::Uncompress::RawInflate 2.033 ;
-use IO::Uncompress::Unzip 2.033 ;
+use IO::Uncompress::Base 2.035 ;
+use IO::Uncompress::Gunzip 2.035 ;
+use IO::Uncompress::Inflate 2.035 ;
+use IO::Uncompress::RawInflate 2.035 ;
+use IO::Uncompress::Unzip 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$AnyInflateError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
sub getExtraParams
{
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ) ;
}
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(createSelfTiedObject);
+use IO::Compress::Base::Common 2.035 qw(createSelfTiedObject);
-use IO::Uncompress::Base 2.033 ;
+use IO::Uncompress::Base 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$AnyUncompressError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
BEGIN
{
- eval ' use IO::Uncompress::Adapter::Inflate 2.033 ;';
- eval ' use IO::Uncompress::Adapter::Bunzip2 2.033 ;';
- eval ' use IO::Uncompress::Adapter::LZO 2.033 ;';
- eval ' use IO::Uncompress::Adapter::Lzf 2.033 ;';
+ eval ' use IO::Uncompress::Adapter::Inflate 2.035 ;';
+ eval ' use IO::Uncompress::Adapter::Bunzip2 2.035 ;';
+ eval ' use IO::Uncompress::Adapter::LZO 2.035 ;';
+ eval ' use IO::Uncompress::Adapter::Lzf 2.035 ;';
eval ' use IO::Uncompress::Adapter::UnLzma 2.020 ;';
eval ' use IO::Uncompress::Adapter::UnXz 2.020 ;';
- eval ' use IO::Uncompress::Bunzip2 2.033 ;';
- eval ' use IO::Uncompress::UnLzop 2.033 ;';
- eval ' use IO::Uncompress::Gunzip 2.033 ;';
- eval ' use IO::Uncompress::Inflate 2.033 ;';
- eval ' use IO::Uncompress::RawInflate 2.033 ;';
- eval ' use IO::Uncompress::Unzip 2.033 ;';
- eval ' use IO::Uncompress::UnLzf 2.033 ;';
- eval ' use IO::Uncompress::UnLzma 2.033 ;';
- eval ' use IO::Uncompress::UnXz 2.033 ;';
+ eval ' use IO::Uncompress::Bunzip2 2.035 ;';
+ eval ' use IO::Uncompress::UnLzop 2.035 ;';
+ eval ' use IO::Uncompress::Gunzip 2.035 ;';
+ eval ' use IO::Uncompress::Inflate 2.035 ;';
+ eval ' use IO::Uncompress::RawInflate 2.035 ;';
+ eval ' use IO::Uncompress::Unzip 2.035 ;';
+ eval ' use IO::Uncompress::UnLzf 2.035 ;';
+ eval ' use IO::Uncompress::UnLzma 2.035 ;';
+ eval ' use IO::Uncompress::UnXz 2.035 ;';
}
sub new
sub getExtraParams
{
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return ( 'RawInflate' => [1, 1, Parse_boolean, 0] ,
'UnLzma' => [1, 1, Parse_boolean, 0] ) ;
}
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
@ISA = qw(Exporter IO::File);
-$VERSION = '2.033';
+$VERSION = '2.035';
use constant G_EOF => 0 ;
use constant G_ERR => -1 ;
-use IO::Compress::Base::Common 2.033 ;
-#use Parse::Parameters ;
+use IO::Compress::Base::Common 2.035 ;
use IO::File ;
use Symbol;
%EXPORT_TAGS = ( );
push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
-#Exporter::export_ok_tags('all') ;
-
-
sub smartRead
{
my $self = $_[0];
my $out = $_[1];
my $size = $_[2];
- #$$out = "" ;
$$out = "" ;
my $offset = 0 ;
}
if ( length *$self->{Prime} ) {
- #$$out = substr(*$self->{Prime}, 0, $size, '') ;
$$out = substr(*$self->{Prime}, 0, $size) ;
substr(*$self->{Prime}, 0, $size) = '' ;
if (length $$out == $size) {
}
if (length $$out > $size ) {
- #*$self->{Prime} = substr($$out, $size, length($$out), '');
*$self->{Prime} = substr($$out, $size, length($$out));
substr($$out, $size, length($$out)) = '';
}
no warnings 'uninitialized';
my $buf = *$self->{Buffer} ;
$$buf = '' unless defined $$buf ;
- #$$out = '' unless defined $$out ;
substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size);
if (*$self->{ConsumeInput})
{ substr($$buf, 0, $get_size) = '' }
my $self = shift ;
my $offset = shift ;
my $truncate = shift;
- #print "smartSeek to $offset\n";
# TODO -- need to take prime into account
if (defined *$self->{FH})
my $status = $self->smartRead(\$buffer, 1);
$self->pushBack($buffer) if length $buffer;
$self->setErrInfo($info);
-
+
return $status == 0 ;
}
elsif (defined *$self->{InputEvent})
{
my $self = shift ;
my $errno = shift() + 0 ;
- #return $errno unless $errno || ! defined *$self->{ErrorNo};
- #return $errno unless $errno ;
*$self->{ErrorNo} = $errno;
${ *$self->{Error} } = '' ;
my $self = shift ;
my $retval = shift ;
- #return $retval if ${ *$self->{Error} };
-
${ *$self->{Error} } = shift ;
- *$self->{ErrorNo} = shift() + 0 if @_ ;
+ *$self->{ErrorNo} = @_ ? shift() + 0 : STATUS_ERROR ;
- #warn "saveErrorString: " . ${ *$self->{Error} } . " " . *$self->{Error} . "\n" ;
return $retval;
}
return undef
unless defined $status;
- if ( ! $status) {
+ *$obj->{InNew} = 0;
+ *$obj->{Closed} = 0;
+
+ if ($status) {
+ # Need to try uncompressing to catch the case
+ # where the compressed file uncompresses to an
+ # empty string - so eof is set immediately.
+
+ my $out_buffer = '';
+
+ $status = $obj->read(\$out_buffer);
+
+ if ($status < 0) {
+ *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ];
+ }
+
+ $obj->ungetc($out_buffer)
+ if length $out_buffer;
+ }
+ else {
return undef
unless *$obj->{Transparent};
$obj->clearError();
*$obj->{Type} = 'plain';
*$obj->{Plain} = 1;
- #$status = $obj->mkIdentityUncomp($class, $got);
$obj->pushBack(*$obj->{HeaderPending}) ;
}
}
last if $status < 0 || $z->smartEof();
- #last if $status < 0 ;
last
unless *$self->{MultiStream};
}
my $status = $self->smartRead($buff, $size) ;
- return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!")
+ return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!)
if $status == STATUS_ERROR ;
if ($status == 0 ) {
my $self = shift ;
return G_EOF if *$self->{Closed} ;
- #return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
return G_EOF if *$self->{EndStream} ;
my $buffer = shift ;
my $temp_buf = '';
my $outSize = 0;
my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ;
+
return G_ERR
if $status == STATUS_ERROR ;
if ($status == STATUS_ENDSTREAM) {
*$self->{EndStream} = 1 ;
-#$self->pushBack($temp_buf) ;
-#$temp_buf = '';
my $trailer;
my $trailer_size = *$self->{Info}{TrailerLength} ;
*$self->{CompSize}->reset();
my $magic = $self->ckMagic();
- #*$self->{EndStream} = 0 ;
if ( ! defined $magic) {
if (! *$self->{Transparent} || $self->eof())
my $self = shift ;
+ if (defined *$self->{ReadStatus} ) {
+ my $status = *$self->{ReadStatus}[0];
+ $self->saveErrorString( @{ *$self->{ReadStatus} } );
+ delete *$self->{ReadStatus} ;
+ return $status ;
+ }
+
return G_EOF if *$self->{Closed} ;
my $buffer ;
}
}
}
+ elsif (! defined $$buffer) {
+ $$buffer = '' ;
+ }
return G_EOF if !length *$self->{Pending} && *$self->{EndStream} ;
*$self->{Pending} = $out_buffer;
$out_buffer = \*$self->{Pending} ;
- #substr($$buffer, $offset) = substr($$out_buffer, 0, $length, '') ;
substr($$buffer, $offset) = substr($$out_buffer, 0, $length) ;
substr($$out_buffer, 0, $length) = '' ;
if ( ! defined $/ ) {
my $data ;
1 while ($status = $self->read($data)) > 0 ;
- return $status < 0 ? \undef : \$data ;
+ return ($status, \$data);
}
# Record Mode
my $reclen = ${$/} ;
my $data ;
$status = $self->read($data, $reclen) ;
- return $status < 0 ? \undef : \$data ;
+ return ($status, \$data);
}
# Paragraph Mode
if ($paragraph =~ s/^(.*?\n\n+)//s) {
*$self->{Pending} = $paragraph ;
my $par = $1 ;
- return \$par ;
+ return (1, \$par);
}
}
- return $status < 0 ? \undef : \$paragraph;
+ return ($status, \$paragraph);
}
# $/ isn't empty, or a reference, so it's Line Mode.
{
my $line ;
- my $offset;
my $p = \*$self->{Pending} ;
-
- if (length(*$self->{Pending}) &&
- ($offset = index(*$self->{Pending}, $/)) >=0) {
- my $l = substr(*$self->{Pending}, 0, $offset + length $/ );
- substr(*$self->{Pending}, 0, $offset + length $/) = '';
- return \$l;
- }
-
while (($status = $self->read($line)) > 0 ) {
my $offset = index($line, $/);
if ($offset >= 0) {
my $l = substr($line, 0, $offset + length $/ );
substr($line, 0, $offset + length $/) = '';
$$p = $line;
- return \$l;
+ return (1, \$l);
}
}
- return $status < 0 ? \undef : \$line;
+ return ($status, \$line);
}
}
sub getline
{
my $self = shift;
+
+ if (defined *$self->{ReadStatus} ) {
+ $self->saveErrorString( @{ *$self->{ReadStatus} } );
+ delete *$self->{ReadStatus} ;
+ return undef;
+ }
+
+ return undef
+ if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ;
+
my $current_append = *$self->{AppendOutput} ;
*$self->{AppendOutput} = 1;
- my $lineref = $self->_getline();
- $. = ++ *$self->{LineNo} if defined $$lineref ;
+
+ my ($status, $lineref) = $self->_getline();
*$self->{AppendOutput} = $current_append;
+
+ return undef
+ if $status < 0 || length $$lineref == 0 ;
+
+ $. = ++ *$self->{LineNo} ;
+
return $$lineref ;
}
if (defined *$self->{FH}) {
if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) {
- #if ( *$self->{AutoClose}) {
local $.;
$! = 0 ;
$status = *$self->{FH}->close();
sub _notAvailable
{
my $name = shift ;
- #return sub { croak "$name Not Available" ; } ;
return sub { croak "$name Not Available: File opened only for intput" ; } ;
}
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Base 2.033 ;
-use IO::Uncompress::Adapter::Bunzip2 2.033 ;
+use IO::Uncompress::Base 2.035 ;
+use IO::Uncompress::Adapter::Bunzip2 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
-$VERSION = '2.033';
+$VERSION = '2.035';
$Bunzip2Error = '';
@ISA = qw( Exporter IO::Uncompress::Base );
{
my $self = shift ;
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return (
'Verbosity' => [1, 1, Parse_boolean, 0],
use warnings;
use bytes;
-use IO::Uncompress::RawInflate 2.033 ;
+use IO::Uncompress::RawInflate 2.035 ;
-use Compress::Raw::Zlib 2.033 qw( crc32 ) ;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
-use IO::Compress::Gzip::Constants 2.033 ;
-use IO::Compress::Zlib::Extra 2.033 ;
+use Compress::Raw::Zlib 2.035 qw( crc32 ) ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
+use IO::Compress::Gzip::Constants 2.035 ;
+use IO::Compress::Zlib::Extra 2.035 ;
require Exporter ;
$GunzipError = '';
-$VERSION = '2.033';
+$VERSION = '2.035';
sub new
{
sub getExtraParams
{
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return ( 'ParseExtra' => [1, 1, Parse_boolean, 0] ) ;
}
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
-use IO::Compress::Zlib::Constants 2.033 ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
+use IO::Compress::Zlib::Constants 2.035 ;
-use IO::Uncompress::RawInflate 2.033 ;
+use IO::Uncompress::RawInflate 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$InflateError = '';
@ISA = qw( Exporter IO::Uncompress::RawInflate );
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use warnings;
use bytes;
-use Compress::Raw::Zlib 2.033 ;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
+use Compress::Raw::Zlib 2.035 ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Base 2.033 ;
-use IO::Uncompress::Adapter::Inflate 2.033 ;
+use IO::Uncompress::Base 2.035 ;
+use IO::Uncompress::Adapter::Inflate 2.035 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
-$VERSION = '2.033';
+$VERSION = '2.035';
$RawInflateError = '';
@ISA = qw( Exporter IO::Uncompress::Base );
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
use warnings;
use bytes;
-use IO::Uncompress::RawInflate 2.033 ;
-use IO::Compress::Base::Common 2.033 qw(:Status createSelfTiedObject);
-use IO::Uncompress::Adapter::Inflate 2.033 ;
-use IO::Uncompress::Adapter::Identity 2.033 ;
-use IO::Compress::Zlib::Extra 2.033 ;
-use IO::Compress::Zip::Constants 2.033 ;
+use IO::Uncompress::RawInflate 2.035 ;
+use IO::Compress::Base::Common 2.035 qw(:Status createSelfTiedObject);
+use IO::Uncompress::Adapter::Inflate 2.035 ;
+use IO::Uncompress::Adapter::Identity 2.035 ;
+use IO::Compress::Zlib::Extra 2.035 ;
+use IO::Compress::Zip::Constants 2.035 ;
-use Compress::Raw::Zlib 2.033 qw(crc32) ;
+use Compress::Raw::Zlib 2.035 qw(crc32) ;
BEGIN
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
-$VERSION = '2.033';
+$VERSION = '2.035';
$UnzipError = '';
@ISA = qw(Exporter IO::Uncompress::RawInflate);
sub getExtraParams
{
- use IO::Compress::Base::Common 2.033 qw(:Parse);
+ use IO::Compress::Base::Common 2.035 qw(:Parse);
return (
will return the underlying file descriptor. Once the C<close> method is
called C<fileno> will return C<undef>.
-If the C<$z> object is is associated with a buffer, this method will return
+If the C<$z> object is associated with a buffer, this method will return
C<undef>.
=head2 close
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- my $VERSION = '2.033';
+ my $VERSION = '2.035';
my @NAMES = qw(
Compress::Raw::Bzip2
Compress::Raw::Zlib
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 910 + $extra ;
+ plan tests => 915 + $extra ;
use_ok('Compress::Raw::Zlib') ;
use_ok('IO::Compress::Gzip::Constants') ;
}
{
- # Check Minimal + no compressed data
+ title "Check Minimal + no compressed data";
# This is the smallest possible gzip file (20 bytes)
ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
- ok $x->close ;
- #ok GZreadFile($name) eq '' ;
+ isa_ok $x, "IO::Compress::Gzip";
+ ok $x->close, "closed" ;
- ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
+ ok $x = new IO::Uncompress::Gunzip $name, -Append => 0 ;
+ isa_ok $x, "IO::Uncompress::Gunzip";
my $data ;
my $status = 1;
+ ok $x->eof(), "eof" ;
$status = $x->read($data)
while $status > 0;
- is $status, 0 ;
- is $data, '';
- ok ! $x->error() ;
- ok $x->eof() ;
+ is $status, 0, "status == 0" ;
+ is $data, '', "empty string";
+ ok ! $x->error(), "no error" ;
+ ok $x->eof(), "eof" ;
my $hdr = $x->getHeaderInfo();
ok $hdr;
}
{
- # Header Corruption Tests
+ title "Header Corruption Tests";
my $string = <<EOM;
some text
title "ExtraField max raw size";
my $x ;
my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
- my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
- ok $z, "Created IO::Compress::Gzip object" ;
+ {
+ my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
+ ok $z, "Created IO::Compress::Gzip object" ;
+ }
my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
ok $gunz, "Created IO::Uncompress::Gunzip object" ;
my $hdr = $gunz->getHeaderInfo();
my $string = <<EOM;
some text
EOM
+ $string = $string x 1000;
my $good ;
{
foreach my $strict (0, 1)
{
- ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict => $strict ;
+ ok my $gunz = new IO::Uncompress::Gunzip $name, Append => 1, -Strict => $strict ;
my $uncomp ;
+ my $status = 1;
+ $status = $gunz->read($uncomp) while $status > 0;
if ($strict)
{
- ok $gunz->read($uncomp) < 0 ;
+ cmp_ok $status, '<', 0 ;
like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
}
else
{
- ok $gunz->read($uncomp) > 0 ;
- ok ! $GunzipError ;
+ is $status, 0, "status 0";
+ ok ! $GunzipError, "no error" ;
my $expected = substr($buffer, - $got);
- is $gunz->trailingData(), $expected_trailing;
+ is $gunz->trailingData(), $expected_trailing, "trailing data";
}
ok $gunz->eof() ;
ok $uncomp eq $string;
foreach my $strict (0, 1)
{
ok my $gunz = new IO::Uncompress::Gunzip $name,
+ Append => 1,
-Strict => $strict ;
my $uncomp ;
+ my $status = 1;
+ $status = $gunz->read($uncomp) while $status > 0;
if ($strict)
{
- ok $gunz->read($uncomp) < 0 ;
+ cmp_ok $status, '<', 0 ;
my $got_len = $actual_len + 1;
like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
}
else
{
- ok $gunz->read($uncomp) > 0 ;
+ is $status, 0;
ok ! $GunzipError ;
#is $gunz->trailingData(), substr($buffer, - $got) ;
}
foreach my $strict (0, 1)
{
ok my $gunz = new IO::Uncompress::Gunzip $name,
+ -Append => 1,
-Strict => $strict ;
my $uncomp ;
+ my $status = 1;
+ $status = $gunz->read($uncomp) while $status > 0;
if ($strict)
{
- ok $gunz->read($uncomp) < 0 ;
+ cmp_ok $status, '<', 0 ;
like $GunzipError, '/Trailer Error: CRC mismatch/';
}
else
{
- ok $gunz->read($uncomp) > 0 ;
+ is $status, 0;
ok ! $GunzipError ;
}
ok ! $gunz->trailingData() ;
foreach my $strict (0, 1)
{
ok my $gunz = new IO::Uncompress::Gunzip $name,
+ -Append => 1,
-Strict => $strict ;
my $uncomp ;
+ my $status = 1;
+ $status = $gunz->read($uncomp) while $status > 0;
if ($strict)
{
- ok $gunz->read($uncomp) < 0 ;
+ cmp_ok $status, '<', 0 ;
like $GunzipError, '/Trailer Error: CRC mismatch/';
}
else
{
- ok $gunz->read($uncomp) > 0 ;
+ is $status, 0;
ok ! $GunzipError ;
}
ok $gunz->eof() ;
my $buffer ;
ok my $def = new IO::Compress::Deflate \$buffer, %opts ;
- is $def->write($string), length($string) ;
- ok $def->close ;
+ is $def->write($string), length($string), "write" ;
+ ok $def->close, "closed" ;
#print "ReadHeaderInfo\n"; hexDump(\$buffer);
ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1 ;
- my $uncomp ;
+ my $uncomp = "";
#ok $inf->read($uncomp) ;
my $actual = 0 ;
my $status = 1 ;
is $actual, length($string) ;
is $uncomp, $string;
- ok ! $inf->error() ;
- ok $inf->eof() ;
+ ok ! $inf->error(), "! error" ;
+ ok $inf->eof(), "eof" ;
ok my $hdr = $inf->getHeaderInfo();
ok $inf->close ;
# Check the Deflate Header Parameters
#========================================
-my $lex = new LexFile my $name ;
+#my $lex = new LexFile my $name ;
{
title "Check default header settings" ;
some text
EOM
+ $string = $string x 1000;
my $good ;
ok my $x = new IO::Compress::Deflate \$good ;
ok $x->write($string) ;
foreach my $s (0, 1)
{
title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ;
+ my $lex = new LexFile my $name ;
my $buffer = $good ;
my $expected_trailing = substr($good, -4, 4) ;
substr($expected_trailing, $trim) = '';
substr($buffer, $trim) = '';
writeFile($name, $buffer) ;
- ok my $gunz = new IO::Uncompress::Inflate $name, Strict => $s;
+ ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => $s;
my $uncomp ;
if ($s)
{
- ok $gunz->read($uncomp) < 0 ;
+ my $status ;
+ 1 while ($status = $gunz->read($uncomp)) > 0;
+ cmp_ok $status, "<", 0 ;
like $IO::Uncompress::Inflate::InflateError,"/Trailer Error: trailer truncated. Expected 4 bytes, got $got/",
"Trailer Error";
}
else
{
- is $gunz->read($uncomp), length $string ;
+ 1 while $gunz->read($uncomp) > 0;
+ is $uncomp, $string ;
}
ok $gunz->eof() ;
ok $uncomp eq $string;
my $buffer = $good ;
my $crc = unpack("N", substr($buffer, -4, 4));
substr($buffer, -4, 4) = pack('N', $crc+1);
+ my $lex = new LexFile my $name ;
writeFile($name, $buffer) ;
- ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 1;
+ ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 1;
my $uncomp ;
- ok $gunz->read($uncomp) < 0 ;
+ my $status ;
+ 1 while ($status = $gunz->read($uncomp)) > 0;
+ cmp_ok $status, "<", 0 ;
like $IO::Uncompress::Inflate::InflateError,'/Trailer Error: CRC mismatch/',
"Trailer Error: CRC mismatch";
ok $gunz->eof() ;
my $buffer = $good ;
my $crc = unpack("N", substr($buffer, -4, 4));
substr($buffer, -4, 4) = pack('N', $crc+1);
+ my $lex = new LexFile my $name ;
writeFile($name, $buffer) ;
- ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 0;
+ ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 0;
my $uncomp ;
- ok $gunz->read($uncomp) >= 0 ;
+ my $status ;
+ 1 while ($status = $gunz->read($uncomp)) > 0;
+ cmp_ok $status, '>=', 0 ;
ok $gunz->eof() ;
ok ! $gunz->trailingData() ;
ok $uncomp eq $string;
my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ;
-my $file1 = "hello1.gz" ;
-my $file2 = "hello2.gz" ;
-my $stderr = "err.out" ;
-
-for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
-
+my ($file1, $file2, $stderr) ;
+my $lex = new LexFile $file1, $file2, $stderr ;
bzip2 \$hello1 => $file1 ;
bzip2 \$hello2 => $file2 ;
my $command = shift ;
my $expected = shift ;
- my $stderr = 'err.out';
- 1 while unlink $stderr;
+ my $lex = new LexFile my $stderr ;
my $cmd = "$command 2>$stderr";
my $stdout = `$cmd` ;
title "bzcat" ;
check "$Perl ${examples}/bzcat $file2", $hello1 ;
}
-
-END
-{
- for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
-}
-
my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ;
-my $file1 = "hello1.gz" ;
-my $file2 = "hello2.gz" ;
-my $stderr = "err.out" ;
-
-for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
-
+my ($file1, $file2, $stderr) ;
+my $lex = new LexFile $file1, $file2, $stderr ;
gzip \$hello1 => $file1 ;
gzip \$hello2 => $file2 ;
my $command = shift ;
my $expected = shift ;
- my $stderr = 'err.out';
- 1 while unlink $stderr;
+ my $lex = new LexFile my $stderr ;
+
my $cmd = "$command 2>$stderr";
my $stdout = `$cmd` ;
title "gzcat" ;
check "$Perl ${examples}/gzcat $file2", $hello1 ;
}
-
-END
-{
- for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
-}
-
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 3308 + $extra;
+ plan tests => 4012 + $extra;
};
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 2552 + $extra;
+ plan tests => 3056 + $extra;
};
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 3040 + $extra;
+ plan tests => 3544 + $extra;
};
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 7732 + $extra;
+ plan tests => 9156 + $extra;
};
like $@, @_ ;
}
+BEGIN {
+ eval {
+ require File::Temp;
+ } ;
+
+}
+
+
{
package LexFile ;
my $self = shift ;
foreach (@_)
{
- # autogenerate the name unless if none supplied
- $_ = "tst" . $index ++ . ".tmp"
+ Carp::croak "NO!!!!" if defined $_;
+ # autogenerate the name if none supplied
+ $_ = "tst" . $$ . "X" . $index ++ . ".tmp"
unless defined $_;
}
chmod 0777, @_;
package LexDir ;
use File::Path;
+
+ our ($index);
+ $index = '00000';
+ our ($useTempFile) = defined &File::Temp::tempdir;
+ our ($useTempDir) = defined &File::Temp::newdir;
+
sub new
{
my $self = shift ;
- foreach (@_) { rmtree $_ }
- bless [ @_ ], $self ;
+
+ if ( $useTempDir)
+ {
+ foreach (@_)
+ {
+ Carp::croak "NO!!!!" if defined $_;
+ $_ = File::Temp->newdir(DIR => '.');
+ }
+ bless [ @_ ], $self ;
+ }
+ elsif ( $useTempFile)
+ {
+ foreach (@_)
+ {
+ Carp::croak "NO!!!!" if defined $_;
+ $_ = File::Temp::tempdir(DIR => '.', CLEANUP => 1);
+ }
+ bless [ @_ ], $self ;
+ }
+ else
+ {
+ foreach (@_)
+ {
+ Carp::croak "NO!!!!" if defined $_;
+ # autogenerate the name if none supplied
+ $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ;
+ }
+ foreach (@_) { rmtree $_; mkdir $_, 0777 }
+ bless [ @_ ], $self ;
+ }
+
}
sub DESTROY
{
- my $self = shift ;
- foreach (@$self) { rmtree $_ }
+ if (! $useTempFile)
+ {
+ my $self = shift ;
+ foreach (@$self) { rmtree $_ }
+ }
}
}
+
sub readFile
{
my $f = shift ;
use bytes;
use Test::More ;
-use CompTestUtils;
use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
+use CompTestUtils;
our ($UncompressClass);
BEGIN
$extra = 1
if $st ;
- plan(tests => 666 + $extra) ;
+ plan(tests => 794 + $extra) ;
}
sub myGZreadFile
{
local $/; # slurp mode
my $io = $UncompressClass->new($name);
- is $., 0;
+ is $., 0, "line 0";
is $io->input_line_number, 0;
- ok ! $io->eof;
+ ok ! $io->eof, "eof";
my @lines = $io->getlines;
- is $., 1;
- is $io->input_line_number, 1;
- ok $io->eof;
+ is $., 1, "line 1";
+ is $io->input_line_number, 1, "line number 1";
+ ok $io->eof, "eof" ;
ok @lines == 1 && $lines[0] eq $str;
$io = $UncompressClass->new($name);
and a single line.
EOT
-
my $lex = new LexFile my $name ;
writeFile($name, $str);
{
my $io = new $UncompressClass $name, -Transparent => 1 ;
- ok defined $io;
- ok ! $io->eof;
- ok $io->tell() == 0 ;
+ isa_ok $io, $UncompressClass ;
+ ok ! $io->eof, "eof";
+ is $io->tell(), 0, "tell == 0" ;
my @lines = $io->getlines();
- is @lines, 6;
+ is @lines, 6, "got 6 lines";
ok $lines[1] eq "of a paragraph\n" ;
ok join('', @lines) eq $str ;
is $., 6;
my $line = $io->getline;
is $., 1;
is $io->input_line_number, 1;
- ok $line eq $str;
+ is $line, $str;
ok $io->eof;
}
# }
}
-}
+ {
+ # Check can handle empty compressed files
+ # Test is for rt.cpan #67554
-1;
+ foreach my $type (qw(filename filehandle buffer ))
+ {
+ foreach my $append (0, 1)
+ {
+ title "$UncompressClass -- empty file read from $type, Append => $append";
+ my $appended = "append";
+ my $string = "some data";
+ my $compressed ;
+ my $c = new $CompressClass(\$compressed);
+ $c->close();
+ my $comp_len = length $compressed;
+ $compressed .= $appended if $append ;
+ my $lex = new LexFile my $name ;
+ my $input ;
+ writeFile ($name, $compressed);
+ if ($type eq 'buffer')
+ {
+ $input = \$compressed;
+ }
+ elsif ($type eq 'filename')
+ {
+ $input = $name;
+ }
+ elsif ($type eq 'filehandle')
+ {
+ my $fh = new IO::File "<$name" ;
+ ok $fh, "opened file $name ok";
+ $input = $fh ;
+ }
+
+ {
+ # Check that eof is true immediately after creating the
+ # uncompression object.
+
+ # Check that readline returns undef
+
+ my $x = new $UncompressClass $input, Transparent => 0
+ or diag "$$UnError" ;
+ isa_ok $x, $UncompressClass;
+
+ # should be EOF immediately
+ is $x->eof(), 1, "eof true";
+
+ is <$x>, undef, "getline is undef";
+
+ is $x->eof(), 1, "eof true";
+ }
+
+ {
+ # Check that read return an empty string
+ if ($type eq 'filehandle')
+ {
+ my $fh = new IO::File "<$name" ;
+ ok $fh, "opened file $name ok";
+ $input = $fh ;
+ }
+
+ my $x = new $UncompressClass $input, Transparent => 0
+ or diag "$$UnError" ;
+ isa_ok $x, $UncompressClass;
+
+ my $buffer;
+ is $x->read($buffer), 0, "read 0 bytes";
+ ok defined $buffer, "buffer is defined";
+ is $buffer, "", "buffer is empty string";
+
+ is $x->eof(), 1, "eof true";
+ }
+
+ {
+ # Check that read return an empty string in Append Mode
+ # to empty string
+
+ if ($type eq 'filehandle')
+ {
+ my $fh = new IO::File "<$name" ;
+ ok $fh, "opened file $name ok";
+ $input = $fh ;
+ }
+ my $x = new $UncompressClass $input, Transparent => 0,
+ Append => 1
+ or diag "$$UnError" ;
+ isa_ok $x, $UncompressClass;
+
+ my $buffer;
+ is $x->read($buffer), 0, "read 0 bytes";
+ ok defined $buffer, "buffer is defined";
+ is $buffer, "", "buffer is empty string";
+
+ is $x->eof(), 1, "eof true";
+ }
+ {
+ # Check that read return an empty string in Append Mode
+ # to non-empty string
+
+ if ($type eq 'filehandle')
+ {
+ my $fh = new IO::File "<$name" ;
+ ok $fh, "opened file $name ok";
+ $input = $fh ;
+ }
+ my $x = new $UncompressClass($input, Append => 1 );
+ isa_ok $x, $UncompressClass;
+
+ my $buffer = "123";
+ is $x->read($buffer), 0, "read 0 bytes";
+ ok defined $buffer, "buffer is defined";
+ is $buffer, "123", "buffer orig string";
+
+ is $x->eof(), 1, "eof true";
+ }
+ }
+ }
+ }
+}
+
+1;
ok ! $CompressClass->new($buffer, Merge => 1), " constructor fails";
{
- like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file|Inflation Error: data error)/', " got Bad Magic" ;
+ like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file|Inflation Error: data error)?/', " got Bad Magic" ;
}
}
}
{
- my $dir = "tmpdir";
+ my $dir ;
my $lex = new LexDir $dir ;
- mkdir $dir, 0777 ;
+ my $d = quotemeta $dir;
- $a = $Func->($dir, \$x) ;
+ $a = $Func->("$dir", \$x) ;
is $a, undef, " $TopType returned undef";
- like $$Error, "/input file '$dir' is a directory/",
+ like $$Error, "/input file '$d' is a directory/",
' Input filename is a directory';
- $a = $Func->(\$x, $dir) ;
+ $a = $Func->(\$x, "$dir") ;
is $a, undef, " $TopType returned undef";
- like $$Error, "/output file '$dir' is a directory/",
+ like $$Error, "/output file '$d' is a directory/",
' Output filename is a directory';
}
for my $files ( [qw(a1)], [qw(a1 a2 a3)] )
{
- my $tmpDir1 = 'tmpdir1';
- my $tmpDir2 = 'tmpdir2';
+ my $tmpDir1 ;
+ my $tmpDir2 ;
my $lex = new LexDir($tmpDir1, $tmpDir2) ;
-
- mkdir $tmpDir1, 0777;
- mkdir $tmpDir2, 0777;
+ my $d1 = quotemeta $tmpDir1 ;
+ my $d2 = quotemeta $tmpDir2 ;
ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
- #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
my @files = map { "$tmpDir1/$_.tmp" } @$files ;
foreach (@files) { writeFile($_, "abc $_") }
my @expected = map { "abc $_" } @files ;
- my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
+ my @outFiles = map { s/$d1/$tmpDir2/; $_ } @files ;
{
title "$TopType - From FileGlob to FileGlob files [@$files]" ;
{
title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ;
- my $filename = "abcde";
- my $lex = new LexFile($filename) ;
+ my $lex = new LexFile(my $filename) ;
ok &$Func("<$tmpDir1/a*.tmp>" => $filename,
MultiStream => $ms), ' Compressed ok'
{
title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ;
- my $filename = "abcde";
- my $lex = new LexFile($filename) ;
+ my $lex = new LexFile(my $filename) ;
my $fh = new IO::File ">$filename";
ok &$Func("<$tmpDir1/a*.tmp>" => $fh,
my $Func = getTopFuncRef($bit);
my $TopType = getTopFuncName($bit);
- my $tmpDir1 = 'tmpdir1';
- my $tmpDir2 = 'tmpdir2';
+ my $tmpDir1 ;
+ my $tmpDir2 ;
my $lex = new LexDir($tmpDir1, $tmpDir2) ;
-
- mkdir $tmpDir1, 0777;
- mkdir $tmpDir2, 0777;
+ my $d1 = quotemeta $tmpDir1 ;
+ my $d2 = quotemeta $tmpDir2 ;
my @opts = ();
@opts = (RawInflate => 1, UnLzma => 1)
if $bit eq 'IO::Uncompress::AnyUncompress';
ok -d $tmpDir1, " Temp Directory $tmpDir1 exists";
- #ok ! -d $tmpDir2, " Temp Directory $tmpDir2 does not exist";
my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ;
foreach (@files) { writeFile($_, compressBuffer($UncompressClass, "abc $_")) }
my @expected = map { "abc $_" } @files ;
- my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
+ my @outFiles = map { s/$d1/$tmpDir2/; $_ } @files ;
{
title "$TopType - From FileGlob to FileGlob" ;
{
title "$TopType - From FileGlob to Filehandle" ;
- my $output = 'abc' ;
- my $lex = new LexFile $output ;
+ my $lex = new LexFile my $output ;
my $fh = new IO::File ">$output" ;
ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok'
or diag $$Error ;
1 while <$gz> ;
}
ok $gz->error() ;
+ cmp_ok $gz->errorNo(), '<', 0 ;
ok $gz->eof() ;
$gz->close();
}
title 'memGzip & memGunzip';
{
- my $name = "test.gz" ;
+ my ($name, $name1, $name2, $name3);
+ my $lex = new LexFile $name, $name1, $name2, $name3 ;
my $buffer = <<EOM;
some sample
text
ok $uncomp eq $buffer ;
- 1 while unlink $name ;
+ #1 while unlink $name ;
# now check that memGunzip can deal with it.
my $ungzip = memGunzip($dest) ;
is $gzerrno, 0;
# write it to disk
- ok open(FH, ">$name") ;
+ ok open(FH, ">$name1") ;
binmode(FH);
print FH $dest ;
close FH ;
# uncompress with gzopen
- ok $fil = gzopen($name, "rb") ;
+ ok $fil = gzopen($name1, "rb") ;
ok (($x = $fil->gzread($uncomp)) == $len) ;
cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
- 1 while unlink $name ;
+ #1 while unlink $name ;
# check corrupt header -- too short
$dest = "x" ;
ok my $x = new $CompressClass(\$compressed) ;
my $input .= $hello;
- is $x->write($hello), $len_hello ;
+ is $x->write($hello), $len_hello, "wrote $len_hello bytes" ;
# Change both Level & Strategy
- ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY);
+ ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok";
$input .= $goodbye;
- is $x->write($goodbye), $len_goodbye ;
+ is $x->write($goodbye), $len_goodbye, "wrote $len_goodbye bytes" ;
- ok $x->close ;
+ ok $x->close, "closed $CompressClass object" ;
- ok my $k = new $UncompressClass(\$compressed);
+ my $k = new $UncompressClass(\$compressed);
+ isa_ok $k, $UncompressClass;
my $len = length $input ;
my $uncompressed;
is $k->read($uncompressed, $len), $len
or diag "$IO::Uncompress::Gunzip::GunzipError" ;
- ok $uncompressed eq $input ;
- ok $k->eof ;
- ok $k->close ;
- ok $k->eof ;
+ ok $uncompressed eq $input, "got expected uncompressed data"
+ or diag("unc len = " . length($uncompressed) . ", input len = " .
+ length($input) . "\n") ;
+ ok $k->eof, "eof" ;
+ ok $k->close, "closed" ;
+ ok $k->eof, "eof" ;
}
{
title "input glob matches zero files";
- my $tmpDir = 'td';
+ #my $tmpDir = 'td';
+ my $tmpDir ;
my $lex = new LexDir $tmpDir;
+ my $d = quotemeta $tmpDir;
- my $gm = new File::GlobMapper("$tmpDir/Z*", '*.X');
+ my $gm = new File::GlobMapper("$d/Z*", '*.X');
ok $gm, " created GlobMapper object" ;
my $map = $gm->getFileMap() ;
{
title 'test wildcard mapping of * in destination';
- my $tmpDir = 'td';
+ #my $tmpDir = 'td';
+ my $tmpDir ;
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
{
title 'no wildcards in input or destination';
- my $tmpDir = 'td';
+ #my $tmpDir = 'td';
+ my $tmpDir ;
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
{
title 'test wildcard mapping of {} in destination';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
{
title 'test wildcard mapping of multiple * to #';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
{
title 'test wildcard mapping of multiple ? to #';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
{
title 'test wildcard mapping of multiple ?,* and [] to #';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
- my $gm = new File::GlobMapper("./$tmpDir/?b[a-z]*.tmp", "./$tmpDir/X-#3-#2-#1-X");
+ my $gm = new File::GlobMapper("$tmpDir/?b[a-z]*.tmp", "$tmpDir/X-#3-#2-#1-X");
ok $gm, " created GlobMapper object" ;
#diag "Input pattern is $gm->{InputPattern}";
my $map = $gm->getFileMap() ;
is @{ $map }, 3, " returned 3 maps";
is_deeply $map,
- [ [map { "./$tmpDir/$_" } qw(abc1.tmp X-1-c-a-X)],
- [map { "./$tmpDir/$_" } qw(abc2.tmp X-2-c-a-X)],
- [map { "./$tmpDir/$_" } qw(abc3.tmp X-3-c-a-X)],
+ [ [map { "$tmpDir/$_" } qw(abc1.tmp X-1-c-a-X)],
+ [map { "$tmpDir/$_" } qw(abc2.tmp X-2-c-a-X)],
+ [map { "$tmpDir/$_" } qw(abc3.tmp X-3-c-a-X)],
], " got mapping";
}
{
title 'input glob matches a file multiple times';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch "$tmpDir/abc.tmp";
{
title 'multiple input files map to one output file';
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc def) ;
{
title "globmap" ;
- my $tmpDir = 'td';
+ my $tmpDir ;#= 'td';
my $lex = new LexDir $tmpDir;
- mkdir $tmpDir, 0777 ;
+ #mkdir $tmpDir, 0777 ;
touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
projects / platform / upstream / perl.git / commitdiff