diff options
| author | Richard Leach <richardleach@users.noreply.github.com> | 2021-01-18 02:23:31 +0000 |
|---|---|---|
| committer | Richard Leach <richardleach@users.noreply.github.com> | 2021-01-18 02:23:31 +0000 |
| commit | 3b97bda7a8e804addcbd10fb61a354d31351ce0c (patch) | |
| tree | aff268ee4f63e5508b6daa1895442284c82fd0b8 | |
| parent | 8d01fcd8d240d5051df69aa7e48deb774903458f (diff) | |
| download | perl-3b97bda7a8e804addcbd10fb61a354d31351ce0c.tar.gz | |
Update IO-Compress from 2.096 to 2.100
75 files changed, 2190 insertions, 2219 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9fc3279175..ab5ab5e313 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -636,7 +636,7 @@ use File::Glob qw(:case); }, 'IO-Compress' => { - 'DISTRIBUTION' => 'PMQS/IO-Compress-2.096.tar.gz', + 'DISTRIBUTION' => 'PMQS/IO-Compress-2.100.tar.gz', 'FILES' => q[cpan/IO-Compress], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/IO-Compress/Makefile.PL b/cpan/IO-Compress/Makefile.PL index 1249a3c7a0..d55f014296 100644 --- a/cpan/IO-Compress/Makefile.PL +++ b/cpan/IO-Compress/Makefile.PL @@ -3,7 +3,7 @@ use strict ; require 5.006 ; -$::VERSION = '2.096' ; +$::VERSION = '2.100' ; use lib '.'; use private::MakeUtil; diff --git a/cpan/IO-Compress/bin/zipdetails b/cpan/IO-Compress/bin/zipdetails index 6a054cd4cd..55276af67b 100644 --- a/cpan/IO-Compress/bin/zipdetails +++ b/cpan/IO-Compress/bin/zipdetails @@ -188,7 +188,7 @@ my %Extras = ( ); -my $VERSION = "2.01" ; +my $VERSION = "2.02" ; my $FH; @@ -198,10 +198,10 @@ my $LocalHeaderCount = 0; my $CentralHeaderCount = 0; my $START; -my $OFFSET = new U64 0; +my $OFFSET = U64->new( 0 ); my $TRAILING = 0 ; -my $PAYLOADLIMIT = 256; #new U64 256; -my $ZERO = new U64 0 ; +my $PAYLOADLIMIT = 256; # U64->new( 256 ); +my $ZERO = U64->new( 0 ); sub prOff { @@ -595,7 +595,7 @@ sub read_U64 myRead($b, 8); my ($lo, $hi) = unpack ("V V" , $b); no warnings 'uninitialized'; - return ($b, new U64 $hi, $lo); + return ($b, U64->new( $hi, $lo) ); } sub read_VV @@ -714,7 +714,7 @@ die "$filename does not exist\n" die "$filename not a standard file\n" unless -f $filename ; -$FH = new IO::File "<$filename" +$FH = IO::File->new( "<$filename" ) or die "Cannot open $filename: $!\n"; @@ -901,7 +901,7 @@ sub LocalHeader myRead($filename, $filenameLength); outputFilename($filename); - my $cl64 = new U64 $compressedLength ; + my $cl64 = U64->new( $compressedLength ); my %ExtraContext = (); if ($extraLength) { @@ -1154,7 +1154,7 @@ sub GeneralPurposeBits if ($method == ZIP_CM_DEFLATE) { - my $mid = $gp & 0x03; + my $mid = ($gp >> 1) & 0x03 ; out1 "[Bits 1-2]", "$mid '$lookup{$mid}'"; } @@ -1171,8 +1171,8 @@ sub GeneralPurposeBits if ($method == ZIP_CM_IMPLODE) # Imploding { - out1 "[Bit 1]", ($gp & 1 ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ; - out1 "[Bit 2]", ($gp & 2 ? "1 '3" : "0 '2" ) . " Shannon-Fano Trees'" ; + out1 "[Bit 1]", ($gp & (1 << 1) ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ; + out1 "[Bit 2]", ($gp & (2 << 1) ? "1 '3" : "0 '2" ) . " Shannon-Fano Trees'" ; } out1 "[Bit 3]", "1 'Streamed'" if $gp & ZIP_GP_FLAG_STREAMING_MASK; @@ -1363,7 +1363,7 @@ sub Ntfs2Unix # NTFS offset is 19DB1DED53E8000 my $hex = Value_U64($u64) ; - my $NTFS_OFFSET = new U64 0x19DB1DE, 0xD53E8000 ; + my $NTFS_OFFSET = U64->new( 0x19DB1DE, 0xD53E8000 ); $u64->subtract($NTFS_OFFSET); my $elapse = $u64->get64bit(); my $ns = ($elapse % 10000000) * 100; @@ -1766,8 +1766,8 @@ sub scanCentralDirectory my $got = [$locHeaderOffset, $compressedLength] ; - # my $v64 = new U64 $compressedLength ; - # my $loc64 = new U64 $locHeaderOffset ; + # my $v64 = U64->new( $compressedLength ); + # my $loc64 = U64->new( $locHeaderOffset ); # my $got = [$loc64, $v64] ; # if (full32 $compressedLength || full32 $locHeaderOffset) { @@ -2285,7 +2285,7 @@ OPTIONS -v Verbose - output more stuff --version Print version number -Copyright (c) 2011-2020 Paul Marquess. All rights reserved. +Copyright (c) 2011-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/IO-Compress/lib/Compress/Zlib.pm b/cpan/IO-Compress/lib/Compress/Zlib.pm index 1290b1d633..2380271289 100644 --- a/cpan/IO-Compress/lib/Compress/Zlib.pm +++ b/cpan/IO-Compress/lib/Compress/Zlib.pm @@ -7,18 +7,18 @@ use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); -use IO::Compress::Base::Common 2.096 ; -use Compress::Raw::Zlib 2.096 ; -use IO::Compress::Gzip 2.096 ; -use IO::Uncompress::Gunzip 2.096 ; +use IO::Compress::Base::Common 2.100 ; +use Compress::Raw::Zlib 2.100 ; +use IO::Compress::Gzip 2.100 ; +use IO::Uncompress::Gunzip 2.100 ; use strict ; use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.096'; -$XS_VERSION = $VERSION; +$VERSION = '2.100'; +$XS_VERSION = $VERSION; $VERSION = eval $VERSION; @ISA = qw(Exporter); @@ -126,7 +126,7 @@ sub gzopen($$) my @params = () ; croak "gzopen: file parameter is not a filehandle or filename" - unless isaFilehandle $file || isaFilename $file || + unless isaFilehandle $file || isaFilename $file || (ref $file && ref $file eq 'SCALAR'); return undef unless $mode =~ /[rwa]/i ; @@ -134,17 +134,17 @@ sub gzopen($$) _set_gzerr(0) ; if ($writing) { - $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, - %defOpts) + $gz = IO::Compress::Gzip->new($file, Minimal => 1, AutoClose => 1, + %defOpts) or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; } else { - $gz = new IO::Uncompress::Gunzip($file, + $gz = IO::Uncompress::Gunzip->new($file, Transparent => 1, - Append => 0, - AutoClose => 1, + Append => 0, + AutoClose => 1, MultiStream => 1, - Strict => 0) + Strict => 0) or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; } @@ -161,7 +161,7 @@ sub Compress::Zlib::gzFile::gzread return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'inflate'; - my $len = defined $_[1] ? $_[1] : 4096 ; + my $len = defined $_[1] ? $_[1] : 4096 ; my $gz = $self->[0] ; if ($self->gzeof() || $len == 0) { @@ -171,7 +171,7 @@ sub Compress::Zlib::gzFile::gzread return 0 ; } - my $status = $gz->read($_[0], $len) ; + my $status = $gz->read($_[0], $len) ; _save_gzerr($gz, 1); return $status ; } @@ -185,7 +185,7 @@ sub Compress::Zlib::gzFile::gzreadline # Maintain backward compatibility with 1.x behaviour # It didn't support $/, so this can't either. local $/ = "\n" ; - $_[0] = $gz->getline() ; + $_[0] = $gz->getline() ; } _save_gzerr($gz, 1); return defined $_[0] ? length $_[0] : 0 ; @@ -199,7 +199,7 @@ sub Compress::Zlib::gzFile::gzwrite return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; - $] >= 5.008 and (utf8::downgrade($_[0], 1) + $] >= 5.008 and (utf8::downgrade($_[0], 1) or croak "Wide character in gzwrite"); my $status = $gz->write($_[0]) ; @@ -282,8 +282,8 @@ sub Compress::Zlib::gzFile::gzsetparams return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; - - my $status = *$gz->{Compress}->deflateParams(-Level => $level, + + my $status = *$gz->{Compress}->deflateParams(-Level => $level, -Strategy => $strategy); _save_gzerr($gz); return $status ; @@ -293,7 +293,7 @@ sub Compress::Zlib::gzFile::gzerror { my $self = shift ; my $gz = $self->[0] ; - + return $Compress::Zlib::gzerrno ; } @@ -310,7 +310,7 @@ sub compress($;$) $in = \$_[0] ; } - $] >= 5.008 and (utf8::downgrade($$in, 1) + $] >= 5.008 and (utf8::downgrade($$in, 1) or croak "Wide character in compress"); my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); @@ -322,7 +322,7 @@ sub compress($;$) MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, - '') + '') or return undef ; $err = $x->deflate($in, $output) ; @@ -330,7 +330,7 @@ sub compress($;$) $err = $x->flush($output) ; return undef unless $err == Z_OK() ; - + return $output ; } @@ -346,21 +346,21 @@ sub uncompress($) $in = \$_[0] ; } - $] >= 5.008 and (utf8::downgrade($$in, 1) - or croak "Wide character in uncompress"); - + $] >= 5.008 and (utf8::downgrade($$in, 1) + or croak "Wide character in uncompress"); + my ($obj, $status) = Compress::Raw::Zlib::_inflateInit(0, - MAX_WBITS, 4096, "") ; - - $status == Z_OK + MAX_WBITS, 4096, "") ; + + $status == Z_OK or return undef; - - $obj->inflate($in, $output) == Z_STREAM_END + + $obj->inflate($in, $output) == Z_STREAM_END or return undef; - + return $output; } - + sub deflateInit(@) { my ($got) = ParseParameters(0, @@ -374,27 +374,27 @@ sub deflateInit(@) 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_ ) ; - croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . + croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $obj ; - + my $status = 0 ; - ($obj, $status) = + ($obj, $status) = Compress::Raw::Zlib::_deflateInit(0, - $got->getValue('level'), - $got->getValue('method'), - $got->getValue('windowbits'), - $got->getValue('memlevel'), - $got->getValue('strategy'), + $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 ; } - + sub inflateInit(@) { my ($got) = ParseParameters(0, @@ -405,15 +405,15 @@ sub inflateInit(@) }, @_) ; - croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . + croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $status = 0 ; my $obj ; ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, - $got->getValue('windowbits'), - $got->getValue('bufsize'), + $got->getValue('windowbits'), + $got->getValue('bufsize'), $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; @@ -442,7 +442,7 @@ sub flush my $output ; my $flag = shift || Compress::Zlib::Z_FINISH(); my $status = $self->SUPER::flush($output, $flag) ; - + wantarray ? ($output, $status) : $output ; } @@ -461,7 +461,7 @@ sub inflate package Compress::Zlib ; -use IO::Compress::Gzip::Constants 2.096 ; +use IO::Compress::Gzip::Constants 2.100 ; sub memGzip($) { @@ -473,13 +473,13 @@ sub memGzip($) MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, - '') + '') or return undef ; - + # if the deflation buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]) ; - $] >= 5.008 and (utf8::downgrade($$string, 1) + $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGzip"); my $out; @@ -487,12 +487,12 @@ sub memGzip($) $x->deflate($string, $out) == Z_OK or return undef ; - + $x->flush($out) == Z_OK or return undef ; - - return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . - $out . + + return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . + $out . pack("V V", $x->crc32(), $x->total_in()); } @@ -501,10 +501,10 @@ sub _removeGzipHeader($) { my $string = shift ; - return Z_DATA_ERROR() + return Z_DATA_ERROR() if length($$string) < GZIP_MIN_HEADER_SIZE ; - my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = + my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = unpack ('CCCCVCC', $$string); return Z_DATA_ERROR() @@ -551,7 +551,7 @@ sub _removeGzipHeader($) if length ($$string) < GZIP_FHCRC_SIZE ; substr($$string, 0, GZIP_FHCRC_SIZE) = ''; } - + return Z_OK(); } @@ -566,24 +566,24 @@ sub memGunzip($) { # if the buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]); - - $] >= 5.008 and (utf8::downgrade($$string, 1) + + $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGunzip"); _set_gzerr(0); my $status = _removeGzipHeader($string) ; - $status == Z_OK() + $status == Z_OK() or return _set_gzerr_undef($status); - + my $bufsize = length $$string > 4096 ? length $$string : 4096 ; my $x = Compress::Raw::Zlib::_inflateInit(FLAG_CRC | FLAG_CONSUME_INPUT, - -MAX_WBITS(), $bufsize, '') + -MAX_WBITS(), $bufsize, '') or return _ret_gun_error(); my $output = '' ; $status = $x->inflate($string, $output); - + if ( $status == Z_OK() ) { _set_gzerr(Z_DATA_ERROR()); @@ -606,7 +606,7 @@ sub memGunzip($) $$string = ''; } - return $output; + return $output; } # Autoload methods go after __END__, and are processed by the autosplit program. @@ -938,23 +938,23 @@ I<gzcat> function. use strict ; use warnings ; - + use Compress::Zlib ; - + # use stdin if no files supplied @ARGV = '-' unless @ARGV ; - + foreach my $file (@ARGV) { my $buffer ; - + my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; - + print $buffer while $gz->gzread($buffer) > 0 ; - + die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n" if $gzerrno != Z_STREAM_END ; - + $gz->gzclose() ; } @@ -963,28 +963,28 @@ very simple I<grep> like script. use strict ; use warnings ; - + use Compress::Zlib ; - + die "Usage: gzgrep pattern [file...]\n" unless @ARGV >= 1; - + my $pattern = shift ; - + # use stdin if no files supplied @ARGV = '-' unless @ARGV ; - + foreach my $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; - + while ($gz->gzreadline($_) > 0) { print if /$pattern/ ; } - + die "Error reading from $file: $gzerrno\n" if $gzerrno != Z_STREAM_END ; - + $gz->gzclose() ; } @@ -994,14 +994,14 @@ standard output. use strict ; use warnings ; - + use Compress::Zlib ; - + binmode STDOUT; # gzopen only sets it on the fd - + my $gz = gzopen(\*STDOUT, "wb") or die "Cannot open stdout: $gzerrno\n" ; - + while (<>) { $gz->gzwrite($_) or die "error writing: $gzerrno\n" ; @@ -1275,18 +1275,18 @@ input, deflates it and writes it to standard output. while (<>) { ($output, $status) = $x->deflate($_) ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; } - + ($output, $status) = $x->flush() ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; =head1 Inflate Interface @@ -1313,13 +1313,13 @@ I<zlib> error code. The function optionally takes a number of named options specified as C<< -Name=>value >> pairs. This allows individual options to be tailored without having to specify them all in the parameter list. - + For backward compatibility, it is also possible to pass the parameters as a reference to a hash containing the name=>value pairs. - + The function takes one optional parameter, a reference to a hash. The contents of the hash allow the deflation interface to be tailored. - + Here is a list of the valid options: =over 5 @@ -1409,27 +1409,27 @@ Here is an example of using C<inflate>. use strict ; use warnings ; - + use Compress::Zlib ; - + my $x = inflateInit() or die "Cannot create a inflation stream\n" ; - + my $input = '' ; binmode STDIN; binmode STDOUT; - + my ($output, $status) ; while (read(STDIN, $input, 4096)) { ($output, $status) = $x->inflate(\$input) ; - + print $output if $status == Z_OK or $status == Z_STREAM_END ; - + last if $status != Z_OK ; } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1506,8 +1506,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 1995-2020 Paul Marquess. All rights reserved. +Copyright (c) 1995-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/File/GlobMapper.pm b/cpan/IO-Compress/lib/File/GlobMapper.pm index a4e5385565..f015b16567 100644 --- a/cpan/IO-Compress/lib/File/GlobMapper.pm +++ b/cpan/IO-Compress/lib/File/GlobMapper.pm @@ -51,7 +51,7 @@ sub globmap ($$;) my $inputGlob = shift ; my $outputGlob = shift ; - my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_) + my $obj = File::GlobMapper->new($inputGlob, $outputGlob, @_) or croak "globmap: $Error" ; return $obj->getFileMap(); } @@ -383,7 +383,7 @@ File::GlobMapper - Extend File Glob to Allow Input and Output Files my $aref = globmap $input => $output or die $File::GlobMapper::Error ; - my $gm = new File::GlobMapper $input => $output + my $gm = File::GlobMapper->new( $input => $output ) or die $File::GlobMapper::Error ; diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm index 635091e802..d20b62b9b3 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); -use Compress::Raw::Bzip2 2.096 ; +use Compress::Raw::Bzip2 2.100 ; our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkCompObject { @@ -21,7 +21,7 @@ sub mkCompObject $WorkFactor = 0 if ! defined $WorkFactor ; $Verbosity = 0 if ! defined $Verbosity ; - my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, + my ($def, $status) = Compress::Raw::Bzip2->new(1, $BlockSize100K, $WorkFactor, $Verbosity); return (undef, "Could not create Deflate object: $status", $status) @@ -30,7 +30,7 @@ sub mkCompObject return bless {'Def' => $def, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -44,11 +44,11 @@ sub compr if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -62,12 +62,12 @@ sub flush if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } sub close @@ -81,12 +81,12 @@ sub close if ($status != BZ_STREAM_END) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } @@ -96,18 +96,18 @@ sub reset my $outer = $self->{Outer}; - my ($def, $status) = new Compress::Raw::Bzip2(); + my ($def, $status) = Compress::Raw::Bzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Deflate object: $status"; + $self->{Error} = "Cannot create Deflate object: $status"; return STATUS_ERROR; } $self->{Def} = $def; - return STATUS_OK; + return STATUS_OK; } sub compressedBytes @@ -151,4 +151,3 @@ sub uncompressedBytes 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm index 4f6f1d6175..fc8332ce20 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm @@ -4,13 +4,13 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); -use Compress::Raw::Zlib 2.096 qw( !crc32 !adler32 ) ; - -require Exporter; +use IO::Compress::Base::Common 2.100 qw(:Status); +use Compress::Raw::Zlib 2.100 qw( !crc32 !adler32 ) ; + +require Exporter; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; @@ -24,20 +24,20 @@ sub mkCompObject my $level = shift ; my $strategy = shift ; - my ($def, $status) = new Compress::Raw::Zlib::Deflate + my ($def, $status) = Compress::Raw::Zlib::Deflate->new( -AppendOutput => 1, -CRC32 => $crc32, -ADLER32 => $adler32, -Level => $level, -Strategy => $strategy, - -WindowBits => - MAX_WBITS; + -WindowBits => - MAX_WBITS); - return (undef, "Cannot create Deflate object: $status", $status) - if $status != Z_OK; + return (undef, "Cannot create Deflate object: $status", $status) + if $status != Z_OK; return bless {'Def' => $def, 'Error' => '', - } ; + } ; } sub compr @@ -51,11 +51,11 @@ sub compr if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -70,11 +70,11 @@ sub flush if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub close @@ -97,14 +97,14 @@ sub reset $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; @@ -114,11 +114,11 @@ sub deflateParams $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "deflateParams Error: $status"; + $self->{Error} = "deflateParams Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } @@ -167,4 +167,3 @@ sub adler32 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm index 00b529b019..091e655bd4 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkCompObject { @@ -19,7 +19,7 @@ sub mkCompObject 'UnCompSize' => 0, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -30,7 +30,7 @@ sub compr $self->{CompSize} += length ${ $_[0] } ; $self->{UnCompSize} = $self->{CompSize} ; - if ( ref $_[1] ) + if ( ref $_[1] ) { ${ $_[1] } .= ${ $_[0] } } else { $_[1] .= ${ $_[0] } } @@ -43,14 +43,14 @@ sub flush { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub close { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub reset @@ -60,14 +60,14 @@ sub reset $self->{CompSize} = 0; $self->{UnCompSize} = 0; - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } #sub total_out @@ -98,4 +98,3 @@ sub uncompressedBytes __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Base.pm b/cpan/IO-Compress/lib/IO/Compress/Base.pm index 1f1942965b..bc49e01841 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Base.pm @@ -6,7 +6,7 @@ require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.096 ; +use IO::Compress::Base::Common 2.100 ; use IO::File (); ; use Scalar::Util (); @@ -20,7 +20,7 @@ use Symbol(); our (@ISA, $VERSION); @ISA = qw(IO::File Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; #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. @@ -254,8 +254,8 @@ sub _create *$obj->{Compress} = $obj->mkComp($got) or return undef; - *$obj->{UnCompSize} = new U64 ; - *$obj->{CompSize} = new U64 ; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; if ( $outType eq 'buffer') { ${ *$obj->{Buffer} } = '' @@ -279,7 +279,7 @@ sub _create my $mode = '>' ; $mode = '>>' if $appendOutput; - *$obj->{FH} = new IO::File "$mode $outValue" + *$obj->{FH} = IO::File->new( "$mode $outValue" ) or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; *$obj->{StdIO} = ($outValue eq '-'); setBinModeOutput(*$obj->{FH}) ; @@ -340,7 +340,7 @@ sub _def my $haveOut = @_ ; my $output = shift ; - my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) + my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output) or return undef ; push @_, $output if $haveOut && $x->{Hash}; @@ -493,7 +493,7 @@ sub _wr2 if ( ! $isFilehandle ) { - $fh = new IO::File "<$input" + $fh = IO::File->new( "<$input" ) or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; } binmode $fh ; @@ -983,23 +983,27 @@ sub _notAvailable return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; } -*read = _notAvailable('read'); -*READ = _notAvailable('read'); -*readline = _notAvailable('readline'); -*READLINE = _notAvailable('readline'); -*getc = _notAvailable('getc'); -*GETC = _notAvailable('getc'); - -*FILENO = \&fileno; -*PRINT = \&print; -*PRINTF = \&printf; -*WRITE = \&syswrite; -*write = \&syswrite; -*SEEK = \&seek; -*TELL = \&tell; -*EOF = \&eof; -*CLOSE = \&close; -*BINMODE = \&binmode; +{ + no warnings 'once'; + + *read = _notAvailable('read'); + *READ = _notAvailable('read'); + *readline = _notAvailable('readline'); + *READLINE = _notAvailable('readline'); + *getc = _notAvailable('getc'); + *GETC = _notAvailable('getc'); + + *FILENO = \&fileno; + *PRINT = \&print; + *PRINTF = \&printf; + *WRITE = \&syswrite; + *write = \&syswrite; + *SEEK = \&seek; + *TELL = \&tell; + *EOF = \&eof; + *CLOSE = \&close; + *BINMODE = \&binmode; +} #*sysread = \&_notAvailable; #*syswrite = \&_write; @@ -1047,8 +1051,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm index 37501a63e5..8f0530cddd 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm @@ -11,7 +11,7 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; @EXPORT = qw( isaFilehandle isaFilename isaScalar whatIsInput whatIsOutput @@ -160,7 +160,7 @@ sub whatIsInput($;$) #use IO::File; $got = 'handle'; $_[0] = *STDIN; - #$_[0] = new IO::File("<-"); + #$_[0] = IO::File->new("<-"); } return $got; @@ -174,7 +174,7 @@ sub whatIsOutput($;$) { $got = 'handle'; $_[0] = *STDOUT; - #$_[0] = new IO::File(">-"); + #$_[0] = IO::File->new(">-"); } return $got; @@ -267,7 +267,7 @@ sub IO::Compress::Base::Validator::new { $data{GlobMap} = 1 ; $data{inType} = $data{outType} = 'filename'; - my $mapper = new File::GlobMapper($_[0], $_[1]); + my $mapper = File::GlobMapper->new($_[0], $_[1]); if ( ! $mapper ) { return $obj->saveErrorString($File::GlobMapper::Error) ; @@ -509,7 +509,7 @@ sub ParseParameters return $_[1] if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters"); - my $p = new IO::Compress::Base::Parameters() ; + my $p = IO::Compress::Base::Parameters->new(); $p->parse(@_) or croak "$sub: $p->[IxError]" ; diff --git a/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm index 950366c378..88dd7f9bfe 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.096 ; +use IO::Compress::Base 2.100 ; -use IO::Compress::Base::Common 2.096 qw(); -use IO::Compress::Adapter::Bzip2 2.096 ; +use IO::Compress::Base::Common 2.100 qw(); +use IO::Compress::Adapter::Bzip2 2.100 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.096'; +$VERSION = '2.100'; $Bzip2Error = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -40,7 +40,7 @@ sub bzip2 } -sub mkHeader +sub mkHeader { my $self = shift ; return ''; @@ -51,9 +51,9 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.096 qw(:Parse); - - return ( + use IO::Compress::Base::Common 2.100 qw(:Parse); + + 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], @@ -66,7 +66,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + # check that BlockSize100K is a number between 1 & 9 if ($got->parsed('blocksize100k')) { my $value = $got->getValue('blocksize100k'); @@ -101,7 +101,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + return $obj; } @@ -133,7 +133,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } 1; @@ -151,7 +151,7 @@ IO::Compress::Bzip2 - Write bzip2 files/buffers my $status = bzip2 $input => $output [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "bzip2 failed: $Bzip2Error\n"; $z->print($string); @@ -426,7 +426,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; bzip2 $input => \$buffer @@ -463,7 +463,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Bzip2> is shown below - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "IO::Compress::Bzip2 failed: $Bzip2Error\n"; It returns an C<IO::Compress::Bzip2> object on success and undef on failure. @@ -818,8 +818,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm index 358e01989e..c3aa1eab78 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm @@ -8,16 +8,16 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.096 (); -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::RawDeflate 2.100 (); +use IO::Compress::Adapter::Deflate 2.100 ; -use IO::Compress::Zlib::Constants 2.096 ; -use IO::Compress::Base::Common 2.096 qw(); +use IO::Compress::Zlib::Constants 2.100 ; +use IO::Compress::Base::Common 2.100 qw(); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $DeflateError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -80,7 +80,7 @@ sub mkDeflateHdr($$$;$) return $hdr; } -sub mkHeader +sub mkHeader { my $self = shift ; my $param = shift ; @@ -89,7 +89,7 @@ sub mkHeader my $strategy = $param->getValue('strategy'); my $lflag ; - $level = 6 + $level = 6 if $level == Z_DEFAULT_COMPRESSION ; if (ZLIB_VERNUM >= 0x1210) @@ -118,7 +118,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + $got->setValue('adler32' => 1); return 1 ; } @@ -149,6 +149,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError); } @@ -158,7 +159,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } @@ -178,7 +179,7 @@ IO::Compress::Deflate - Write RFC 1950 files/buffers my $status = deflate $input => $output [,OPTS] or die "deflate failed: $DeflateError\n"; - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "deflate failed: $DeflateError\n"; $z->print($string); @@ -455,7 +456,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Deflate qw(deflate $DeflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; deflate $input => \$buffer @@ -492,7 +493,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Deflate> is shown below - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "IO::Compress::Deflate failed: $DeflateError\n"; It returns an C<IO::Compress::Deflate> object on success and undef on failure. @@ -951,8 +952,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/FAQ.pod b/cpan/IO-Compress/lib/IO/Compress/FAQ.pod index d6d11c7646..367468ec07 100644 --- a/cpan/IO-Compress/lib/IO/Compress/FAQ.pod +++ b/cpan/IO-Compress/lib/IO/Compress/FAQ.pod @@ -79,7 +79,7 @@ write a C<.tar.Z> file use Archive::Tar; use IO::File; - my $fh = new IO::File "| compress -c >$filename"; + my $fh = IO::File->new( "| compress -c >$filename" ); my $tar = Archive::Tar->new(); ... $tar->write($fh); @@ -101,7 +101,7 @@ recompression. my $gzipFile = "somefile.gz"; my $bzipFile = "somefile.bz2"; - my $gunzip = new IO::Uncompress::Gunzip $gzipFile + my $gunzip = IO::Uncompress::Gunzip->new( $gzipFile ) or die "Cannot gunzip $gzipFile: $GunzipError\n" ; bzip2 $gunzip => $bzipFile @@ -167,8 +167,8 @@ by including the C<Zip64> option. If you want to create a zip64 zip file with the OO interface you must specify the C<Zip64> option. - my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; - + my $zip = IO::Compress::Zip->new( "whatever", Zip64 => 1 ); + When uncompressing with C<IO-Uncompress-Unzip>, it will automatically detect if the zip file is zip64. @@ -300,14 +300,14 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm package Apache::GZip; #File: Apache::GZip.pm - + use strict vars; use Apache::Constants ':common'; use Compress::Zlib; use IO::File; use constant GZIP_MAGIC => 0x1f8b; use constant OS_MAGIC => 0x03; - + sub handler { my $r = shift; my ($fh,$gz); @@ -316,28 +316,28 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm $r->header_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; - + tie *STDOUT,'Apache::GZip',$r; print($_) while <$fh>; untie *STDOUT; return OK; } - + sub TIEHANDLE { my($class,$r) = @_; # initialize a deflation stream my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; - + # gzip header -- don't ask how I found out $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); - + return bless { r => $r, crc => crc32(undef), d => $d, l => 0 },$class; } - + sub PRINT { my $self = shift; foreach (@_) { @@ -349,18 +349,18 @@ L<http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.htm $self->{crc} = crc32($_,$self->{crc}); } } - + sub DESTROY { my $self = shift; - + # flush the output buffers my $data = $self->{d}->flush; $self->{r}->print($data); - + # print the CRC and the total length (uncompressed) $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); } - + 1; Here's the Apache configuration entry you'll need to make use of it. Once @@ -401,12 +401,12 @@ C<IO::Compress::Gzip> is used instead of C<Compress::Zlib> the whole tied filehandle code can be removed. Here is the rewritten code. package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip; use IO::File; - + sub handler { my $r = shift; my ($fh,$gz); @@ -416,22 +416,22 @@ filehandle code can be removed. Here is the rewritten code. $r->send_http_header; return OK if $r->header_only; - my $gz = new IO::Compress::Gzip '-', Minimal => 1 + my $gz = IO::Compress::Gzip->new( '-', Minimal => 1 ) or return DECLINED ; print $gz $_ while <$fh>; - + return OK; } - + or even more succinctly, like this, using a one-shot gzip package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip qw(gzip); - + sub handler { my $r = shift; $r->header_out('Content-Encoding'=>'gzip'); @@ -443,7 +443,7 @@ or even more succinctly, like this, using a one-shot gzip return OK; } - + 1; The use of one-shot C<gzip> above just reads from C<< $r->filename >> and @@ -468,7 +468,7 @@ read from the FTP Server. use Net::FTP; use IO::Uncompress::Gunzip qw(:all); - my $ftp = new Net::FTP ... + my $ftp = Net::FTP->new( ... ) my $retr_fh = $ftp->retr($compressed_filename); gunzip $retr_fh => $outFilename, AutoClose => 1 @@ -518,7 +518,7 @@ the other C<IO::Uncompress::*> modules. my $file = $ARGV[0] ; - my $fh = new IO::File "<$file" + my $fh = IO::File->new( "<$file" ) or die "Cannot open '$file': $!\n"; while (1) @@ -566,9 +566,9 @@ the other C<IO::Uncompress::*> modules. # Done reading the Local Header - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -585,14 +585,14 @@ The majority of the code above is concerned with reading the zip local header data. The code that I want to focus on is at the bottom. while (1) { - + # read local zip header data # get $filename # get $compressedLength - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -618,7 +618,7 @@ byte directly after the compressed data stream. Now consider what the code looks like without C<InputLength> while (1) { - + # read local zip header data # get $filename # get $compressedLength @@ -626,8 +626,8 @@ Now consider what the code looks like without C<InputLength> # read all the compressed data into $data read($fh, $data, $compressedLength); - my $inf = new IO::Uncompress::RawInflate \$data, - Transparent => 1, + my $inf = IO::Uncompress::RawInflate->new( \$data, + Transparent => 1 ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -682,7 +682,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm index 68f6008ef1..cf9d8e263a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm @@ -8,24 +8,24 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.096 () ; -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::RawDeflate 2.100 () ; +use IO::Compress::Adapter::Deflate 2.100 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Gzip::Constants 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Gzip::Constants 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; BEGIN { - if (defined &utf8::downgrade ) + if (defined &utf8::downgrade ) { *noUTF8 = \&utf8::downgrade } else - { *noUTF8 = sub {} } + { *noUTF8 = sub {} } } our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.096'; +$VERSION = '2.100'; $GzipError = '' ; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -65,7 +65,7 @@ sub getExtraParams return ( # zlib behaviour $self->getZlibParams(), - + # Gzip header fields 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 'comment' => [IO::Compress::Base::Common::Parse_any, undef], @@ -105,7 +105,7 @@ sub ckParams # Also check that they only contain ISO 8859-1 chars. 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 =~ /\x00/ ; @@ -132,16 +132,16 @@ sub ckParams 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->setValue('method' => Z_DEFLATED) ; if ( ! $got->parsed('extraflags')) { - $got->setValue('extraflags' => 2) + $got->setValue('extraflags' => 2) if $got->getValue('level') == Z_BEST_COMPRESSION ; - $got->setValue('extraflags' => 4) + $got->setValue('extraflags' => 4) if $got->getValue('level') == Z_BEST_SPEED ; } @@ -161,12 +161,13 @@ sub ckParams sub mkTrailer { my $self = shift ; - return pack("V V", *$self->{Compress}->crc32(), + return pack("V V", *$self->{Compress}->crc32(), *$self->{UnCompSize}->get32bit()); } sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError); } @@ -184,7 +185,7 @@ sub getFileInfo $params->setValue('name' => $filename) if ! $params->parsed('name') ; - $params->setValue('time' => $defaultTime) + $params->setValue('time' => $defaultTime) if ! $params->parsed('time') ; } @@ -207,7 +208,7 @@ sub mkHeader $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) ; @@ -218,7 +219,7 @@ sub mkHeader my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ; - my $out = pack("C4 V C C", + my $out = pack("C4 V C C", GZIP_ID1, # ID1 GZIP_ID2, # ID2 $method, # Compression Method @@ -240,7 +241,7 @@ sub mkHeader $name =~ s/\x00.*$//; $out .= $name ; # Terminate the filename with NULL unless it already is - $out .= GZIP_NULL_BYTE + $out .= GZIP_NULL_BYTE if !length $name or substr($name, 1, -1) ne GZIP_NULL_BYTE ; } @@ -257,7 +258,7 @@ sub mkHeader } # HEADER CRC - $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) + $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->getValue('headercrc') ; noUTF8($out); @@ -270,7 +271,7 @@ sub mkFinalTrailer return ''; } -1; +1; __END__ @@ -285,7 +286,7 @@ IO::Compress::Gzip - Write RFC 1952 files/buffers my $status = gzip $input => $output [,OPTS] or die "gzip failed: $GzipError\n"; - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "gzip failed: $GzipError\n"; $z->print($string); @@ -573,7 +574,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Gzip qw(gzip $GzipError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; gzip $input => \$buffer @@ -610,7 +611,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::Gzip> is shown below - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "IO::Compress::Gzip failed: $GzipError\n"; It returns an C<IO::Compress::Gzip> object on success and undef on failure. @@ -1263,8 +1264,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm index c41fa18fe5..ef67f7e66a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @@ -89,22 +89,22 @@ use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE + GZIP_FEXTRA_SUBFIELD_LEN_SIZE; -use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - +use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ; if (ord('A') == 193) { - # EBCDIC + # EBCDIC $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]'; - + } else { $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x1F\x7F-\x9F]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x09\x11-\x1F\x7F-\x9F]'; -} +} use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip @@ -140,7 +140,7 @@ use constant GZIP_OS_DEFAULT=> 0xFF ; GZIP_OS_DEFAULT() => 'Unknown', ) ; -use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", +use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ; diff --git a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm index 603c9e0231..a0005dd6cd 100644 --- a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm @@ -6,15 +6,16 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::Base 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status :Parse); +use IO::Compress::Adapter::Deflate 2.100 ; +use Compress::Raw::Zlib 2.100 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $RawDeflateError = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -28,8 +29,8 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; my %seen; foreach (keys %EXPORT_TAGS ) { - push @{$EXPORT_TAGS{constants}}, - grep { !$seen{$_}++ } + push @{$EXPORT_TAGS{constants}}, + grep { !$seen{$_}++ } @{ $EXPORT_TAGS{$_} } } $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ; @@ -41,7 +42,7 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; #push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); - + sub new @@ -82,7 +83,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - return $obj; + return $obj; } @@ -116,8 +117,6 @@ sub getExtraParams return getZlibParams(); } -use IO::Compress::Base::Common 2.096 qw(:Parse); -use Compress::Raw::Zlib 2.096 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], @@ -125,17 +124,18 @@ our %PARAMS = ( 'crc32' => [IO::Compress::Base::Common::Parse_boolean, 0], 'adler32' => [IO::Compress::Base::Common::Parse_boolean, 0], - 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], ); - + sub getZlibParams { - return %PARAMS; + return %PARAMS; } sub getInverseClass { - return ('IO::Uncompress::RawInflate', + no warnings 'once'; + return ('IO::Uncompress::RawInflate', \$IO::Uncompress::RawInflate::RawInflateError); } @@ -144,7 +144,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } use Fcntl qw(SEEK_SET); @@ -156,20 +156,20 @@ sub createMerge my $outType = shift ; my ($invClass, $error_ref) = $self->getInverseClass(); - eval "require $invClass" + eval "require $invClass" or die "aaaahhhh" ; - my $inf = $invClass->new( $outValue, - Transparent => 0, + 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() + $inf->scan() or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ; - $inf->zap($end_offset) + $inf->zap($end_offset) or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ; my $def = *$self->{Compress} = $inf->createDeflate(); @@ -178,10 +178,10 @@ sub createMerge *$self->{UnCompSize} = *$inf->{UnCompSize}->clone(); *$self->{CompSize} = *$inf->{CompSize}->clone(); # TODO -- fix this - #*$self->{CompSize} = new U64(0, *$self->{UnCompSize_32bit}); + #*$self->{CompSize} = U64->new(0, *$self->{UnCompSize_32bit}); - if ( $outType eq 'buffer') + if ( $outType eq 'buffer') { substr( ${ *$self->{Buffer} }, $end_offset) = '' } elsif ($outType eq 'handle' || $outType eq 'filename') { *$self->{FH} = *$inf->{FH} ; @@ -189,8 +189,8 @@ sub createMerge *$self->{FH}->flush() ; *$self->{Handle} = 1 if $outType eq 'handle'; - #seek(*$self->{FH}, $end_offset, SEEK_SET) - *$self->{FH}->seek($end_offset, SEEK_SET) + #seek(*$self->{FH}, $end_offset, SEEK_SET) + *$self->{FH}->seek($end_offset, SEEK_SET) or return $self->saveErrorString(undef, $!, $!) ; } @@ -199,7 +199,7 @@ sub createMerge #### zlib specific methods -sub deflateParams +sub deflateParams { my $self = shift ; @@ -210,7 +210,7 @@ sub deflateParams return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; - return 1; + return 1; } @@ -231,7 +231,7 @@ IO::Compress::RawDeflate - Write RFC 1951 files/buffers my $status = rawdeflate $input => $output [,OPTS] or die "rawdeflate failed: $RawDeflateError\n"; - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "rawdeflate failed: $RawDeflateError\n"; $z->print($string); @@ -511,7 +511,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; rawdeflate $input => \$buffer @@ -548,7 +548,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C<IO::Compress::RawDeflate> is shown below - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "IO::Compress::RawDeflate failed: $RawDeflateError\n"; It returns an C<IO::Compress::RawDeflate> object on success and undef on failure. @@ -1007,8 +1007,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip.pm b/cpan/IO-Compress/lib/IO/Compress/Zip.pm index 63bd9981ab..16d956129e 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip.pm @@ -4,40 +4,41 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::RawDeflate 2.096 (); -use IO::Compress::Adapter::Deflate 2.096 ; -use IO::Compress::Adapter::Identity 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; -use IO::Compress::Zip::Constants 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::RawDeflate 2.100 (); +use IO::Compress::Adapter::Deflate 2.100 ; +use IO::Compress::Adapter::Identity 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; +use IO::Compress::Zip::Constants 2.100 ; use File::Spec(); use Config; -use Compress::Raw::Zlib 2.096 (); +use Compress::Raw::Zlib 2.100 (); BEGIN { eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.096 ; + IO::Compress::Adapter::Bzip2->import( 2.096 ); require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.096 ; + IO::Compress::Bzip2->import( 2.096 ); } ; eval { require IO::Compress::Adapter::Lzma ; - import IO::Compress::Adapter::Lzma 2.096 ; + IO::Compress::Adapter::Lzma->import( 2.096 ); require IO::Compress::Lzma ; - import IO::Compress::Lzma 2.096 ; + IO::Compress::Lzma->import( 2.096 ); } ; + eval { require IO::Compress::Adapter::Xz ; - import IO::Compress::Adapter::Xz 2.096 ; + IO::Compress::Adapter::Xz->import( 2.096 ); require IO::Compress::Xz ; - import IO::Compress::Xz 2.096 ; + IO::Compress::Xz->import( 2.096 ); } ; eval { require IO::Compress::Adapter::Zstd ; - import IO::Compress::Adapter::Zstd 2.096 ; + IO::Compress::Adapter::Zstd->import( 2.096 ); require IO::Compress::Zstd ; - import IO::Compress::Zstd 2.096 ; + IO::Compress::Zstd->import( 2.096 ); } ; } @@ -46,7 +47,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.096'; +$VERSION = '2.100'; $ZipError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -177,7 +178,7 @@ sub mkComp if (! defined *$self->{ZipData}{SizesOffset}) { *$self->{ZipData}{SizesOffset} = 0; - *$self->{ZipData}{Offset} = new U64 ; + *$self->{ZipData}{Offset} = U64->new(); } *$self->{ZipData}{AnyZip64} = 0 @@ -753,6 +754,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Unzip', \$IO::Uncompress::Unzip::UnzipError); } @@ -905,7 +907,7 @@ IO::Compress::Zip - Write zip files/buffers my $status = zip $input => $output [,OPTS] or die "zip failed: $ZipError\n"; - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "zip failed: $ZipError\n"; $z->print($string); @@ -1251,7 +1253,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Zip qw(zip $ZipError) ; use IO::File ; - my $input = new IO::File "<file1.txt" + my $input = IO::File->new( "<file1.txt" ) or die "Cannot open 'file1.txt': $!\n" ; my $buffer ; zip $input => \$buffer @@ -1292,7 +1294,7 @@ or more succinctly The format of the constructor for C<IO::Compress::Zip> is shown below - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "IO::Compress::Zip failed: $ZipError\n"; It returns an C<IO::Compress::Zip> object on success and undef on failure. @@ -1730,10 +1732,10 @@ By default, no comment field is written to the zip file. =item C<< Method => $method >> Controls which compression method is used. At present the compression -methods are supported are: Store (no compression at all), Deflate, -Bzip2, Xz and Lzma. +methods supported are: Store (no compression at all), Deflate, +Bzip2, Zstd, Xz and Lzma. -The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_XZ and ZIP_CM_LZMA +The symbols ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_ZSTD, ZIP_CM_XZ and ZIP_CM_LZMA are used to select the compression method. These constants are not imported by C<IO::Compress::Zip> by default. @@ -1754,6 +1756,10 @@ Note that to create Xz content, the module C<IO::Compress::Xz> must be installed. A fatal error will be thrown if you attempt to create Xz content when C<IO::Compress::Xz> is not available. +Note that to create Zstd content, the module C<IO::Compress::Zstd> must +be installed. A fatal error will be thrown if you attempt to create Zstd +content when C<IO::Compress::Zstd> is not available. + The default method is ZIP_CM_DEFLATE. =item C<< TextFlag => 0|1 >> @@ -2137,8 +2143,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm index 526e0ba994..c81a4ad56c 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm index a6903a7662..1b953510b3 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @@ -23,7 +23,7 @@ $VERSION = '2.096'; ZLIB_CMF_CM_DEFLATED ZLIB_CMF_CINFO_OFFSET - ZLIB_CMF_CINFO_BITS + ZLIB_CMF_CINFO_BITS ZLIB_CMF_CINFO_MAX ZLIB_FLG_FCHECK_OFFSET diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm index b5c49b7cde..0bbef359f2 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.096'; +$VERSION = '2.100'; -use IO::Compress::Gzip::Constants 2.096 ; +use IO::Compress::Gzip::Constants 2.100 ; sub ExtraFieldError { @@ -36,11 +36,11 @@ sub validateExtraFieldPair return ExtraFieldError("SubField Data is a reference") if ref $pair->[1] ; - # ID is exactly two chars + # ID is exactly two chars return ExtraFieldError("SubField ID not two chars long") unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; - # Check that the 2nd byte of the ID isn't 0 + # Check that the 2nd byte of the ID isn't 0 return ExtraFieldError("SubField ID 2nd byte is 0x00") if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ; @@ -74,7 +74,7 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -84,8 +84,8 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + $subLen > $XLEN ; - my $bad = validateExtraFieldPair( [$id, - substr($data, $offset, $subLen)], + my $bad = validateExtraFieldPair( [$id, + substr($data, $offset, $subLen)], $strict, $gzipMode ); return $bad if $bad ; push @$extraRef, [$id => substr($data, $offset, $subLen)] @@ -94,7 +94,7 @@ sub parseRawExtra $offset += $subLen ; } - + return undef ; } @@ -111,7 +111,7 @@ sub findID return undef if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -126,7 +126,7 @@ sub findID $offset += $subLen ; } - + return undef ; } @@ -165,7 +165,7 @@ sub parseExtraField # $id2 => $data2, # ... # } - + if ( ! ref $dataRef ) { return undef @@ -177,7 +177,7 @@ sub parseExtraField my $data = $dataRef; my $out = '' ; - if (ref $data eq 'ARRAY') { + if (ref $data eq 'ARRAY') { if (ref $data->[0]) { foreach my $pair (@$data) { @@ -188,30 +188,30 @@ sub parseExtraField return $bad if $bad ; $out .= mkSubField(@$pair); - } - } + } + } else { return ExtraFieldError("Not even number of elements") unless @$data % 2 == 0; for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { my $bad = validateExtraFieldPair([$data->[$ix], - $data->[$ix+1]], + $data->[$ix+1]], $strict, $gzipMode) ; return $bad if $bad ; $out .= mkSubField($data->[$ix], $data->[$ix+1]); - } + } } - } - elsif (ref $data eq 'HASH') { + } + elsif (ref $data eq 'HASH') { while (my ($id, $info) = each %$data) { my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode); return $bad if $bad ; $out .= mkSubField($id, $info); - } - } + } + } else { return ExtraFieldError("Not a scalar, array ref or hash ref") ; } diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm index 60b34bab82..92f3945c4d 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,19 +4,19 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); -use Compress::Raw::Bzip2 2.096 ; +use Compress::Raw::Bzip2 2.100 ; our ($VERSION, @ISA); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkUncompObject { my $small = shift || 0; my $verbosity = shift || 0; - my ($inflate, $status) = new Compress::Raw::Bunzip2(1, 1, $small, $verbosity, 1); + my ($inflate, $status) = Compress::Raw::Bunzip2->new(1, 1, $small, $verbosity, 1); return (undef, "Could not create Inflation object: $status", $status) if $status != BZ_OK ; @@ -26,8 +26,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -48,7 +48,7 @@ sub uncompr return STATUS_ERROR; } - + return STATUS_OK if $status == BZ_OK ; return STATUS_ENDSTREAM if $status == BZ_STREAM_END ; return STATUS_ERROR ; @@ -59,12 +59,12 @@ sub reset { my $self = shift ; - my ($inf, $status) = new Compress::Raw::Bunzip2(); + my ($inf, $status) = Compress::Raw::Bunzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Inflate object: $status"; + $self->{Error} = "Cannot create Inflate object: $status"; return STATUS_ERROR; } @@ -100,8 +100,8 @@ sub adler32 sub sync { my $self = shift ; - #( $self->{Inf}->inflateSync(@_) == BZ_OK) - # ? STATUS_OK + #( $self->{Inf}->inflateSync(@_) == BZ_OK) + # ? STATUS_OK # : STATUS_ERROR ; } @@ -109,4 +109,3 @@ sub sync 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm index 84d74c9cab..07621b4f69 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,14 +4,14 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; -use Compress::Raw::Zlib 2.096 (); +use Compress::Raw::Zlib 2.100 (); sub mkUncompObject { @@ -21,7 +21,7 @@ sub mkUncompObject my $crc32 = 1; #shift ; my $adler32 = shift; - bless { 'CompSize' => new U64 , # 0, + bless { 'CompSize' => U64->new(), # 0, 'UnCompSize' => 0, 'wantCRC32' => $crc32, 'CRC32' => Compress::Raw::Zlib::crc32(''), @@ -70,7 +70,7 @@ sub uncompr $ind = $len - 1 ; } } - + if ($ind >= 0) { $remainder = substr($$in, $ind) ; substr($$in, $ind) = '' ; @@ -94,7 +94,7 @@ sub uncompr $l1 = U64::newUnpack_V32(substr($remainder, 8)); $l2 = U64::newUnpack_V32(substr($remainder, 12)); } - + my $newLen = $self->{CompSize}->clone(); $newLen->add(length $$in); if ($l1->equal($l2) && $l1->equal($newLen) ) { @@ -142,7 +142,7 @@ sub reset $self->{CompSize}->reset(); $self->{UnCompSize} = 0; $self->{CRC32} = Compress::Raw::Zlib::crc32(''); - $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); + $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); return STATUS_OK ; } diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm index 63e8707737..9d5dba9481 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); -use Compress::Raw::Zlib 2.096 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common 2.100 qw(:Status); +use Compress::Raw::Zlib 2.100 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; @@ -23,23 +23,23 @@ sub mkUncompObject if ($scan) { - ($inflate, $status) = new Compress::Raw::Zlib::InflateScan + ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new( #LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } else { - ($inflate, $status) = new Compress::Raw::Zlib::Inflate + ($inflate, $status) = Compress::Raw::Zlib::Inflate->new( AppendOutput => 1, LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } - return (undef, "Could not create Inflation object: $status", $status) + return (undef, "Could not create Inflation object: $status", $status) if $status != Z_OK ; return bless {'Inf' => $inflate, @@ -47,8 +47,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -67,7 +67,7 @@ sub uncompr $self->{Error} = "Inflation Error: $status"; return STATUS_ERROR; } - + return STATUS_OK if $status == Z_BUF_ERROR ; # ??? return STATUS_OK if $status == Z_OK ; return STATUS_ENDSTREAM if $status == Z_STREAM_END ; @@ -115,8 +115,8 @@ sub adler32 sub sync { my $self = shift ; - ( $self->{Inf}->inflateSync(@_) == Z_OK) - ? STATUS_OK + ( $self->{Inf}->inflateSync(@_) == Z_OK) + ? STATUS_OK : STATUS_ERROR ; } @@ -154,4 +154,3 @@ sub createDeflateStream __END__ - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm index 63ada56ee1..7e2066d4e8 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm @@ -6,27 +6,27 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 (); +use IO::Compress::Base::Common 2.100 qw(:Parse); -use IO::Uncompress::Adapter::Inflate 2.096 (); +use IO::Uncompress::Adapter::Inflate 2.100 (); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Gunzip 2.096 ; -use IO::Uncompress::Inflate 2.096 ; -use IO::Uncompress::RawInflate 2.096 ; -use IO::Uncompress::Unzip 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Gunzip 2.100 ; +use IO::Uncompress::Inflate 2.100 ; +use IO::Uncompress::RawInflate 2.100 ; +use IO::Uncompress::Unzip 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $AnyInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyInflateError anyinflate ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -48,7 +48,6 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.096 qw(:Parse); return ( 'rawinflate' => [Parse_boolean, 0] ) ; } @@ -75,9 +74,9 @@ sub mkUncomp if ! defined $obj; *$self->{Uncomp} = $obj; - + my @possible = qw( Inflate Gunzip Unzip ); - unshift @possible, 'RawInflate' + unshift @possible, 'RawInflate' if 1 || $got->getValue('rawinflate'); my $magic = $self->ckMagic( @possible ); @@ -113,7 +112,7 @@ sub ckMagic $self->pushBack(*$self->{HeaderPending}) ; *$self->{HeaderPending} = '' ; - } + } bless $self => $keep; return undef; @@ -135,7 +134,7 @@ IO::Uncompress::AnyInflate - Uncompress zlib-based (zip, gzip) file/buffer my $status = anyinflate $input => $output [,OPTS] or die "anyinflate failed: $AnyInflateError\n"; - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "anyinflate failed: $AnyInflateError\n"; $status = $z->read($buffer) @@ -444,7 +443,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.Compressed" + my $input = IO::File->new( "<file1.txt.Compressed" ) or die "Cannot open 'file1.txt.Compressed': $!\n" ; my $buffer ; anyinflate $input => \$buffer @@ -479,7 +478,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyInflate is shown below - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n"; Returns an C<IO::Uncompress::AnyInflate> object on success and undef on failure. @@ -999,8 +998,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm index ae8acdf2d8..b17a3edbda 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm @@ -4,21 +4,21 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 (); +use IO::Compress::Base::Common 2.100 (); -use IO::Uncompress::Base 2.096 ; +use IO::Uncompress::Base 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.096'; +$VERSION = '2.100'; $AnyUncompressError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -33,26 +33,26 @@ BEGIN # Don't trigger any __DIE__ Hooks. local $SIG{__DIE__}; - eval ' use IO::Uncompress::Adapter::Inflate 2.096 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.096 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.096 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnZstd 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnLzip 2.096 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.096 ;'; - eval ' use IO::Uncompress::UnLzop 2.096 ;'; - eval ' use IO::Uncompress::Gunzip 2.096 ;'; - eval ' use IO::Uncompress::Inflate 2.096 ;'; - eval ' use IO::Uncompress::RawInflate 2.096 ;'; - eval ' use IO::Uncompress::Unzip 2.096 ;'; - eval ' use IO::Uncompress::UnLzf 2.096 ;'; - eval ' use IO::Uncompress::UnLzma 2.096 ;'; - eval ' use IO::Uncompress::UnXz 2.096 ;'; - eval ' use IO::Uncompress::UnZstd 2.096 ;'; - eval ' use IO::Uncompress::UnLzip 2.096 ;'; + eval ' use IO::Uncompress::Adapter::Inflate 2.100 ;'; + eval ' use IO::Uncompress::Adapter::Bunzip2 2.100 ;'; + eval ' use IO::Uncompress::Adapter::LZO 2.100 ;'; + eval ' use IO::Uncompress::Adapter::Lzf 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnLzma 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnXz 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnZstd 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnLzip 2.100 ;'; + + eval ' use IO::Uncompress::Bunzip2 2.100 ;'; + eval ' use IO::Uncompress::UnLzop 2.100 ;'; + eval ' use IO::Uncompress::Gunzip 2.100 ;'; + eval ' use IO::Uncompress::Inflate 2.100 ;'; + eval ' use IO::Uncompress::RawInflate 2.100 ;'; + eval ' use IO::Uncompress::Unzip 2.100 ;'; + eval ' use IO::Uncompress::UnLzf 2.100 ;'; + eval ' use IO::Uncompress::UnLzma 2.100 ;'; + eval ' use IO::Uncompress::UnXz 2.100 ;'; + eval ' use IO::Uncompress::UnZstd 2.100 ;'; + eval ' use IO::Uncompress::UnLzip 2.100 ;'; } @@ -279,7 +279,7 @@ IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, zstd, xz, lzma, lzi my $status = anyuncompress $input => $output [,OPTS] or die "anyuncompress failed: $AnyUncompressError\n"; - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "anyuncompress failed: $AnyUncompressError\n"; $status = $z->read($buffer) @@ -600,7 +600,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ; use IO::File ; - my $input = new IO::File "<file1.txt.Compressed" + my $input = IO::File->new( "<file1.txt.Compressed" ) or die "Cannot open 'file1.txt.Compressed': $!\n" ; my $buffer ; anyuncompress $input => \$buffer @@ -635,7 +635,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyUncompress is shown below - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "IO::Uncompress::AnyUncompress failed: $AnyUncompressError\n"; Returns an C<IO::Uncompress::AnyUncompress> object on success and undef on failure. @@ -1077,8 +1077,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm index 91a50e7263..5627bc6a44 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm @@ -9,12 +9,12 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(IO::File Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.096 ; +use IO::Compress::Base::Common 2.100 ; use IO::File ; use Symbol; @@ -58,7 +58,7 @@ sub smartRead if (defined *$self->{FH}) { if ($offset) { - # Not using this + # Not using this # # *$self->{FH}->read($$out, $get_size, $offset); # @@ -75,7 +75,7 @@ sub smartRead elsif (defined *$self->{InputEvent}) { my $got = 1 ; while (length $$out < $size) { - last + last if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0; } @@ -93,13 +93,13 @@ sub smartRead substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size); if (*$self->{ConsumeInput}) { substr($$buf, 0, $get_size) = '' } - else + else { *$self->{BufferOffset} += length($$out) - $offset } } - *$self->{InputLengthRemaining} -= length($$out) #- $offset + *$self->{InputLengthRemaining} -= length($$out) #- $offset if defined *$self->{InputLength}; - + if (! defined $status) { $self->saveStatus($!) ; return STATUS_ERROR; @@ -169,7 +169,7 @@ sub smartTell if (defined *$self->{FH}) { return *$self->{FH}->tell() } - else + else { return *$self->{BufferOffset} } } @@ -179,7 +179,7 @@ sub smartWrite my $out_data = shift ; if (defined *$self->{FH}) { - # flush needed for 5.8.0 + # flush needed for 5.8.0 defined *$self->{FH}->write($out_data, length $out_data) && defined *$self->{FH}->flush() ; } @@ -199,7 +199,7 @@ sub smartReadExact sub smartEof { my ($self) = $_[0]; - local $.; + local $.; return 0 if length *$self->{Prime} || *$self->{PushMode}; @@ -207,15 +207,15 @@ sub smartEof { # Could use # - # *$self->{FH}->eof() + # *$self->{FH}->eof() # # here, but this can cause trouble if # the filehandle is itself a tied handle, but it uses sysread. - # Then we get into mixing buffered & non-buffered IO, + # Then we get into mixing buffered & non-buffered IO, # which will cause trouble my $info = $self->getErrInfo(); - + my $buffer = ''; my $status = $self->smartRead(\$buffer, 1); $self->pushBack($buffer) if length $buffer; @@ -225,7 +225,7 @@ sub smartEof } elsif (defined *$self->{InputEvent}) { *$self->{EventEof} } - else + else { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) } } @@ -347,7 +347,7 @@ sub checkParams my $class = shift ; my $got = shift || IO::Compress::Base::Parameters::new(); - + my $Valid = { 'blocksize' => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024], 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -362,7 +362,7 @@ sub checkParams #'decode' => [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, @@ -371,11 +371,11 @@ sub checkParams $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef] if *$self->{OneShot} ; - - $got->parse($Valid, @_ ) + + $got->parse($Valid, @_ ) or $self->croakError("${class}: " . $got->getError()) ; - $self->postCheckParams($got) + $self->postCheckParams($got) or $self->croakError("${class}: " . $self->error()) ; return $got; @@ -403,7 +403,7 @@ sub _create my $inType = whatIsInput($inValue, 1); - $obj->ckInputParam($class, $inValue, 1) + $obj->ckInputParam($class, $inValue, 1) or return undef ; *$obj->{InNew} = 1; @@ -412,8 +412,8 @@ sub _create or $obj->croakError("${class}: " . *$obj->{Error}); if ($inType eq 'buffer' || $inType eq 'code') { - *$obj->{Buffer} = $inValue ; - *$obj->{InputEvent} = $inValue + *$obj->{Buffer} = $inValue ; + *$obj->{InputEvent} = $inValue if $inType eq 'code' ; } else { @@ -422,18 +422,18 @@ sub _create *$obj->{Handle} = 1 ; # Need to rewind for Scan - *$obj->{FH}->seek(0, SEEK_SET) + *$obj->{FH}->seek(0, SEEK_SET) if $got->getValue('scan'); - } - else { + } + else { no warnings ; my $mode = '<'; $mode = '+<' if $got->getValue('scan'); *$obj->{StdIO} = ($inValue eq '-'); - *$obj->{FH} = new IO::File "$mode $inValue" + *$obj->{FH} = IO::File->new( "$mode $inValue" ) or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ; } - + *$obj->{LineNo} = $. = 0; setBinModeInput(*$obj->{FH}) ; @@ -441,7 +441,7 @@ sub _create *$obj->{Buffer} = \$buff ; } -# if ($got->getValue('decode')) { +# if ($got->getValue('decode')) { # my $want_encoding = $got->getValue('decode'); # *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding); # } @@ -449,7 +449,7 @@ sub _create # *$obj->{Encoding} = undef; # } - *$obj->{InputLength} = $got->parsed('inputlength') + *$obj->{InputLength} = $got->parsed('inputlength') ? $got->getValue('inputlength') : undef ; *$obj->{InputLengthRemaining} = $got->getValue('inputlength'); @@ -465,7 +465,7 @@ sub _create # TODO - move these two into RawDeflate *$obj->{Scan} = $got->getValue('scan'); - *$obj->{ParseExtra} = $got->getValue('parseextra') + *$obj->{ParseExtra} = $got->getValue('parseextra') || $got->getValue('strict') ; *$obj->{Type} = ''; *$obj->{Prime} = $got->getValue('prime') || '' ; @@ -473,8 +473,8 @@ sub _create *$obj->{Plain} = 0; *$obj->{PlainBytesRead} = 0; *$obj->{InflatedBytesRead} = 0; - *$obj->{UnCompSize} = new U64; - *$obj->{CompSize} = new U64; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; *$obj->{TotalInflatedBytesRead} = 0; *$obj->{NewStream} = 0 ; *$obj->{EventEof} = 0 ; @@ -494,19 +494,19 @@ sub _create *$obj->{InNew} = 0; *$obj->{Closed} = 0; - - return $obj + + return $obj if *$obj->{Pause} ; 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() ]; } @@ -515,7 +515,7 @@ sub _create if length $out_buffer; } else { - return undef + return undef unless *$obj->{Transparent}; $obj->clearError(); @@ -549,7 +549,7 @@ sub ckInputParam # # if ($_[0] ne '-' && ! -e $_[0] ) # { -# return $self->saveErrorString(1, +# return $self->saveErrorString(1, # "input file '$_[0]' does not exist", STATUS_ERROR); # } # } @@ -573,13 +573,13 @@ sub _inf my $output = shift ; - my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) + my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output) or return undef ; - + push @_, $output if $haveOut && $x->{Hash}; *$obj->{OneShot} = 1 ; - + my $got = $obj->checkParams($name, undef, @_) or return undef ; @@ -589,25 +589,25 @@ sub _inf # warn "TD $value "; # #$value = $$value; ## warn "TD $value $$value "; -# +# # return retErr($obj, "Parameter 'TrailingData' not writable") -# if readonly $$value ; +# if readonly $$value ; # -# if (ref $$value) +# if (ref $$value) # { # return retErr($obj,"Parameter 'TrailingData' not a scalar reference") # if ref $$value ne 'SCALAR' ; -# +# # *$obj->{TrailingData} = $$value ; # } -# else +# else # { # return retErr($obj,"Parameter 'TrailingData' not a scalar") -# if ref $value ne 'SCALAR' ; +# if ref $value ne 'SCALAR' ; # # *$obj->{TrailingData} = $value ; # } - + *$obj->{TrailingData} = $got->getValue('trailingdata'); } @@ -620,7 +620,7 @@ sub _inf # { # while (my($k, $v) = each %$input) # { -# $v = \$input->{$k} +# $v = \$input->{$k} # unless defined $v ; # # $obj->_singleTarget($x, $k, $v, @_) @@ -629,7 +629,7 @@ sub _inf # # return keys %$input ; # } - + if ($x->{GlobMap}) { $x->{oneInput} = 1 ; @@ -645,11 +645,11 @@ sub _inf if (! $x->{oneOutput} ) { - my $inFile = ($x->{inType} eq 'filenames' + my $inFile = ($x->{inType} eq 'filenames' || $x->{inType} eq 'filename'); $x->{inType} = $inFile ? 'filename' : 'buffer'; - + foreach my $in ($x->{oneInput} ? $input : @$input) { my $out ; @@ -684,7 +684,7 @@ sub _singleTarget my $x = shift ; my $input = shift; my $output = shift; - + my $buff = ''; $x->{buff} = \$buff ; @@ -693,7 +693,7 @@ sub _singleTarget my $mode = '>' ; $mode = '>>' if $x->{Got}->getValue('append') ; - $x->{fh} = new IO::File "$mode $output" + $x->{fh} = IO::File->new( "$mode $output" ) or return retErr($x, "cannot open file '$output': $!") ; binmode $x->{fh} ; @@ -708,10 +708,10 @@ sub _singleTarget } } - + elsif ($x->{outType} eq 'buffer' ) { - $$output = '' + $$output = '' unless $x->{Got}->getValue('append'); $x->{buff} = $output ; } @@ -719,22 +719,22 @@ sub _singleTarget if ($x->{oneInput}) { defined $self->_rd2($x, $input, $output) - or return undef; + or return undef; } else { for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) { - defined $self->_rd2($x, $element, $output) + defined $self->_rd2($x, $element, $output) or return undef ; } } - if ( ($x->{outType} eq 'filename' && $output ne '-') || + if ( ($x->{outType} eq 'filename' && $output ne '-') || ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) { - $x->{fh}->close() - or return retErr($x, $!); + $x->{fh}->close() + or return retErr($x, $!); delete $x->{fh}; } @@ -747,15 +747,15 @@ sub _rd2 my $x = shift ; my $input = shift; my $output = shift; - + my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error}); - + $z->_create($x->{Got}, 1, $input, @_) or return undef ; my $status ; my $fh = $x->{fh}; - + while (1) { while (($status = $z->read($x->{buff})) > 0) { @@ -770,9 +770,9 @@ sub _rd2 if (! $x->{oneOutput} ) { my $ot = $x->{outType} ; - if ($ot eq 'array') + if ($ot eq 'array') { push @$output, $x->{buff} } - elsif ($ot eq 'hash') + elsif ($ot eq 'hash') { $output->{$input} = $x->{buff} } my $buff = ''; @@ -781,12 +781,12 @@ sub _rd2 last if $status < 0 || $z->smartEof(); - last + last unless *$self->{MultiStream}; $status = $z->nextStream(); - last + last unless $status == 1 ; } @@ -796,7 +796,7 @@ sub _rd2 ${ *$self->{TrailingData} } = $z->trailingData() if defined *$self->{TrailingData} ; - $z->close() + $z->close() or return undef ; return 1 ; @@ -808,7 +808,7 @@ sub TIEHANDLE die "OOPS\n" ; } - + sub UNTIE { my $self = shift ; @@ -836,7 +836,7 @@ sub readBlock $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} ); *$self->{CompressedInputLengthRemaining} -= $size ; } - + my $status = $self->smartRead($buff, $size) ; return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!) if $status == STATUS_ERROR ; @@ -861,7 +861,7 @@ sub _raw_read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; return G_EOF if *$self->{Closed} ; @@ -873,8 +873,8 @@ sub _raw_read if (*$self->{Plain}) { my $tmp_buff ; my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ; - - return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) + + return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) if $len == STATUS_ERROR ; if ($len == 0 ) { @@ -898,13 +898,13 @@ sub _raw_read $$buffer .= *$self->{Pending} ; my $len = length *$self->{Pending} ; *$self->{Pending} = ''; - return $len; + return $len; } my $temp_buf = ''; my $outSize = 0; my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ; - + return G_ERR if $status == STATUS_ERROR ; @@ -915,18 +915,18 @@ sub _raw_read $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer, defined *$self->{CompressedInputLengthDone} || $self->smartEof(), $outSize); - + # Remember the input buffer if it wasn't consumed completely $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput}; return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo}) - if $self->saveStatus($status) == STATUS_ERROR; + if $self->saveStatus($status) == STATUS_ERROR; $self->postBlockChk($buffer, $before_len) == STATUS_OK or return G_ERR; $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0; - + *$self->{CompSize}->add($beforeC_len - length $temp_buf) ; *$self->{InflatedBytesRead} += $buf_len ; @@ -960,7 +960,7 @@ sub _raw_read or return G_ERR; } else { - return $self->TrailerError("trailer truncated. Expected " . + return $self->TrailerError("trailer truncated. Expected " . "$trailer_size bytes, got $got") if *$self->{Strict}; $self->pushBack($trailer) ; @@ -978,7 +978,7 @@ sub _raw_read } } - + # return the number of uncompressed bytes read return $buf_len ; @@ -1029,7 +1029,7 @@ sub gotoNextStream # TODO - make this more efficient if know the offset for the end of # the stream and seekable - $status = $self->read($buffer) + $status = $self->read($buffer) while $status > 0 ; return $status @@ -1074,7 +1074,7 @@ sub gotoNextStream push @{ *$self->{InfoList} }, *$self->{Info} ; - return 1; + return 1; } sub streamCount @@ -1090,7 +1090,7 @@ sub read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; if (defined *$self->{ReadStatus} ) { @@ -1123,7 +1123,7 @@ sub read my $offset = $_[2] || 0; if (! *$self->{AppendOutput}) { - if (! $offset) { + if (! $offset) { $$buffer = '' ; } @@ -1161,13 +1161,13 @@ sub read } else { my $len = 0; - $len = $self->_raw_read($buffer) + $len = $self->_raw_read($buffer) while ! *$self->{EndStream} && $len == 0 ; return $len ; } } - # Need to jump through more hoops - either length or offset + # Need to jump through more hoops - either length or offset # or both are specified. my $out_buffer = *$self->{Pending} ; *$self->{Pending} = ''; @@ -1176,17 +1176,17 @@ sub read while (! *$self->{EndStream} && length($out_buffer) < $length) { my $buf_len = $self->_raw_read(\$out_buffer); - return $buf_len + return $buf_len if $buf_len < 0 ; } - $length = length $out_buffer + $length = length $out_buffer if length($out_buffer) < $length ; - return 0 + return 0 if $length == 0 ; - $$buffer = '' + $$buffer = '' if ! defined $$buffer; $offset = length $$buffer @@ -1223,7 +1223,7 @@ sub _getline # Paragraph Mode if ( ! length $/ ) { - my $paragraph ; + my $paragraph ; while (($status = $self->read($paragraph)) > 0 ) { if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; @@ -1236,13 +1236,13 @@ sub _getline # $/ isn't empty, or a reference, so it's Line Mode. { - my $line ; + my $line ; my $p = \*$self->{Pending} ; 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 $/) = ''; + substr($line, 0, $offset + length $/) = ''; $$p = $line; return (1, \$l); } @@ -1262,7 +1262,7 @@ sub getline return undef; } - return undef + return undef if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ; my $current_append = *$self->{AppendOutput} ; @@ -1271,7 +1271,7 @@ sub getline my ($status, $lineref) = $self->_getline(); *$self->{AppendOutput} = $current_append; - return undef + return undef if $status < 0 || length $$lineref == 0 ; $. = ++ *$self->{LineNo} ; @@ -1282,10 +1282,10 @@ sub getline sub getlines { my $self = shift; - $self->croakError(*$self->{ClassName} . + $self->croakError(*$self->{ClassName} . "::getlines: called in scalar context\n") unless wantarray; my($line, @lines); - push(@lines, $line) + push(@lines, $line) while defined($line = $self->getline); return @lines; } @@ -1307,8 +1307,8 @@ sub getc sub ungetc { my $self = shift; - *$self->{Pending} = "" unless defined *$self->{Pending} ; - *$self->{Pending} = $_[0] . *$self->{Pending} ; + *$self->{Pending} = "" unless defined *$self->{Pending} ; + *$self->{Pending} = $_[0] . *$self->{Pending} ; } @@ -1332,7 +1332,7 @@ sub eof my $self = shift ; return (*$self->{Closed} || - (!length *$self->{Pending} + (!length *$self->{Pending} && ( $self->smartEof() || *$self->{EndStream}))) ; } @@ -1362,14 +1362,14 @@ sub close return 1 if *$self->{Closed} ; - untie *$self + untie *$self if $] >= 5.008 ; my $status = 1 ; if (defined *$self->{FH}) { if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { - local $.; + local $.; $! = 0 ; $status = *$self->{FH}->close(); return $self->saveErrorString(0, $!, $!) @@ -1449,8 +1449,8 @@ sub seek sub fileno { my $self = shift ; - return defined *$self->{FH} - ? fileno *$self->{FH} + return defined *$self->{FH} + ? fileno *$self->{FH} : undef ; } @@ -1458,8 +1458,8 @@ sub binmode { 1; # my $self = shift ; -# return defined *$self->{FH} -# ? binmode *$self->{FH} +# return defined *$self->{FH} +# ? binmode *$self->{FH} # : 1 ; } @@ -1472,8 +1472,8 @@ sub opened sub autoflush { my $self = shift ; - return defined *$self->{FH} - ? *$self->{FH}->autoflush(@_) + return defined *$self->{FH} + ? *$self->{FH}->autoflush(@_) : undef ; } @@ -1485,33 +1485,35 @@ sub input_line_number return $last; } - -*BINMODE = \&binmode; -*SEEK = \&seek; -*READ = \&read; -*sysread = \&read; -*TELL = \&tell; -*EOF = \&eof; - -*FILENO = \&fileno; -*CLOSE = \&close; - sub _notAvailable { my $name = shift ; return sub { croak "$name Not Available: File opened only for intput" ; } ; } - -*print = _notAvailable('print'); -*PRINT = _notAvailable('print'); -*printf = _notAvailable('printf'); -*PRINTF = _notAvailable('printf'); -*write = _notAvailable('write'); -*WRITE = _notAvailable('write'); - -#*sysread = \&read; -#*syswrite = \&_notAvailable; +{ + no warnings 'once'; + + *BINMODE = \&binmode; + *SEEK = \&seek; + *READ = \&read; + *sysread = \&read; + *TELL = \&tell; + *EOF = \&eof; + + *FILENO = \&fileno; + *CLOSE = \&close; + + *print = _notAvailable('print'); + *PRINT = _notAvailable('print'); + *printf = _notAvailable('printf'); + *PRINTF = _notAvailable('printf'); + *write = _notAvailable('write'); + *WRITE = _notAvailable('write'); + + #*sysread = \&read; + #*syswrite = \&_notAvailable; +} @@ -1560,8 +1562,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm index 65932c19c4..1bc8ac2b0e 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); +use IO::Compress::Base::Common 2.100 qw(:Status ); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Adapter::Bunzip2 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Adapter::Bunzip2 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error); -$VERSION = '2.096'; +$VERSION = '2.100'; $Bunzip2Error = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -72,7 +72,7 @@ sub mkUncomp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + *$self->{Uncomp} = $obj; return 1; @@ -88,15 +88,15 @@ sub ckMagic $self->smartReadExact(\$magic, 4); *$self->{HeaderPending} = $magic ; - - return $self->HeaderError("Header size is " . - 4 . " bytes") + + return $self->HeaderError("Header size is " . + 4 . " bytes") if length $magic != 4; return $self->HeaderError("Bad Magic.") if ! isBzip2Magic($magic) ; - - + + *$self->{Type} = 'bzip2'; return $magic; } @@ -117,7 +117,7 @@ sub readHeader 'TrailerLength' => 0, 'Header' => '$magic' }; - + } sub chkTrailer @@ -149,7 +149,7 @@ IO::Uncompress::Bunzip2 - Read bzip2 files/buffers my $status = bunzip2 $input => $output [,OPTS] or die "bunzip2 failed: $Bunzip2Error\n"; - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "bunzip2 failed: $Bunzip2Error\n"; $status = $z->read($buffer) @@ -440,7 +440,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ; use IO::File ; - my $input = new IO::File "<file1.txt.bz2" + my $input = IO::File->new( "<file1.txt.bz2" ) or die "Cannot open 'file1.txt.bz2': $!\n" ; my $buffer ; bunzip2 $input => \$buffer @@ -475,7 +475,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Bunzip2 is shown below - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "IO::Uncompress::Bunzip2 failed: $Bunzip2Error\n"; Returns an C<IO::Uncompress::Bunzip2> object on success and undef on failure. @@ -907,8 +907,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm index 2bb383c2b8..2c2529d53b 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm @@ -9,12 +9,12 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; -use Compress::Raw::Zlib 2.096 () ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Gzip::Constants 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; +use Compress::Raw::Zlib 2.100 () ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Gzip::Constants 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; require Exporter ; @@ -28,7 +28,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.096'; +$VERSION = '2.100'; sub new { @@ -70,9 +70,9 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") if ! isGzipMagic($magic) ; @@ -95,10 +95,10 @@ sub chkTrailer my $self = shift; my $trailer = shift; - # Check CRC & ISIZE + # Check CRC & ISIZE my ($CRC32, $ISIZE) = unpack("V V", $trailer) ; - *$self->{Info}{CRC32} = $CRC32; - *$self->{Info}{ISIZE} = $ISIZE; + *$self->{Info}{CRC32} = $CRC32; + *$self->{Info}{ISIZE} = $ISIZE; if (*$self->{Strict}) { return $self->TrailerError("CRC mismatch") @@ -130,9 +130,9 @@ sub _readFullGzipHeader($) *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") @@ -150,7 +150,7 @@ sub _readGzipHeader($) my ($buffer) = '' ; $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE) - or return $self->HeaderError("Minimum header size is " . + or return $self->HeaderError("Minimum header size is " . GZIP_MIN_HEADER_SIZE . " bytes") ; my $keep = $magic . $buffer ; @@ -159,22 +159,22 @@ sub _readGzipHeader($) # now split out the various parts my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ; - $cm == GZIP_CM_DEFLATED + $cm == GZIP_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; # check for use of reserved bits return $self->HeaderError("Use of Reserved Bits in FLG field.") - if $flag & GZIP_FLG_RESERVED ; + if $flag & GZIP_FLG_RESERVED ; my $EXTRA ; my @EXTRA = () ; if ($flag & GZIP_FLG_FEXTRA) { $EXTRA = "" ; - $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) + $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) or return $self->TruncatedHeader("FEXTRA Length") ; my ($XLEN) = unpack("v", $buffer) ; - $self->smartReadExact(\$EXTRA, $XLEN) + $self->smartReadExact(\$EXTRA, $XLEN) or return $self->TruncatedHeader("FEXTRA Body"); $keep .= $buffer . $EXTRA ; @@ -190,10 +190,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FNAME) { $origname = "" ; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FNAME"); last if $buffer eq GZIP_NULL_BYTE ; - $origname .= $buffer + $origname .= $buffer } $keep .= $origname . GZIP_NULL_BYTE ; @@ -205,10 +205,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FCOMMENT) { $comment = ""; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FCOMMENT"); last if $buffer eq GZIP_NULL_BYTE ; - $comment .= $buffer + $comment .= $buffer } $keep .= $comment . GZIP_NULL_BYTE ; @@ -217,7 +217,7 @@ sub _readGzipHeader($) } if ($flag & GZIP_FLG_FHCRC) { - $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) + $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) or return $self->TruncatedHeader("FHCRC"); $HeaderCRC = unpack("v", $buffer) ; @@ -254,7 +254,7 @@ sub _readGzipHeader($) 'Comment' => $comment, 'Time' => $mtime, 'OsID' => $os, - 'OsName' => defined $GZIP_OS_Names{$os} + 'OsName' => defined $GZIP_OS_Names{$os} ? $GZIP_OS_Names{$os} : "Unknown", 'HeaderCRC' => $HeaderCRC, 'Flags' => $flag, @@ -286,7 +286,7 @@ IO::Uncompress::Gunzip - Read RFC 1952 files/buffers my $status = gunzip $input => $output [,OPTS] or die "gunzip failed: $GunzipError\n"; - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "gunzip failed: $GunzipError\n"; $status = $z->read($buffer) @@ -579,7 +579,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; use IO::File ; - my $input = new IO::File "<file1.txt.gz" + my $input = IO::File->new( "<file1.txt.gz" ) or die "Cannot open 'file1.txt.gz': $!\n" ; my $buffer ; gunzip $input => \$buffer @@ -614,7 +614,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Gunzip is shown below - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "IO::Uncompress::Gunzip failed: $GunzipError\n"; Returns an C<IO::Uncompress::Gunzip> object on success and undef on failure. @@ -1122,8 +1122,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm index 3d576f9529..5621959af9 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Zlib::Constants 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Zlib::Constants 2.100 ; -use IO::Uncompress::RawInflate 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $InflateError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -62,14 +62,14 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Header size is " . - ZLIB_HEADER_SIZE . " bytes") + return $self->HeaderError("Header size is " . + ZLIB_HEADER_SIZE . " bytes") if length $magic != ZLIB_HEADER_SIZE; #return $self->HeaderError("CRC mismatch.") return undef if ! $self->isZlibMagic($magic) ; - + *$self->{Type} = 'rfc1950'; return $magic; } @@ -88,7 +88,7 @@ sub chkTrailer my $trailer = shift; my $ADLER32 = unpack("N", $trailer) ; - *$self->{Info}{ADLER32} = $ADLER32; + *$self->{Info}{ADLER32} = $ADLER32; return $self->TrailerError("CRC mismatch") if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ; @@ -102,7 +102,7 @@ sub isZlibMagic my $self = shift; my $buffer = shift ; - return 0 + return 0 if length $buffer < ZLIB_HEADER_SIZE ; my $hdr = unpack("n", $buffer) ; @@ -114,16 +114,16 @@ sub isZlibMagic my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; # Only Deflate supported - return $self->HeaderError("Not Deflate (CM is $cm)") + return $self->HeaderError("Not Deflate (CM is $cm)") if $cm != ZLIB_CMF_CM_DEFLATED ; # Max window value is 7 for Deflate. my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ; - return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . - " (CINFO is $cinfo)") + return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . + " (CINFO is $cinfo)") if $cinfo > ZLIB_CMF_CINFO_MAX ; - return 1; + return 1; } sub bits @@ -145,19 +145,19 @@ sub _readDeflateHeader # # *$self->{HeaderPending} = $buffer ; # -# return $self->HeaderError("Header size is " . -# ZLIB_HEADER_SIZE . " bytes") +# return $self->HeaderError("Header size is " . +# ZLIB_HEADER_SIZE . " bytes") # if length $buffer != ZLIB_HEADER_SIZE; # # return $self->HeaderError("CRC mismatch.") # if ! isZlibMagic($buffer) ; # } - + my ($CMF, $FLG) = unpack "C C", $buffer; my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS ), my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; - $cm == ZLIB_CMF_CM_DEFLATED + $cm == ZLIB_CMF_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; my $DICTID; @@ -208,7 +208,7 @@ IO::Uncompress::Inflate - Read RFC 1950 files/buffers my $status = inflate $input => $output [,OPTS] or die "inflate failed: $InflateError\n"; - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "inflate failed: $InflateError\n"; $status = $z->read($buffer) @@ -501,7 +501,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Inflate qw(inflate $InflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.1950" + my $input = IO::File->new( "<file1.txt.1950" ) or die "Cannot open 'file1.txt.1950': $!\n" ; my $buffer ; inflate $input => \$buffer @@ -536,7 +536,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Inflate is shown below - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "IO::Uncompress::Inflate failed: $InflateError\n"; Returns an C<IO::Uncompress::Inflate> object on success and undef on failure. @@ -994,8 +994,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm index b5a4b8a71e..1a6c1f5860 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); +use Compress::Raw::Zlib 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Adapter::Inflate 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Adapter::Inflate 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $RawInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -25,16 +25,16 @@ push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); #{ -# # Execute at runtime +# # Execute at runtime # my %bad; # for my $module (qw(Compress::Raw::Zlib IO::Compress::Base::Common IO::Uncompress::Base IO::Uncompress::Adapter::Inflate)) # { # my $ver = ${ $module . "::VERSION"} ; -# +# # $bad{$module} = $ver # if $ver ne $VERSION; # } -# +# # if (keys %bad) # { # my $string = join "\n", map { "$_ $bad{$_}" } keys %bad; @@ -148,14 +148,14 @@ sub _isRawx my $buffer = ''; - $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 + $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 or return $self->saveErrorString(undef, "No data to read"); my $temp_buf = $magic . $buffer ; - *$self->{HeaderPending} = $temp_buf ; + *$self->{HeaderPending} = $temp_buf ; $buffer = ''; my $status = *$self->{Uncomp}->uncompr(\$temp_buf, \$buffer, $self->smartEof()) ; - + return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR) if $status == STATUS_ERROR; @@ -163,12 +163,12 @@ sub _isRawx return $self->saveErrorString(undef, "unexpected end of file", STATUS_ERROR) if $self->smartEof() && $status != STATUS_ENDSTREAM; - + #my $buf_len = *$self->{Uncomp}->uncompressedBytes(); my $buf_len = length $buffer; if ($status == STATUS_ENDSTREAM) { - if (*$self->{MultiStream} + if (*$self->{MultiStream} && (length $temp_buf || ! $self->smartEof())){ *$self->{NewStream} = 1 ; *$self->{EndStream} = 0 ; @@ -177,9 +177,9 @@ sub _isRawx *$self->{EndStream} = 1 ; } } - *$self->{HeaderPending} = $buffer ; - *$self->{InflatedBytesRead} = $buf_len ; - *$self->{TotalInflatedBytesRead} += $buf_len ; + *$self->{HeaderPending} = $buffer ; + *$self->{InflatedBytesRead} = $buf_len ; + *$self->{TotalInflatedBytesRead} += $buf_len ; *$self->{Type} = 'rfc1951'; $self->saveStatus(STATUS_OK); @@ -229,7 +229,7 @@ sub inflateSync return $self->saveErrorString(0, "unexpected end of file", STATUS_ERROR); } } - + $status = *$self->{Uncomp}->sync($temp_buf) ; if ($status == STATUS_OK) @@ -251,23 +251,23 @@ sub inflateSync # my $status ; # my $end_offset = 0; # -# $status = $self->scan() +# $status = $self->scan() # #or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $self->errorNo) ; # or return $self->saveErrorString(G_ERR, "Error Scanning: $status") # -# $status = $self->zap($end_offset) +# $status = $self->zap($end_offset) # or return $self->saveErrorString(G_ERR, "Error Zapping: $status"); # #or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $self->errorNo) ; # # #(*$obj->{Deflate}, $status) = $inf->createDeflate(); # ## *$obj->{Header} = *$inf->{Info}{Header}; -## *$obj->{UnCompSize_32bit} = +## *$obj->{UnCompSize_32bit} = ## *$obj->{BytesWritten} = *$inf->{UnCompSize_32bit} ; ## *$obj->{CompSize_32bit} = *$inf->{CompSize_32bit} ; # # -## if ( $outType eq 'buffer') +## if ( $outType eq 'buffer') ## { substr( ${ *$self->{Buffer} }, $end_offset) = '' } ## elsif ($outType eq 'handle' || $outType eq 'filename') { ## *$self->{FH} = *$inf->{FH} ; @@ -275,11 +275,11 @@ sub inflateSync ## *$obj->{FH}->flush() ; ## *$obj->{Handle} = 1 if $outType eq 'handle'; ## -## #seek(*$obj->{FH}, $end_offset, SEEK_SET) -## *$obj->{FH}->seek($end_offset, SEEK_SET) +## #seek(*$obj->{FH}, $end_offset, SEEK_SET) +## *$obj->{FH}->seek($end_offset, SEEK_SET) ## or return $obj->saveErrorString(undef, $!, $!) ; ## } -# +# #} sub scan @@ -292,7 +292,7 @@ sub scan my $buffer = '' ; my $len = 0; - $len = $self->_raw_read(\$buffer, 1) + $len = $self->_raw_read(\$buffer, 1) while ! *$self->{EndStream} && $len >= 0 ; #return $len if $len < 0 ? $len : 0 ; @@ -310,16 +310,16 @@ sub zap #printf "# block_offset $block_offset %x\n", $block_offset; my $byte ; ( $self->smartSeek($block_offset) && - $self->smartRead(\$byte, 1) ) - or return $self->saveErrorString(0, $!, $!); + $self->smartRead(\$byte, 1) ) + or return $self->saveErrorString(0, $!, $!); #printf "#byte is %x\n", unpack('C*',$byte); *$self->{Uncomp}->resetLastBlockByte($byte); #printf "#to byte is %x\n", unpack('C*',$byte); - ( $self->smartSeek($block_offset) && + ( $self->smartSeek($block_offset) && $self->smartWrite($byte) ) - or return $self->saveErrorString(0, $!, $!); + or return $self->saveErrorString(0, $!, $!); #$self->smartSeek($end_offset, 1); @@ -335,12 +335,12 @@ sub createDeflate -CRC32 => *$self->{Params}->getValue('crc32'), -ADLER32 => *$self->{Params}->getValue('adler32'), ); - - return wantarray ? ($status, $def) : $def ; + + return wantarray ? ($status, $def) : $def ; } -1; +1; __END__ @@ -356,7 +356,7 @@ IO::Uncompress::RawInflate - Read RFC 1951 files/buffers my $status = rawinflate $input => $output [,OPTS] or die "rawinflate failed: $RawInflateError\n"; - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "rawinflate failed: $RawInflateError\n"; $status = $z->read($buffer) @@ -646,7 +646,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ; use IO::File ; - my $input = new IO::File "<file1.txt.1951" + my $input = IO::File->new( "<file1.txt.1951" ) or die "Cannot open 'file1.txt.1951': $!\n" ; my $buffer ; rawinflate $input => \$buffer @@ -681,7 +681,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::RawInflate is shown below - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "IO::Uncompress::RawInflate failed: $RawInflateError\n"; Returns an C<IO::Uncompress::RawInflate> object on success and undef on failure. @@ -1122,8 +1122,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm index 24cd66e51e..55eb89e010 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm @@ -9,14 +9,14 @@ use warnings; use bytes; use IO::File; -use IO::Uncompress::RawInflate 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Uncompress::Adapter::Inflate 2.096 ; -use IO::Uncompress::Adapter::Identity 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; -use IO::Compress::Zip::Constants 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Uncompress::Adapter::Inflate 2.100 ; +use IO::Uncompress::Adapter::Identity 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; +use IO::Compress::Zip::Constants 2.100 ; -use Compress::Raw::Zlib 2.096 () ; +use Compress::Raw::Zlib 2.100 () ; BEGIN { @@ -24,13 +24,13 @@ BEGIN local $SIG{__DIE__}; eval{ require IO::Uncompress::Adapter::Bunzip2 ; - import IO::Uncompress::Adapter::Bunzip2 } ; + IO::Uncompress::Adapter::Bunzip2->import() } ; eval{ require IO::Uncompress::Adapter::UnLzma ; - import IO::Uncompress::Adapter::UnLzma } ; + IO::Uncompress::Adapter::UnLzma->import() } ; eval{ require IO::Uncompress::Adapter::UnXz ; - import IO::Uncompress::Adapter::UnXz } ; + IO::Uncompress::Adapter::UnXz->import() } ; eval{ require IO::Uncompress::Adapter::UnZstd ; - import IO::Uncompress::Adapter::UnZstd } ; + IO::Uncompress::Adapter::UnZstd->import() } ; } @@ -38,7 +38,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.096'; +$VERSION = '2.100'; $UnzipError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -932,7 +932,7 @@ sub scanCentralDirectory $self->skip($filename_length ) ; - my $v64 = new U64 $compressedLength ; + my $v64 = U64->new( $compressedLength ); if (U64::full32 $compressedLength ) { $self->smartReadExact(\$buffer, $extra_length) ; @@ -1093,7 +1093,7 @@ IO::Uncompress::Unzip - Read zip files/buffers my $status = unzip $input => $output [,OPTS] or die "unzip failed: $UnzipError\n"; - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "unzip failed: $UnzipError\n"; $status = $z->read($buffer) @@ -1445,7 +1445,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Unzip qw(unzip $UnzipError) ; use IO::File ; - my $input = new IO::File "<file1.zip" + my $input = IO::File->new( "<file1.zip" ) or die "Cannot open 'file1.zip': $!\n" ; my $buffer ; unzip $input => \$buffer @@ -1457,7 +1457,7 @@ uncompressed data to a buffer, C<$buffer>. The format of the constructor for IO::Uncompress::Unzip is shown below - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "IO::Uncompress::Unzip failed: $UnzipError\n"; Returns an C<IO::Uncompress::Unzip> object on success and undef on failure. @@ -1890,7 +1890,7 @@ stream at a time. use IO::Uncompress::Unzip qw($UnzipError); my $zipfile = "somefile.zip"; - my $u = new IO::Uncompress::Unzip $zipfile + my $u = IO::Uncompress::Unzip->new( $zipfile ) or die "Cannot open $zipfile: $UnzipError"; my $status; @@ -1965,8 +1965,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/private/MakeUtil.pm b/cpan/IO-Compress/private/MakeUtil.pm index 12fa26fd05..aa540c68fd 100644 --- a/cpan/IO-Compress/private/MakeUtil.pm +++ b/cpan/IO-Compress/private/MakeUtil.pm @@ -42,14 +42,14 @@ sub MY::libscan return $path; } -sub MY::postamble +sub MY::postamble { return '' if $ENV{PERL_CORE} ; my @files = getPerlFiles('MANIFEST'); - # Note: Once you remove all the layers of shell/makefile escaping + # Note: Once you remove all the layers of shell/makefile escaping # the regular expression below reads # # /^\s*local\s*\(\s*\$^W\s*\)/ @@ -215,7 +215,7 @@ sub UpDowngrade foreach (@files) { #if (-l $_ ) { doUpDown($our_sub, $warn_sub, $_) } - #else + #else #{ doUpDownViaCopy($our_sub, $warn_sub, $_) } } @@ -234,7 +234,7 @@ sub doUpDown local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; local (@ARGV) = shift; - + while (<>) { print, last if /^__(END|DATA)__/ ; @@ -277,7 +277,7 @@ sub doUpDownViaCopy push @keep, $_; last ; } - + &{ $our_sub }() if $our_sub ; &{ $warn_sub }() if $warn_sub ; push @keep, $_; @@ -334,7 +334,7 @@ sub FindBrokenDependencies Compress::Zlib ); - + my @broken = (); foreach my $module ( grep { ! $thisModule{$_} } @modules) @@ -342,12 +342,12 @@ sub FindBrokenDependencies my $hasVersion = getInstalledVersion($module); # No need to upgrade if the module isn't installed at all - next + next if ! defined $hasVersion; # If already have C::Z version 1, then an upgrade to any of the # IO::Compress modules will not break it. - next + next if $module eq 'Compress::Zlib' && $hasVersion < 2; if ($hasVersion < $version) @@ -370,14 +370,12 @@ sub getInstalledVersion { no strict 'refs'; $version = ${ $module . "::VERSION" }; - $version = 0 + $version = 0 } - + return $version; } package MakeUtil ; 1; - - diff --git a/cpan/IO-Compress/t/000prereq.t b/cpan/IO-Compress/t/000prereq.t index 205e032573..f657083ad4 100644 --- a/cpan/IO-Compress/t/000prereq.t +++ b/cpan/IO-Compress/t/000prereq.t @@ -25,7 +25,7 @@ BEGIN if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - my $VERSION = '2.096'; + my $VERSION = '2.100'; my @NAMES = qw( Compress::Raw::Bzip2 Compress::Raw::Zlib @@ -60,7 +60,7 @@ BEGIN ); - my @OPT = qw( + my @OPT = qw( ); plan tests => 1 + 2 + @NAMES + @OPT + $extra ; @@ -76,21 +76,21 @@ BEGIN eval " require $name " ; if ($@) { - ok 1, "$name not available" + ok 1, "$name not available" } - else + else { my $ver = eval("\$${name}::VERSION"); - is $ver, $VERSION, "$name version should be $VERSION" + is $ver, $VERSION, "$name version should be $VERSION" or diag "$name version is $ver, need $VERSION" ; - } + } } # need zlib 1.2.0 or better - + cmp_ok Compress::Raw::Zlib::ZLIB_VERNUM(), ">=", 0x1200 - or diag "IO::Compress needs zlib 1.2.0 or better, you have " . Compress::Raw::Zlib::zlib_version(); - + or diag "IO::Compress needs zlib 1.2.0 or better, you have " . Compress::Raw::Zlib::zlib_version(); + use_ok('Scalar::Util') ; } @@ -99,4 +99,3 @@ ok gotScalarUtilXS(), "Got XS Version of Scalar::Util" or diag <<EOM; You don't have the XS version of Scalar::Util EOM - diff --git a/cpan/IO-Compress/t/001bzip2.t b/cpan/IO-Compress/t/001bzip2.t index 40b9bcca59..cb4fa990f3 100644 --- a/cpan/IO-Compress/t/001bzip2.t +++ b/cpan/IO-Compress/t/001bzip2.t @@ -14,8 +14,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -40,10 +40,10 @@ sub myBZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -66,7 +66,7 @@ sub myBZreadFile title "BlockSize100K => $stringValue"; my $err = "Parameter 'BlockSize100K' must be an unsigned int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, BlockSize100K => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -80,7 +80,7 @@ sub myBZreadFile title "BlockSize100K => $stringValue"; my $err = "Parameter 'BlockSize100K' not between 1 and 9, got $stringValue"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, BlockSize100K => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -94,7 +94,7 @@ sub myBZreadFile title "WorkFactor => $stringValue"; my $err = "Parameter 'WorkFactor' must be an unsigned int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, WorkFactor => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -108,7 +108,7 @@ sub myBZreadFile title "WorkFactor => $stringValue"; my $err = "Parameter 'WorkFactor' not between 0 and 250, got $stringValue"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, WorkFactor => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -130,7 +130,7 @@ sub myBZreadFile title "Small => $stringValue"; my $err = "Parameter 'Small' must be an int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Uncompress::Bunzip2(\$buffer, Small => $value) }; + eval { $bz = IO::Uncompress::Bunzip2->new(\$buffer, Small => $value) }; like $@, mkErr("IO::Uncompress::Bunzip2: $err"), " value $stringValue is bad"; is $Bunzip2Error, "IO::Uncompress::Bunzip2: $err", @@ -151,9 +151,9 @@ EOM for my $value ( 1 .. 9 ) { title "$CompressClass - BlockSize100K => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name, BlockSize100K => $value) + $bz = IO::Compress::Bzip2->new($name, BlockSize100K => $value) or diag $IO::Compress::Bzip2::Bzip2Error ; ok $bz, " bz object ok"; $bz->write($hello); @@ -165,9 +165,9 @@ EOM for my $value ( 0 .. 250 ) { title "$CompressClass - WorkFactor => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name, WorkFactor => $value); + $bz = IO::Compress::Bzip2->new($name, WorkFactor => $value); ok $bz, " bz object ok"; $bz->write($hello); $bz->close($hello); @@ -178,16 +178,16 @@ EOM for my $value ( 0 .. 1 ) { title "$UncompressClass - Small => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name); + $bz = IO::Compress::Bzip2->new($name); ok $bz, " bz object ok"; $bz->write($hello); $bz->close($hello); - my $fil = new $UncompressClass $name, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $name, Append => 1, - Small => $value ; + Small => $value ); my $data = ''; 1 while $fil->read($data) > 0; @@ -200,7 +200,3 @@ EOM 1; - - - - diff --git a/cpan/IO-Compress/t/002any-transparent.t b/cpan/IO-Compress/t/002any-transparent.t index bb26bbcac0..bb323928ec 100644 --- a/cpan/IO-Compress/t/002any-transparent.t +++ b/cpan/IO-Compress/t/002any-transparent.t @@ -6,7 +6,7 @@ BEGIN { } use lib qw(t t/compress); - + use strict; use warnings; use bytes; @@ -38,7 +38,7 @@ EOM { title "AnyInflate with Non-compressed data (File $file)" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -52,12 +52,12 @@ EOM my $unc ; my $keep = $buffer ; - $unc = new IO::Uncompress::AnyInflate $input, -Transparent => 0 ; + $unc = IO::Uncompress::AnyInflate->new( $input, -Transparent => 0 ); ok ! $unc," no AnyInflate object when -Transparent => 0" ; is $buffer, $keep ; $buffer = $keep ; - $unc = new IO::Uncompress::AnyInflate \$buffer, -Transparent => 1 ; + $unc = IO::Uncompress::AnyInflate->new( \$buffer, -Transparent => 1 ); ok $unc, " AnyInflate object when -Transparent => 1" ; my $uncomp ; diff --git a/cpan/IO-Compress/t/004gziphdr.t b/cpan/IO-Compress/t/004gziphdr.t index 27a9013546..0ed4099ebe 100644 --- a/cpan/IO-Compress/t/004gziphdr.t +++ b/cpan/IO-Compress/t/004gziphdr.t @@ -37,7 +37,7 @@ BEGIN { my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code; -my $lex = new LexFile my $name ; +my $lex = LexFile->new( my $name ); { title "Check Defaults"; @@ -63,12 +63,12 @@ my $lex = new LexFile my $name ; title "Check name can be different from filename" ; # Check Name can be different from filename # Comment and Extra can be set - # Can specify a zero Time + # Can specify a zero Time my $comment = "This is a Comment" ; my $extra = "A little something extra" ; my $aname = "a new name" ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -Strict => 0, -Name => $aname, -Comment => $comment, @@ -92,7 +92,7 @@ my $lex = new LexFile my $name ; # Check Time defaults to now # and that can have empty name, comment and extrafield my $before = time ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -TextFlag => 1, -Name => "", -Comment => "", @@ -121,7 +121,7 @@ my $lex = new LexFile my $name ; title "can have null extrafield" ; my $before = time ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -strict => 0, -Name => "a", -Comment => "b", @@ -144,7 +144,7 @@ my $lex = new LexFile my $name ; { title "can have undef name, comment, time and extrafield" ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -Name => undef, -Comment => undef, -ExtraField => undef, @@ -167,9 +167,9 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") my $v = pack "h*", $value; my $comment = "my${v}comment$v"; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, Time => 0, - -TextFlag => 1, + -TextFlag => 1, -Name => "", -Comment => $comment, -ExtraField => ""; @@ -249,14 +249,14 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") for my $code ( -1, undef, '', 'fred' ) { my $code_name = defined $code ? "'$code'" : "'undef'"; - eval { new IO::Compress::Gzip $name, -OS_Code => $code } ; + eval { IO::Compress::Gzip->new( $name, -OS_Code => $code ) } ; like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"), " Trap OS Code $code_name"; } for my $code ( qw( 256 ) ) { - eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) }; + eval { ok ! IO::Compress::Gzip->new($name, OS_Code => $code) }; like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"), " Trap OS Code $code"; like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/", @@ -285,34 +285,34 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [1, ['Xx' => '','AB' => 'Fred'] => [['Xx' => ''],['AB'=>'Fred']] ], [1, ['Xx' => '','Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred']] ], [1, ['Xx' => '', - 'Xx' => 'Fred', + 'Xx' => 'Fred', 'Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred'], ['Xx'=>'Fred']] ], [1, [ ['Xx' => 'a'], ['AB' => 'Fred'] ] => [['Xx' => 'a'],['AB'=>'Fred']] ], - [0, {'AB' => 'Fred', - 'Pq' => 'r', + [0, {'AB' => 'Fred', + 'Pq' => 'r', "\x01\x02" => "\x03"} => [['AB'=>'Fred'], - ['Pq'=>'r'], + ['Pq'=>'r'], ["\x01\x02"=>"\x03"]] ], - [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => + [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ], ); foreach my $test (@tests) { my ($order, $input, $result) = @$test ; - ok my $x = new IO::Compress::Gzip $name, + ok my $x = IO::Compress::Gzip->new( $name, -ExtraField => $input, - -HeaderCRC => 1 + -HeaderCRC => 1 ) or diag "GzipError is $GzipError" ; ; my $string = "abcd" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok $x = new IO::Uncompress::Gunzip $name, + ok $x = IO::Uncompress::Gunzip->new( $name, #-Strict => 1, - -ParseExtra => 1 + -ParseExtra => 1 ) or diag "GunzipError is $GunzipError" ; ; my $hdr = $x->getHeaderInfo(); ok $hdr; @@ -331,7 +331,7 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") eq_array $extra, $result; } else { eq_set $extra, $result; - } + } } } @@ -351,7 +351,7 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"], [ [ ["aa"] ] => "SubField must have two parts"], [ [ ["aa", "b", "c"] ] => "SubField must have two parts"], - [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] + [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] => "SubField Data too long"], [ { 'abc', 1 } => "SubField ID not two chars long"], @@ -359,15 +359,15 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [ { "ab", \1 } => "SubField Data is a reference"], ); - + foreach my $test (@tests) { my ($input, $string) = @$test ; my $buffer ; my $x ; - eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField => $input; }; - like $@, mkErr("$prefix$string"); - like $GzipError, "/$prefix$string/"; + eval { $x = IO::Compress::Gzip->new( \$buffer, -ExtraField => $input ); }; + like $@, mkErr("$prefix$string"); + like $GzipError, "/$prefix$string/"; ok ! $x ; } @@ -378,19 +378,19 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") # Corrupt ExtraField my @tests = ( - ["Sub-field truncated", + ["Sub-field truncated", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ['a', undef, undef] ], - ["Length of field incorrect", + ["Length of field incorrect", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ["ab", 255, "abc"] ], - ["Length of 2nd field incorrect", + ["Length of 2nd field incorrect", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ["ab", 3, "abc"], ["de", 7, "x"] ], - ["Length of 2nd field incorrect", + ["Length of 2nd field incorrect", "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00", "Header Error: SubField ID 2nd byte is 0x00", ["a\x00", 3, "abc"], ["de", 7, "x"] ], @@ -418,31 +418,31 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") my $buffer ; my $x ; - eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField => $input, Strict => 1; }; - like $@, mkErr("$gzip_error"), " $name"; - like $GzipError, "/$gzip_error/", " $name"; + eval {$x = IO::Compress::Gzip->new( \$buffer, -ExtraField => $input, Strict => 1 ); }; + like $@, mkErr("$gzip_error"), " $name"; + like $GzipError, "/$gzip_error/", " $name"; ok ! $x, " IO::Compress::Gzip fails"; - like $GzipError, "/$gzip_error/", " $name"; + like $GzipError, "/$gzip_error/", " $name"; - foreach my $check (0, 1) + foreach my $check (0, 1) { - ok $x = new IO::Compress::Gzip \$buffer, - ExtraField => $input, - Strict => 0 + ok $x = IO::Compress::Gzip->new( \$buffer, + ExtraField => $input, + Strict => 0 ) or diag "GzipError is $GzipError" ; my $string = "abcd" ; $x->write($string) ; $x->close ; is anyUncompress(\$buffer), $string ; - $x = new IO::Uncompress::Gunzip \$buffer, + $x = IO::Uncompress::Gunzip->new( \$buffer, Strict => 0, Transparent => 0, - ParseExtra => $check; + ParseExtra => $check ); if ($check) { ok ! $x ; - like $GunzipError, "/^$gunzip_error/"; + like $GunzipError, "/^$gunzip_error/"; } else { ok $x ; @@ -456,13 +456,13 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") { title 'Check Minimal'; - ok my $x = new IO::Compress::Gzip $name, -Minimal => 1; + ok my $x = IO::Compress::Gzip->new( $name, -Minimal => 1 ); my $string = "abcd" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok $x = new IO::Uncompress::Gunzip $name ; + ok $x = IO::Uncompress::Gunzip->new( $name ); my $hdr = $x->getHeaderInfo(); ok $hdr; ok $hdr->{Time} == 0; @@ -482,11 +482,11 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") 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 my $x = IO::Compress::Gzip->new( $name, -Minimal => 1 ); isa_ok $x, "IO::Compress::Gzip"; ok $x->close, "closed" ; - ok $x = new IO::Uncompress::Gunzip $name, -Append => 0 ; + ok $x = IO::Uncompress::Gunzip->new( $name, -Append => 0 ); isa_ok $x, "IO::Uncompress::Gunzip"; my $data ; my $status = 1; @@ -528,7 +528,7 @@ some text EOM my $good = ''; - ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -537,7 +537,7 @@ EOM my $buffer = $good ; substr($buffer, 0, 1) = 'x' ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); ok $GunzipError =~ /Header Error: Bad Magic/; } @@ -546,7 +546,7 @@ EOM my $buffer = $good ; substr($buffer, 1, 1) = "\xFF" ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); ok $GunzipError =~ /Header Error: Bad Magic/; #print "$GunzipError\n"; } @@ -556,7 +556,7 @@ EOM my $buffer = $good ; substr($buffer, 2, 1) = 'x' ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/'; } @@ -565,7 +565,7 @@ EOM my $buffer = $good ; substr($buffer, 3, 1) = "\xff"; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./'; } @@ -574,7 +574,7 @@ EOM my $buffer = $good ; substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF); - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1 + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0, Strict => 1 ) or print "# $GunzipError\n"; like $GunzipError, '/Header Error: CRC16 mismatch/' #or diag "buffer length " . length($buffer); @@ -587,10 +587,10 @@ EOM my $x ; my $store = "x" x GZIP_FEXTRA_MAX_SIZE ; { - my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ; + my $z = IO::Compress::Gzip->new(\$x, ExtraField => $store, Strict => 0) ; ok $z, "Created IO::Compress::Gzip object" ; } - my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0; + my $gunz = IO::Uncompress::Gunzip->new( \$x, Strict => 0 ); ok $gunz, "Created IO::Uncompress::Gunzip object" ; my $hdr = $gunz->getHeaderInfo(); ok $hdr; @@ -601,7 +601,7 @@ EOM { title "Header Corruption - ExtraField too big"; my $x; - eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;}; + eval { IO::Compress::Gzip->new(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;}; like $@, mkErr('Error with ExtraField Parameter: Too Large'); like $GzipError, '/Error with ExtraField Parameter: Too Large/'; } @@ -610,24 +610,24 @@ EOM title "Header Corruption - Create Name with Illegal Chars"; my $x; - eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "fred\x02" ) }; like $@, mkErr('Non ISO 8859-1 Character found in Name'); like $GzipError, '/Non ISO 8859-1 Character found in Name/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Name => "fred\x02" ; - ok $gz->close(); + -Name => "fred\x02" ); + ok $gz->close(); - ok ! new IO::Uncompress::Gunzip \$x, + ok ! IO::Uncompress::Gunzip->new( \$x, -Transparent => 0, - -Strict => 1; + -Strict => 1 ); - like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/'; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/'; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Name}, "fred\x02"; @@ -636,47 +636,47 @@ EOM { title "Header Corruption - Null Chars in Name"; my $x; - eval { new IO::Compress::Gzip \$x, -Name => "\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "\x00" ) }; like $@, mkErr('Null Character found in Name'); like $GzipError, '/Null Character found in Name/'; - eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "abc\x00" ) }; like $@, mkErr('Null Character found in Name'); like $GzipError, '/Null Character found in Name/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Name => "abc\x00de" ; - ok $gz->close() ; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + -Name => "abc\x00de" ); + ok $gz->close() ; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Name}, "abc"; - + } { title "Header Corruption - Create Comment with Illegal Chars"; my $x; - eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" }; + eval { IO::Compress::Gzip->new( \$x, -Comment => "fred\x02" ) }; like $@, mkErr('Non ISO 8859-1 Character found in Comment'); like $GzipError, '/Non ISO 8859-1 Character found in Comment/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Comment => "fred\x02" ; - ok $gz->close(); + -Comment => "fred\x02" ); + ok $gz->close(); - ok ! new IO::Uncompress::Gunzip \$x, Strict => 1, - -Transparent => 0; + ok ! IO::Uncompress::Gunzip->new( \$x, Strict => 1, + -Transparent => 0 ); like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/'; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Comment}, "fred\x02"; @@ -685,25 +685,25 @@ EOM { title "Header Corruption - Null Char in Comment"; my $x; - eval { new IO::Compress::Gzip \$x, -Comment => "\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Comment => "\x00" ) }; like $@, mkErr('Null Character found in Comment'); like $GzipError, '/Null Character found in Comment/'; - eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ; + eval { IO::Compress::Gzip->new( \$x, -Comment => "abc\x00" ) } ; like $@, mkErr('Null Character found in Comment'); like $GzipError, '/Null Character found in Comment/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Comment => "abc\x00de" ; - ok $gz->close() ; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + -Comment => "abc\x00de" ); + ok $gz->close() ; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Comment}, "abc"; - + } @@ -715,18 +715,18 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0, - -ExtraField => "hello" x 10 ; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1, Strict => 0, + -ExtraField => "hello" x 10 ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - #my $lex = new LexFile my $name ; + #my $lex = LexFile->new( my $name ); #writeFile($name, $truncated) ; - #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like($GunzipError, '/^Header Error: Truncated in FEXTRA/'); @@ -744,14 +744,14 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Name => $Name ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FNAME Section/'; @@ -767,17 +767,17 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Comment => $Comment ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - #my $lex = new LexFile my $name ; + #my $lex = LexFile->new( my $name ); #writeFile($name, $truncated) ; - #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/'; @@ -792,17 +792,16 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $truncated) ; - my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FHCRC Section/'; @@ -820,19 +819,19 @@ EOM my $good ; { - ok my $x = new IO::Compress::Gzip \$good ; + ok my $x = IO::Compress::Gzip->new( \$good ); ok $x->write($string) ; ok $x->close ; } writeFile($name, $good) ; - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => 1; + -Strict => 1 ); my $uncomp ; 1 while $gunz->read($uncomp) > 0 ; ok $gunz->close() ; - ok $uncomp eq $string + ok $uncomp eq $string or print "# got [$uncomp] wanted [$string]\n";; foreach my $trim (-8 .. -1) @@ -848,7 +847,7 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, Append => 1, -Strict => $strict ; + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Append => 1, -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -860,7 +859,7 @@ EOM else { is $status, 0, "status 0"; - ok ! $GunzipError, "no error" + ok ! $GunzipError, "no error" or diag "$GunzipError"; my $expected = substr($buffer, - $got); is $gunz->trailingData(), $expected_trailing, "trailing data"; @@ -881,9 +880,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -916,9 +915,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -951,9 +950,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -980,11 +979,11 @@ EOM 'SubField ID not two chars long' ; my $buffer ; my $x ; - eval { $x = new IO::Compress::Gzip \$buffer, - -ExtraField => [ at => 'mouse', bad => 'dog'] ; + eval { $x = IO::Compress::Gzip->new( \$buffer, + -ExtraField => [ at => 'mouse', bad => 'dog'] ); }; - like $@, mkErr("$error"); - like $GzipError, "/$error/"; + like $@, mkErr("$error"); + like $GzipError, "/$error/"; ok ! $x ; } } diff --git a/cpan/IO-Compress/t/005defhdr.t b/cpan/IO-Compress/t/005defhdr.t index 28059ce2d1..8d4d16310f 100644 --- a/cpan/IO-Compress/t/005defhdr.t +++ b/cpan/IO-Compress/t/005defhdr.t @@ -37,12 +37,12 @@ sub ReadHeaderInfo my %opts = @_ ; my $buffer ; - ok my $def = new IO::Compress::Deflate \$buffer, %opts ; + ok my $def = IO::Compress::Deflate->new( \$buffer, %opts ); 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 ; + ok my $inf = IO::Uncompress::Inflate->new( \$buffer, Append => 1 ); my $uncomp = ""; #ok $inf->read($uncomp) ; my $actual = 0 ; @@ -67,12 +67,12 @@ sub ReadHeaderInfoZlib my %opts = @_ ; my $buffer ; - ok my $def = new Compress::Raw::Zlib::Deflate AppendOutput => 1, %opts ; + ok my $def = Compress::Raw::Zlib::Deflate->new( AppendOutput => 1, %opts ); cmp_ok $def->deflate($string, $buffer), '==', Z_OK; cmp_ok $def->flush($buffer), '==', Z_OK; #print "ReadHeaderInfoZlib\n"; hexDump(\$buffer); - - ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1 ; + + ok my $inf = IO::Uncompress::Inflate->new( \$buffer, Append => 1 ); my $uncomp ; #ok $inf->read($uncomp) ; my $actual = 0 ; @@ -94,7 +94,7 @@ sub ReadHeaderInfoZlib sub printHeaderInfo { my $buffer = shift ; - my $inf = new IO::Uncompress::Inflate \$buffer ; + my $inf = IO::Uncompress::Inflate->new( \$buffer ); my $hdr = $inf->getHeaderInfo(); no warnings 'uninitialized' ; @@ -107,7 +107,7 @@ sub printHeaderInfo # Check the Deflate Header Parameters #======================================== -#my $lex = new LexFile my $name ; +#my $lex = LexFile->new( my $name ); { title "Check default header settings" ; @@ -210,7 +210,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Deflate \$good ; + ok my $x = IO::Compress::Deflate->new( \$good ); ok $x->write($string) ; ok $x->close ; @@ -219,7 +219,7 @@ EOM my $buffer = $good ; substr($buffer, 0, 1) = "\x00" ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/', "CRC mismatch"; } @@ -229,7 +229,7 @@ EOM my $buffer = $good ; substr($buffer, 1, 1) = "\x00" ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/', "CRC mismatch"; } @@ -260,8 +260,8 @@ EOM substr($buffer, 0, 2) = $header; - my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + my $un = IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate \(CM is 3\)/', " Not Deflate"; } @@ -277,7 +277,7 @@ EOM $string = $string x 1000; my $good ; - ok my $x = new IO::Compress::Deflate \$good ; + ok my $x = IO::Compress::Deflate->new( \$good ); ok $x->write($string) ; ok $x->close ; @@ -287,7 +287,7 @@ EOM foreach my $s (0, 1) { title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $buffer = $good ; my $expected_trailing = substr($good, -4, 4) ; substr($expected_trailing, $trim) = ''; @@ -295,7 +295,7 @@ EOM substr($buffer, $trim) = ''; writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => $s; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => $s ); my $uncomp ; if ($s) { @@ -322,10 +322,10 @@ EOM 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 ; + my $lex = LexFile->new( my $name ); writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 1; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => 1 ); my $uncomp ; my $status ; 1 while ($status = $gunz->read($uncomp)) > 0; @@ -343,10 +343,10 @@ EOM 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 ; + my $lex = LexFile->new( my $name ); writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 0; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => 0 ); my $uncomp ; my $status ; 1 while ($status = $gunz->read($uncomp)) > 0; diff --git a/cpan/IO-Compress/t/006zip.t b/cpan/IO-Compress/t/006zip.t index cfc53d79ab..830009127a 100644 --- a/cpan/IO-Compress/t/006zip.t +++ b/cpan/IO-Compress/t/006zip.t @@ -24,11 +24,11 @@ BEGIN { use_ok('IO::Compress::Zip', qw(:all)) ; use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; - eval { - require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.010 ; - require IO::Uncompress::Bunzip2 ; - import IO::Uncompress::Bunzip2 2.010 ; + eval { + require IO::Compress::Bzip2 ; + IO::Compress::Bzip2->import( 2.010 ); + require IO::Uncompress::Bunzip2 ; + IO::Uncompress::Bunzip2->import( 2.010 ); } ; } @@ -38,7 +38,7 @@ sub getContent { my $filename = shift; - my $u = new IO::Uncompress::Unzip $filename, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $filename, Append => 1, @_ ) or die "Cannot open $filename: $UnzipError"; isa_ok $u, "IO::Uncompress::Unzip"; @@ -59,7 +59,7 @@ sub getContent } die "Error processing $filename: $status $!\n" - if $status < 0 ; + if $status < 0 ; return @content; } @@ -69,7 +69,7 @@ sub getContent { title "Create a simple zip - All Deflate"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -77,16 +77,16 @@ sub getContent 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_DEFLATE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -102,7 +102,7 @@ SKIP: skip "IO::Compress::Bzip2 not available", 9 unless defined $IO::Compress::Bzip2::VERSION; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -110,16 +110,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_BZIP2, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_BZIP2, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_BZIP2); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -135,7 +135,7 @@ SKIP: skip "IO::Compress::Bzip2 not available", 9 unless $IO::Compress::Bzip2::VERSION; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -143,16 +143,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -164,7 +164,7 @@ SKIP: { title "Create a simple zip - All STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -172,16 +172,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_STORE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -193,24 +193,24 @@ SKIP: { title "Create a simple zip - Deflate + STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = qw( - hello + hello and - goodbye + goodbye ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -222,7 +222,7 @@ SKIP: { title "Create a simple zip - Deflate + zero length STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello ', @@ -230,16 +230,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -251,7 +251,7 @@ SKIP: { title "RT #72548"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $blockSize = 1024 * 16; @@ -260,16 +260,16 @@ SKIP: "x" x ($blockSize + 1) ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; my @got = getContent($file1, BlockSize => $blockSize); @@ -280,15 +280,15 @@ SKIP: { title "Zip file with a single zero-length file"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -307,13 +307,13 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) my $content = "a single line\n"; my $zip ; - my $status = zip \$content => \$zip, - Method => $method, - Stream => 0, + my $status = zip \$content => \$zip, + Method => $method, + Stream => 0, Name => "123"; is $status, 1, " Created a zip file"; - my $u = new IO::Uncompress::Unzip \$zip; + my $u = IO::Uncompress::Unzip->new( \$zip ); isa_ok $u, "IO::Uncompress::Unzip"; is $u->getline, $content, " Read first line ok"; @@ -324,39 +324,39 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) { title "isMethodAvailable" ; - + ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available"; ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_DEFLATE), "ZIP_CM_DEFLATE available"; #ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available"; - - ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available"; + + ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available"; } { title "Member & Comment 0"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = 'hello' ; - - my $zip = new IO::Compress::Zip $file1, - Name => "0", Comment => "0" ; + + my $zip = IO::Compress::Zip->new( $file1, + Name => "0", Comment => "0" ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content), length($content), "write"; + is $zip->write($content), length($content), "write"; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $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'"; } @@ -365,12 +365,12 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) title "nexStream regression"; # https://github.com/pmqs/IO-Compress/issues/3 - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content1 = qq["organisation_path","collection_occasion_key","episode_key"\n] ; - - my $zip = new IO::Compress::Zip $file1, - Name => "one"; + + my $zip = IO::Compress::Zip->new( $file1, + Name => "one" ); isa_ok $zip, "IO::Compress::Zip"; print $zip $content1; @@ -384,16 +384,16 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) EOM print $zip $content2; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $file1, Append => 1, @_ ) or die "Cannot open $file1: $UnzipError"; isa_ok $u, "IO::Uncompress::Unzip"; my $name = $u->getHeaderInfo()->{Name}; - + is $u->getHeaderInfo()->{Name}, "one", "Name is 'one'"; ok $u->nextStream(), "nextStream OK"; diff --git a/cpan/IO-Compress/t/011-streamzip.t b/cpan/IO-Compress/t/011-streamzip.t index df3fbfb0fd..181371a7c8 100644 --- a/cpan/IO-Compress/t/011-streamzip.t +++ b/cpan/IO-Compress/t/011-streamzip.t @@ -15,11 +15,11 @@ use Test::More ; use CompTestUtils; use IO::Uncompress::Unzip 'unzip' ; -BEGIN -{ +BEGIN +{ plan(skip_all => "Needs Perl 5.005 or better - you have Perl $]" ) if $] < 5.005 ; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -35,7 +35,7 @@ $Inc = '"-MExtUtils::testlib"' my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; - + $Perl = "$Perl $Inc -w" ; #$Perl .= " -Mblib " ; my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" @@ -43,7 +43,7 @@ my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" my $hello1 = <<EOM ; hello -this is +this is a test message x ttttt @@ -54,7 +54,7 @@ EOM -my $lex = new LexFile my $stderr ; +my $lex = LexFile->new( my $stderr ); sub check @@ -62,7 +62,7 @@ sub check my $command = shift ; my $expected = shift ; - my $lex = new LexFile my $stderr ; + my $lex = LexFile->new( my $stderr ); my $cmd = "$command 2>$stderr"; my $stdout = `$cmd` ; @@ -93,7 +93,7 @@ sub check title "streamzip" ; my ($infile, $outfile); - my $lex = new LexFile $infile, $outfile ; + my $lex = LexFile->new( $infile, $outfile ); writeFile($infile, $hello1) ; check "$Perl ${binDir}/streamzip <$infile >$outfile"; @@ -107,7 +107,7 @@ sub check title "streamzip" ; my ($infile, $outfile); - my $lex = new LexFile $infile, $outfile ; + my $lex = LexFile->new( $infile, $outfile ); writeFile($infile, $hello1) ; check "$Perl ${binDir}/streamzip -zipfile=$outfile <$infile"; diff --git a/cpan/IO-Compress/t/01misc.t b/cpan/IO-Compress/t/01misc.t index 7e0d6fd456..36373db630 100644 --- a/cpan/IO-Compress/t/01misc.t +++ b/cpan/IO-Compress/t/01misc.t @@ -10,7 +10,7 @@ use strict; use warnings; use bytes; -use Test::More ; +use Test::More ; use CompTestUtils; BEGIN { @@ -36,35 +36,35 @@ EOM sub My::testParseParameters() { eval { ParseParameters(1, {}, 1) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {}, undef) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {}, []) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; }; - like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), + like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), "wanted unsigned, got undef"; eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; }; - like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), + like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), "wanted unsigned, got undef"; eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; }; - like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), + like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), "wanted signed, got undef"; eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), + like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), "wanted signed, got 'abc'"; eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), + like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), "wanted code, got 'abc'"; @@ -76,25 +76,25 @@ sub My::testParseParameters() if $Config{useithreads}; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' not writable"), + like $@, mkErr("Parameter 'fred' not writable"), "wanted writable, got readonly"; - skip '\\ returns mutable value in 5.19.3', 1 + skip '\\ returns mutable value in 5.19.3', 1 if $] >= 5.019003; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; }; - like $@, mkErr("Parameter 'fred' not writable"), + like $@, mkErr("Parameter 'fred' not writable"), "wanted writable, got readonly"; } my @xx; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; }; - like $@, mkErr("Parameter 'fred' not a scalar reference"), + like $@, mkErr("Parameter 'fred' not a scalar reference"), "wanted scalar reference"; local *ABC; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; }; - like $@, mkErr("Parameter 'fred' not a scalar"), + like $@, mkErr("Parameter 'fred' not a scalar"), "wanted scalar"; eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; }; @@ -137,58 +137,58 @@ sub My::testParseParameters() { my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ; is $got1, $got, "Same object"; - + 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) + for my $type (Parse_unsigned, Parse_signed, Parse_any) { my $value = 0; my $got1 ; eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ; - + ok ! $@; ok $got1->parsed('fred'), "parsed ok" ; is $got1->getValue('fred'), 0; - } + } { # setValue/getValue my $value = 0; my $got1 ; eval { $got1 = ParseParameters(1, {'fred' => [Parse_any, 1]}, fred => $value) } ; - + ok ! $@; ok $got1->parsed('fred'), "parsed ok" ; is $got1->getValue('fred'), 0; $got1->setValue('fred' => undef); - is $got1->getValue('fred'), undef; - } - + is $got1->getValue('fred'), undef; + } + { # twice my $value = 0; - + my $got = IO::Compress::Base::Parameters::new(); - + ok $got->parse({'fred' => [Parse_any, 1]}, fred => $value) ; ok $got->parsed('fred'), "parsed ok" ; is $got->getValue('fred'), 0; - - ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ; + + ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ; ok $got->parsed('fred'), "parsed ok" ; - is $got->getValue('fred'), undef; - - ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ; + is $got->getValue('fred'), undef; + + ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ; ok $got->parsed('fred'), "parsed ok" ; - is $got->getValue('fred'), 7; - } + is $got->getValue('fred'), 7; + } } @@ -208,7 +208,7 @@ My::testParseParameters(); { title "whatIsInput" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open FH, ">$out_file" ; is whatIsInput(*FH), 'handle', "Match filehandle" ; close FH ; @@ -227,7 +227,7 @@ My::testParseParameters(); { title "whatIsOutput" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open FH, ">$out_file" ; is whatIsOutput(*FH), 'handle', "Match filehandle" ; close FH ; @@ -248,34 +248,34 @@ My::testParseParameters(); { title "U64" ; - my $x = new U64(); + my $x = U64->new(); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0, " getLow is 0"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(1,2); + $x = U64->new(1,2); is $x->getHigh, 1, " getHigh is 1"; is $x->getLow, 2, " getLow is 2"; ok $x->is64bit(), " is64bit"; - $x = new U64(0xFFFFFFFF,2); + $x = U64->new(0xFFFFFFFF,2); is $x->getHigh, 0xFFFFFFFF, " getHigh is 0xFFFFFFFF"; is $x->getLow, 2, " getLow is 2"; ok $x->is64bit(), " is64bit"; - $x = new U64(7, 0xFFFFFFFF); + $x = U64->new(7, 0xFFFFFFFF); is $x->getHigh, 7, " getHigh is 7"; is $x->getLow, 0xFFFFFFFF, " getLow is 0xFFFFFFFF"; ok $x->is64bit(), " is64bit"; - $x = new U64(666); + $x = U64->new(666); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 666, " getLow is 666"; ok ! $x->is64bit(), " ! is64bit"; title "U64 - add" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; @@ -285,7 +285,7 @@ My::testParseParameters(); is $x->getLow, 2, " getLow is 2"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(0, 0xFFFFFFFE); + $x = U64->new(0, 0xFFFFFFFE); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0xFFFFFFFE, " getLow is 0xFFFFFFFE"; is $x->get32bit(), 0xFFFFFFFE, " get32bit is 0xFFFFFFFE"; @@ -320,8 +320,8 @@ My::testParseParameters(); is $x->get64bit(), 0xFFFFFFFF+3, " get64bit is 0x100000002"; ok $x->is64bit(), " is64bit"; - $x = new U64(1, 0xFFFFFFFE); - my $y = new U64(2, 3); + $x = U64->new(1, 0xFFFFFFFE); + my $y = U64->new(2, 3); $x->add($y); is $x->getHigh, 4, " getHigh is 4"; @@ -330,7 +330,7 @@ My::testParseParameters(); title "U64 - subtract" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; @@ -340,7 +340,7 @@ My::testParseParameters(); is $x->getLow, 0, " getLow is 0"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(1, 0); + $x = U64->new(1, 0); is $x->getHigh, 1, " getHigh is 1"; is $x->getLow, 0, " getLow is 0"; is $x->get32bit(), 0, " get32bit is 0xFFFFFFFE"; @@ -354,16 +354,16 @@ My::testParseParameters(); is $x->get64bit(), 0xFFFFFFFF, " get64bit is 0xFFFFFFFF"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(2, 2); - $y = new U64(1, 3); + $x = U64->new(2, 2); + $y = U64->new(1, 3); $x->subtract($y); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0xFFFFFFFF, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(0x01CADCE2, 0x4E815983); - $y = new U64(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta + $x = U64->new(0x01CADCE2, 0x4E815983); + $y = U64->new(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta $x->subtract($y); is $x->getHigh, 0x2D2B03, " getHigh is 2D2B03"; @@ -372,17 +372,17 @@ My::testParseParameters(); title "U64 - equal" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; - $y = new U64(0, 1); + $y = U64->new(0, 1); is $y->getHigh, 0, " getHigh is 0"; is $y->getLow, 1, " getLow is 1"; ok ! $y->is64bit(), " ! is64bit"; - my $z = new U64(0, 2); + my $z = U64->new(0, 2); is $z->getHigh, 0, " getHigh is 0"; is $z->getLow, 2, " getLow is 2"; ok ! $z->is64bit(), " ! is64bit"; @@ -391,14 +391,14 @@ My::testParseParameters(); ok !$x->equal($z), " ! equal"; title "U64 - clone" ; - $x = new U64(21, 77); + $x = U64->new(21, 77); $z = U64::clone($x); is $z->getHigh, 21, " getHigh is 21"; is $z->getLow, 77, " getLow is 77"; title "U64 - cmp.gt" ; - $x = new U64 1; - $y = new U64 0; + $x = U64->new( 1 ); + $y = U64->new( 0 ); cmp_ok $x->cmp($y), '>', 0, " cmp > 0"; is $x->gt($y), 1, " gt"; cmp_ok $y->cmp($x), '<', 0, " cmp < 0"; diff --git a/cpan/IO-Compress/t/020isize.t b/cpan/IO-Compress/t/020isize.t index 825e46fc1a..b24bb98d04 100644 --- a/cpan/IO-Compress/t/020isize.t +++ b/cpan/IO-Compress/t/020isize.t @@ -13,8 +13,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} ; @@ -33,7 +33,7 @@ BEGIN use_ok('IO::Compress::Gzip::Constants'); } -my $compressed ; +my $compressed ; my $expected_crc ; for my $wrap (0 .. 2) @@ -59,7 +59,7 @@ for my $wrap (0 .. 2) else { $expected_isize = $offset - 1; } - + sub gzipClosure { my $gzip = shift ; @@ -70,7 +70,7 @@ for my $wrap (0 .. 2) my $buff = 'x' x $inc ; my $left = $max ; - return + return sub { if ($max == 0 && $index == 0) { @@ -113,16 +113,16 @@ for my $wrap (0 .. 2) }; } - my $gzip = new IO::Compress::Gzip \$compressed, + my $gzip = IO::Compress::Gzip->new( \$compressed, -Append => 0, - -HeaderCRC => 1; + -HeaderCRC => 1 ); ok $gzip, " Created IO::Compress::Gzip object"; - my $gunzip = new IO::Uncompress::Gunzip gzipClosure($gzip, $size), + my $gunzip = IO::Uncompress::Gunzip->new( gzipClosure($gzip, $size), -BlockSize => 1024 * 500 , -Append => 0, - -Strict => 1; + -Strict => 1 ); ok $gunzip, " Created IO::Uncompress::Gunzip object"; @@ -147,12 +147,11 @@ for my $wrap (0 .. 2) my $gunzip_hdr = $gunzip->getHeaderInfo(); - is $gunzip_hdr->{ISIZE}, $expected_isize, + is $gunzip_hdr->{ISIZE}, $expected_isize, sprintf(" ISIZE is $expected_isize [0x%X]", $expected_isize); - is $gunzip_hdr->{CRC32}, $expected_crc, + is $gunzip_hdr->{CRC32}, $expected_crc, sprintf(" CRC32 is $expected_crc [0x%X]", $expected_crc); $expected_crc = 0 ; } } - diff --git a/cpan/IO-Compress/t/050interop-gzip.t b/cpan/IO-Compress/t/050interop-gzip.t index ae019c87ac..77b9d76c50 100644 --- a/cpan/IO-Compress/t/050interop-gzip.t +++ b/cpan/IO-Compress/t/050interop-gzip.t @@ -19,7 +19,7 @@ my $GZIP ; sub ExternalGzipWorks { - my $lex = new LexFile my $outfile; + my $lex = LexFile->new( my $outfile ); my $content = qq { Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia @@ -28,7 +28,7 @@ Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id writeWithGzip($outfile, $content) or return 0; - + my $got ; readWithGzip($outfile, $got) or return 0; @@ -46,14 +46,14 @@ sub readWithGzip { my $file = shift ; - my $lex = new LexFile my $outfile; + my $lex = LexFile->new( my $outfile ); my $comp = "$GZIP -d -c" ; if ( system("$comp $file >$outfile") == 0 ) { $_[0] = readFile($outfile); - return 1 + return 1 } diag "'$comp' failed: \$?=$? \$!=$!"; @@ -71,13 +71,13 @@ sub writeWithGzip my $content = shift ; my $options = shift || ''; - my $lex = new LexFile my $infile; + my $lex = LexFile->new( my $infile ); writeFile($infile, $content); unlink $file ; my $comp = "$GZIP -c $options $infile >$file" ; - return 1 + return 1 if system($comp) == 0 ; diag "'$comp' failed: \$?=$? \$!=$!"; @@ -90,14 +90,14 @@ BEGIN { my $name = $^O =~ /mswin/i ? 'gzip.exe' : 'gzip'; my $split = $^O =~ /mswin/i ? ";" : ":"; - for my $dir (reverse split $split, $ENV{PATH}) + for my $dir (reverse split $split, $ENV{PATH}) { $GZIP = File::Spec->catfile($dir,$name) if -x File::Spec->catfile($dir,$name) } - # Handle spaces in path to gzip - $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; + # Handle spaces in path to gzip + $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; plan(skip_all => "Cannot find $name") if ! $GZIP ; @@ -105,7 +105,7 @@ BEGIN { plan(skip_all => "$name doesn't work as expected") if ! ExternalGzipWorks(); - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -124,7 +124,7 @@ BEGIN { my $file; my $file1; - my $lex = new LexFile $file, $file1; + my $lex = LexFile->new( $file, $file1 ); my $content = qq { Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia @@ -143,5 +143,3 @@ Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id ok readWithGzip($file1, $got), "readWithGzip ok"; is $got, $content, "got content"; } - - diff --git a/cpan/IO-Compress/t/101truncate-bzip2.t b/cpan/IO-Compress/t/101truncate-bzip2.t index d533f237a0..e8e4525608 100644 --- a/cpan/IO-Compress/t/101truncate-bzip2.t +++ b/cpan/IO-Compress/t/101truncate-bzip2.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-deflate.t b/cpan/IO-Compress/t/101truncate-deflate.t index 49f9ae41ca..1e8b58e35f 100644 --- a/cpan/IO-Compress/t/101truncate-deflate.t +++ b/cpan/IO-Compress/t/101truncate-deflate.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-gzip.t b/cpan/IO-Compress/t/101truncate-gzip.t index 16b2d07963..df5d877e3f 100644 --- a/cpan/IO-Compress/t/101truncate-gzip.t +++ b/cpan/IO-Compress/t/101truncate-gzip.t @@ -16,7 +16,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-rawdeflate.t b/cpan/IO-Compress/t/101truncate-rawdeflate.t index 177a3d5b37..371ed5c4b0 100644 --- a/cpan/IO-Compress/t/101truncate-rawdeflate.t +++ b/cpan/IO-Compress/t/101truncate-rawdeflate.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -55,22 +55,22 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') my $Error = getErrorRef($UncompressClass); my $compressed ; - ok( my $x = new IO::Compress::RawDeflate \$compressed); + ok( my $x = IO::Compress::RawDeflate->new( \$compressed ) ); ok $x->write($hello) ; ok $x->close ; - + my $cc = $compressed ; my $gz ; - ok($gz = new $UncompressClass(\$cc, + ok($gz = $UncompressClass->can('new')->( $UncompressClass, \$cc, -Transparent => 0)) or diag "$$Error\n"; my $un; is $gz->read($un, length($hello)), length($hello); ok $gz->close(); is $un, $hello ; - + for my $trans (0 .. 1) { title "Testing $CompressClass, Transparent = $trans"; @@ -82,19 +82,19 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') ok 1, "Header size is $header_size" ; ok 1, "Trailer size is $trailer_size" ; - + title "Compressed Data Truncation"; foreach my $i (0 .. $blocksize) { - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + ok 1, "Length $i" ; my $part = substr($compressed, 0, $i); writeFile($name, $part); - my $gz = new $UncompressClass $name, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); if ($trans) { ok $gz; ok ! $gz->error() ; @@ -111,15 +111,15 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') foreach my $i ($blocksize+1 .. length($compressed)-1) { - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + ok 1, "Length $i" ; my $part = substr($compressed, 0, $i); writeFile($name, $part); - ok my $gz = new $UncompressClass $name, + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); my $un ; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; @@ -129,6 +129,5 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') $gz->close(); } } - -} +} diff --git a/cpan/IO-Compress/t/101truncate-zip.t b/cpan/IO-Compress/t/101truncate-zip.t index 80a0aee275..94d4a8da9b 100644 --- a/cpan/IO-Compress/t/101truncate-zip.t +++ b/cpan/IO-Compress/t/101truncate-zip.t @@ -16,7 +16,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/105oneshot-gzip-only.t b/cpan/IO-Compress/t/105oneshot-gzip-only.t index 0382df8e33..ff42b4f884 100644 --- a/cpan/IO-Compress/t/105oneshot-gzip-only.t +++ b/cpan/IO-Compress/t/105oneshot-gzip-only.t @@ -42,11 +42,11 @@ sub gzipGetHeader my $got ; ok IO::Compress::Gzip::gzip($in, \$out, %opts), " gzip ok" ; - ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" + ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" or diag $GunzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Gunzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Gunzip->new( \$out, Strict => 0 ) or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; ok $gunz, " Created IO::Uncompress::Gunzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -57,13 +57,13 @@ sub gzipGetHeader ok $gunz->close, " closed ok" ; return $hdr ; - + } { title "Check gzip header default NAME & MTIME settings" ; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; my $hdr ; @@ -73,7 +73,7 @@ sub gzipGetHeader $mtime = (stat($file1))[9]; # make sure that the gzip file isn't created in the same # second as the input file - sleep 3 ; + sleep 3 ; $hdr = gzipGetHeader($file1, $content); is $hdr->{Name}, $file1, " Name is '$file1'"; @@ -83,7 +83,7 @@ sub gzipGetHeader writeFile($file1, $content); $mtime = (stat($file1))[9]; - sleep 3 ; + sleep 3 ; $hdr = gzipGetHeader($file1, $content, Name => "abcde"); is $hdr->{Name}, "abcde", " Name is 'abcde'" ; @@ -106,9 +106,9 @@ sub gzipGetHeader is $hdr->{Time}, 4321, " Time is 4321"; title "Filehandle doesn't have default Name or Time" ; - my $fh = new IO::File "< $file1" + my $fh = IO::File->new( "< $file1" ) or diag "Cannot open '$file1': $!\n" ; - sleep 3 ; + sleep 3 ; my $before = time ; $hdr = gzipGetHeader($fh, $content); my $after = time ; @@ -131,4 +131,3 @@ sub gzipGetHeader } # TODO add more error cases - diff --git a/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t b/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t index ed3f8c74dc..abeefa7753 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t @@ -18,8 +18,8 @@ BEGIN { if $] < 5.005 ; plan(skip_all => "IO::Compress::Bzip2 not available" ) - unless eval { require IO::Compress::Bzip2; - require IO::Uncompress::Bunzip2; + unless eval { require IO::Compress::Bzip2; + require IO::Uncompress::Bunzip2; 1 } ; @@ -48,11 +48,11 @@ sub zipGetHeader my $got ; ok zip($in, \$out, %opts), " zip ok" ; - ok unzip(\$out, \$got), " unzip ok" + ok unzip(\$out, \$got), " unzip ok" or diag $UnzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Unzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 ) or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ; ok $gunz, " Created IO::Uncompress::Unzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -63,7 +63,7 @@ sub zipGetHeader ok $gunz->close, " closed ok" ; return $hdr ; - + } @@ -79,8 +79,8 @@ for my $input (0, 1) { title "Input $input, Stream $stream, Zip64 $zip64, Method $method"; - my $lex1 = new LexFile my $file1; - my $lex2 = new LexFile my $file2; + my $lex1 = LexFile->new( my $file1 ); + my $lex2 = LexFile->new( my $file2 ); my $content = "hello "; my $in ; @@ -95,9 +95,9 @@ for my $input (0, 1) } - ok zip($in => $file1 , Method => $method, + ok zip($in => $file1 , Method => $method, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; my $got ; @@ -106,7 +106,7 @@ for my $input (0, 1) is $got, $content, " content ok"; - my $u = new IO::Uncompress::Unzip $file1 + my $u = IO::Uncompress::Unzip->new( $file1 ) or diag $ZipError ; my $hdr = $u->getHeaderInfo(); @@ -133,7 +133,7 @@ for my $stream (0, 1) my $file1; my $file2; my $zipfile; - my $lex = new LexFile $file1, $file2, $zipfile; + my $lex = LexFile->new( $file1, $file2, $zipfile ); my $content1 = "hello "; writeFile($file1, $content1); @@ -145,9 +145,9 @@ for my $stream (0, 1) $file2 => $content2, ); - ok zip([$file1, $file2] => $zipfile , Method => $method, + ok zip([$file1, $file2] => $zipfile , Method => $method, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; for my $file ($file1, $file2) @@ -163,4 +163,3 @@ for my $stream (0, 1) } # TODO add more error cases - diff --git a/cpan/IO-Compress/t/105oneshot-zip-only.t b/cpan/IO-Compress/t/105oneshot-zip-only.t index b0d6a4334c..ea7b1b25b5 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-only.t @@ -46,7 +46,7 @@ sub zipGetHeader or diag $UnzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Unzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 ) or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ; ok $gunz, " Created IO::Uncompress::Unzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -63,7 +63,7 @@ sub zipGetHeader { title "Check zip header default NAME & MTIME settings" ; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; my $hdr ; @@ -108,7 +108,7 @@ sub zipGetHeader is $hdr->{Time} >> 1 , $useTime >> 1 , " Time is $useTime"; title "Filehandle doesn't have default Name or Time" ; - my $fh = new IO::File "< $file1" + my $fh = IO::File->new( "< $file1" ) or diag "Cannot open '$file1': $!\n" ; sleep 3 ; my $before = time ; @@ -135,7 +135,7 @@ sub zipGetHeader { title "Check CanonicalName & FilterName"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello" ; writeFile($file1, $content); @@ -222,7 +222,7 @@ for my $stream (0, 1) title "Stream $stream, Zip64 $zip64, Method $method"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; #writeFile($file1, $content); @@ -241,7 +241,7 @@ for my $stream (0, 1) is $got, $content, " content ok"; - my $u = new IO::Uncompress::Unzip $file1 + my $u = IO::Uncompress::Unzip->new( $file1 ) or diag $ZipError ; my $hdr = $u->getHeaderInfo(); @@ -266,7 +266,7 @@ for my $stream (0, 1) my $file1; my $file2; my $zipfile; - my $lex = new LexFile $file1, $file2, $zipfile; + my $lex = LexFile->new( $file1, $file2, $zipfile ); my $content1 = "hello "; writeFile($file1, $content1); diff --git a/cpan/IO-Compress/t/105oneshot-zip-store-only.t b/cpan/IO-Compress/t/105oneshot-zip-store-only.t index 641fb609a8..a7a1eb109a 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-store-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-store-only.t @@ -22,8 +22,8 @@ BEGIN { unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; plan(skip_all => "IO::Compress::Bzip2 not available" ) - unless eval { require IO::Compress::Bzip2; - require IO::Uncompress::Bunzip2; + unless eval { require IO::Compress::Bzip2; + require IO::Uncompress::Bunzip2; 1 } ; @@ -86,7 +86,7 @@ for $content (@contents) ok zip(\$content => \$zipped , Method => ZIP_CM_STORE, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; my $got ; @@ -99,4 +99,3 @@ for $content (@contents) } } } - diff --git a/cpan/IO-Compress/t/107multi-zip-only.t b/cpan/IO-Compress/t/107multi-zip-only.t index 40c7fef5e2..0a8e1ae0cb 100644 --- a/cpan/IO-Compress/t/107multi-zip-only.t +++ b/cpan/IO-Compress/t/107multi-zip-only.t @@ -49,9 +49,9 @@ EOM my $name = "n1"; -my $lex = new LexFile my $zipfile ; +my $lex = LexFile->new( my $zipfile ); -my $x = new IO::Compress::Zip($zipfile, Name => $name++, AutoClose => 1); +my $x = IO::Compress::Zip->new($zipfile, Name => $name++, AutoClose => 1); isa_ok $x, 'IO::Compress::Zip', ' $x' ; @@ -67,10 +67,10 @@ push @buffers, undef; { open F, ">>$zipfile"; print F "trailing"; - close F; + close F; } -my $u = new IO::Uncompress::Unzip $zipfile, Transparent => 1, MultiStream => 0 +my $u = IO::Uncompress::Unzip->new( $zipfile, Transparent => 1, MultiStream => 0 ) or die "Cannot open $zipfile: $UnzipError"; my @names ; diff --git a/cpan/IO-Compress/t/108anyunc-transparent.t b/cpan/IO-Compress/t/108anyunc-transparent.t index 687b1f5cd2..8d79a4669e 100644 --- a/cpan/IO-Compress/t/108anyunc-transparent.t +++ b/cpan/IO-Compress/t/108anyunc-transparent.t @@ -6,7 +6,7 @@ BEGIN { } use lib qw(t t/compress); - + use strict; use warnings; use bytes; @@ -38,7 +38,7 @@ EOM { title "AnyUncompress with Non-compressed data (File $file)" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -52,12 +52,12 @@ EOM my $unc ; my $keep = $buffer ; - $unc = new IO::Uncompress::AnyUncompress $input, -Transparent => 0 ; + $unc = IO::Uncompress::AnyUncompress->new( $input, -Transparent => 0 ); ok ! $unc," no AnyUncompress object when -Transparent => 0" ; is $buffer, $keep ; $buffer = $keep ; - $unc = new IO::Uncompress::AnyUncompress \$buffer, -Transparent => 1 ; + $unc = IO::Uncompress::AnyUncompress->new( \$buffer, -Transparent => 1 ); ok $unc, " AnyUncompress object when -Transparent => 1" ; my $uncomp ; diff --git a/cpan/IO-Compress/t/111const-deflate.t b/cpan/IO-Compress/t/111const-deflate.t index 82a4414149..bdb2eca0f7 100644 --- a/cpan/IO-Compress/t/111const-deflate.t +++ b/cpan/IO-Compress/t/111const-deflate.t @@ -26,75 +26,74 @@ BEGIN { { use Compress::Raw::Zlib ; - + my %all; for my $symbol (@Compress::Raw::Zlib::DEFLATE_CONSTANTS) { eval "defined Compress::Raw::Zlib::$symbol" ; $all{$symbol} = ! $@ ; - } - + } + my $pkg = 1; - - for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) + + for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) { - ++ $pkg ; + ++ $pkg ; eval <<EOM; package P$pkg; use Test::More ; use CompTestUtils; - + use IO::Compress::$module () ; - - ::title "IO::Compress::$module - no import" ; + + ::title "IO::Compress::$module - no import" ; EOM is $@, "", "create package P$pkg"; for my $symbol (@Compress::Raw::Zlib::DEFLATE_CONSTANTS) { if ( $all{$symbol}) { - eval "package P$pkg; defined IO::Compress::${module}::$symbol ;"; + eval "package P$pkg; defined IO::Compress::${module}::$symbol ;"; is $@, "", " has $symbol"; } else { ok 1, " $symbol not available"; } - } - } - - for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) + } + } + + for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) { for my $label (keys %Compress::Raw::Zlib::DEFLATE_CONSTANTS) { - ++ $pkg ; + ++ $pkg ; eval <<EOM; package P$pkg; use Test::More ; use CompTestUtils; - + use IO::Compress::$module qw(:$label) ; - - ::title "IO::Compress::$module - import :$label" ; - + + ::title "IO::Compress::$module - import :$label" ; + EOM is $@, "", "create package P$pkg"; - + for my $symbol (@{ $Compress::Raw::Zlib::DEFLATE_CONSTANTS{$label} } ) { if ( $all{$symbol}) { - eval "package P$pkg; defined $symbol ;"; + eval "package P$pkg; defined $symbol ;"; is $@, "", " has $symbol"; } else { ok 1, " $symbol not available"; - } - } - } - } - -} + } + } + } + } +} diff --git a/cpan/IO-Compress/t/112utf8-zip.t b/cpan/IO-Compress/t/112utf8-zip.t index f90a3cb7d6..ca6fc1afe4 100644 --- a/cpan/IO-Compress/t/112utf8-zip.t +++ b/cpan/IO-Compress/t/112utf8-zip.t @@ -40,7 +40,7 @@ BEGIN { { title "EFS set in zip: Create a simple zip - language encoding flag set"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}', 'beta \N{GREEK SMALL LETTER BETA}', @@ -48,12 +48,12 @@ BEGIN { 'delta \N{GREEK SMALL LETTER DELTA}' ) ; - my @encoded = map { Encode::encode_utf8($_) } @names; + my @encoded = map { Encode::encode_utf8($_) } @names; my @n = @names; - my $zip = new IO::Compress::Zip $file1, - Name => $names[0], Efs => 1; + my $zip = IO::Compress::Zip->new( $file1, + Name => $names[0], Efs => 1 ); my $content = 'Hello, world!'; ok $zip->print($content), "print"; @@ -66,7 +66,7 @@ BEGIN { ok $zip->close(), "closed"; { - my $u = new IO::Uncompress::Unzip $file1, Efs => 1 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 1 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -88,7 +88,7 @@ BEGIN { } { - my $u = new IO::Uncompress::Unzip $file1, Efs => 0 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -107,14 +107,14 @@ BEGIN { or diag "Got " . Dumper(\@efs); is_deeply \@unzip_names, [@names], "Names round tripped" or diag "Got " . Dumper(\@unzip_names); - } + } } { title "Create a simple zip - language encoding flag not set"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}', 'beta \N{GREEK SMALL LETTER BETA}', @@ -124,8 +124,8 @@ BEGIN { my @n = @names; - my $zip = new IO::Compress::Zip $file1, - Name => $names[0], Efs => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => $names[0], Efs => 0 ); my $content = 'Hello, world!'; ok $zip->print($content), "print"; @@ -137,7 +137,7 @@ BEGIN { ok $zip->print($content), "print"; ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Efs => 0 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -161,19 +161,19 @@ BEGIN { { title "zip: EFS => 0 filename not valid utf8 - language encoding flag not set"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); # Invalid UTF8 my $name = "a\xFF\x{100}"; - - my $zip = new IO::Compress::Zip $file1, - Name => $name, Efs => 0 ; + + my $zip = IO::Compress::Zip->new( $file1, + Name => $name, Efs => 0 ); ok $zip->print("abcd"), "print"; ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1 - or die "Cannot open $file1: $UnzipError"; + my $u = IO::Uncompress::Unzip->new( $file1 ) + or die "Cannot open $file1: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; } @@ -184,8 +184,8 @@ BEGIN { my $filename = "t/files/bad-efs.zip" ; my $name = "\xF0\xA4\xAD"; - my $u = new IO::Uncompress::Unzip $filename, efs => 0 - or die "Cannot open $filename: $UnzipError"; + my $u = IO::Uncompress::Unzip->new( $filename, efs => 0 ) + or die "Cannot open $filename: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; } @@ -195,8 +195,8 @@ BEGIN { my $filename = "t/files/bad-efs.zip" ; my $name = "\xF0\xA4\xAD"; - - eval { my $u = new IO::Uncompress::Unzip $filename, efs => 1 + + eval { my $u = IO::Uncompress::Unzip->new( $filename, efs => 1 ) or die "Cannot open $filename: $UnzipError" }; like $@, qr/Zip Filename not UTF-8/, @@ -207,14 +207,14 @@ BEGIN { { title "EFS => 1 - filename not valid utf8 - catch bad content writing to zip"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); # Invalid UTF8 my $name = "a\xFF\x{100}"; - - eval { my $zip = new IO::Compress::Zip $file1, - Name => $name, Efs => 1 } ; - like $@, qr/Wide character in zip filename/, + eval { my $zip = IO::Compress::Zip->new( $file1, + Name => $name, Efs => 1 ) } ; + + like $@, qr/Wide character in zip filename/, " wide characters in zip filename"; }
\ No newline at end of file diff --git a/cpan/IO-Compress/t/compress/CompTestUtils.pm b/cpan/IO-Compress/t/compress/CompTestUtils.pm index c506632f90..61658c9296 100644 --- a/cpan/IO-Compress/t/compress/CompTestUtils.pm +++ b/cpan/IO-Compress/t/compress/CompTestUtils.pm @@ -9,13 +9,13 @@ use bytes; #use lib qw(t t/compress); use Carp ; -#use Test::More ; +#use Test::More ; sub title { - #diag "" ; + #diag "" ; ok(1, $_[0]) ; #diag "" ; } @@ -26,7 +26,7 @@ sub like_eval } BEGIN { - eval { + eval { require File::Temp; } ; @@ -38,7 +38,7 @@ BEGIN { our ($index); $index = '00000'; - + sub new { my $self = shift ; @@ -72,7 +72,7 @@ BEGIN { $index = '00000'; our ($useTempFile); our ($useTempDir); - + sub new { my $self = shift ; @@ -115,11 +115,11 @@ BEGIN { # autogenerate the name if none supplied $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ; } - foreach (@_) - { + foreach (@_) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_; - mkdir $_, 0777 + if -d $_; + mkdir $_, 0777 } bless [ @_ ], $self ; } @@ -131,10 +131,10 @@ BEGIN { if (! $useTempFile) { my $self = shift ; - foreach (@$self) - { + foreach (@$self) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_ ; + if -d $_ ; } } } @@ -150,15 +150,15 @@ sub readFile { my $pos = tell($f); seek($f, 0,0); - @strings = <$f> ; + @strings = <$f> ; seek($f, 0, $pos); } else { - open (F, "<$f") + open (F, "<$f") or croak "Cannot open $f: $!\n" ; binmode F; - @strings = <F> ; + @strings = <F> ; close F ; } @@ -175,7 +175,7 @@ sub writeFile { my($filename, @strings) = @_ ; 1 while unlink $filename ; - open (F, ">$filename") + open (F, ">$filename") or croak "Cannot open $filename: $!\n" ; binmode F; foreach (@strings) { @@ -191,10 +191,10 @@ sub GZreadFile my ($uncomp) = "" ; my $line = "" ; - my $fil = gzopen($filename, "rb") + my $fil = gzopen($filename, "rb") or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; - $uncomp .= $line + $uncomp .= $line while $fil->gzread($line) > 0; $fil->gzclose ; @@ -248,14 +248,14 @@ sub readHeaderInfo some text EOM - ok my $x = new IO::Compress::Gzip $name, %opts + ok my $x = IO::Compress::Gzip->new( $name, %opts ) or diag "GzipError is $IO::Compress::Gzip::GzipError" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0 + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Strict => 0 ) or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; ok my $hdr = $gunz->getHeaderInfo(); my $uncomp ; @@ -562,12 +562,13 @@ sub anyUncompress } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - Append => 1, - Transparent => 0, + my $o = IO::Uncompress::AnyUncompress->new( \$data, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts + ) or croak "Cannot open buffer/file: $AnyUncompressError" ; 1 while $o->read($out) > 0 ; @@ -622,13 +623,14 @@ sub getHeaders } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - MultiStream => 1, - Append => 1, - Transparent => 0, + my $o = IO::Uncompress::AnyUncompress->new( \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts + ) or croak "Cannot open buffer/file: $AnyUncompressError" ; 1 while $o->read($out) > 0 ; @@ -667,7 +669,7 @@ sub mkComplete ); } - my $z = new $class( \$buffer, %params) + my $z = $class->can('new')->( $class, \$buffer, %params) or croak "Cannot create $class object: $$Error"; $z->write($data); $z->close(); @@ -675,7 +677,7 @@ sub mkComplete my $unc = getInverse($class); anyUncompress(\$buffer) eq $data or die "bad bad bad"; - my $u = new $unc( \$buffer); + my $u = $unc->can('new')->( $unc, \$buffer); my $info = $u->getHeaderInfo() ; diff --git a/cpan/IO-Compress/t/compress/any.pl b/cpan/IO-Compress/t/compress/any.pl index c0da133ebe..0569b5af10 100644 --- a/cpan/IO-Compress/t/compress/any.pl +++ b/cpan/IO-Compress/t/compress/any.pl @@ -1,6 +1,6 @@ use lib 't'; - + use strict; use warnings; use bytes; @@ -41,12 +41,12 @@ sub run my $string = "some text" x 100 ; my $buffer ; - my $x = new $CompressClass(\$buffer) ; + my $x = $CompressClass->can('new')->($CompressClass, \$buffer) ; ok $x, " create $CompressClass object" ; ok $x->write($string), " write to object" ; ok $x->close, " close ok" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -58,16 +58,16 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, RawInflate => 1, @anyUnLz, - Append => 1 ; + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; @@ -78,16 +78,16 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, RawInflate => 1, @anyUnLz, - Append => 1 ; + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp, 100) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; diff --git a/cpan/IO-Compress/t/compress/anyunc.pl b/cpan/IO-Compress/t/compress/anyunc.pl index 2860e2571c..8be9c7063e 100644 --- a/cpan/IO-Compress/t/compress/anyunc.pl +++ b/cpan/IO-Compress/t/compress/anyunc.pl @@ -1,6 +1,6 @@ use lib 't'; - + use strict; use warnings; use bytes; @@ -37,12 +37,12 @@ sub run my $string = "some text" x 100 ; my $buffer ; - my $x = new $CompressClass(\$buffer) ; + my $x = $CompressClass->can('new')->( $CompressClass, \$buffer) ; ok $x, " create $CompressClass object" ; ok $x->write($string), " write to object" ; ok $x->close, " close ok" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -54,14 +54,14 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans - Append => 1 ; + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; @@ -72,10 +72,10 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, - Append =>1 ; + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, + Append =>1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp, 10) > 0 ; diff --git a/cpan/IO-Compress/t/compress/destroy.pl b/cpan/IO-Compress/t/compress/destroy.pl index 186520df16..3882e2468d 100644 --- a/cpan/IO-Compress/t/compress/destroy.pl +++ b/cpan/IO-Compress/t/compress/destroy.pl @@ -35,7 +35,7 @@ sub run { # Check that the class destructor will call close - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -44,7 +44,7 @@ EOM { - ok my $x = new $CompressClass $name, -AutoClose => 1 ; + ok my $x = $CompressClass->can('new')->( $CompressClass, $name, -AutoClose => 1 ); ok $x->write($hello) ; } @@ -56,59 +56,59 @@ EOM # Tied filehandle destructor - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world this is a test EOM - my $fh = new IO::File "> $name" ; + my $fh = IO::File->new( "> $name" ); { - ok my $x = new $CompressClass $fh, -AutoClose => 1 ; + ok my $x = $CompressClass->can('new')->( $CompressClass, $fh, -AutoClose => 1 ); $x->write($hello) ; } ok anyUncompress($name) eq $hello ; } - + { title "Testing DESTROY doesn't clobber \$! etc "; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $out; my $result; - + { - ok my $z = new $CompressClass($name); + ok my $z = $CompressClass->can('new')->( $CompressClass, $name ); $z->write("abc") ; $! = 22 ; cmp_ok $!, '==', 22, ' $! is 22'; } - + cmp_ok $!, '==', 22, " \$! has not been changed by $CompressClass destructor"; - + { my $uncomp; - ok my $x = new $UncompressClass($name, -Append => 1) ; - + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1) ; + my $len ; 1 while ($len = $x->read($result)) > 0 ; - + $! = 22 ; cmp_ok $!, '==', 22, ' $! is 22'; - } - + } + cmp_ok $!, '==', 22, " \$! has not been changed by $UncompressClass destructor"; - + is $result, "abc", " Got uncompressed content ok"; - + } } diff --git a/cpan/IO-Compress/t/compress/encode.pl b/cpan/IO-Compress/t/compress/encode.pl index 860d0e46ce..a6ab50ec70 100644 --- a/cpan/IO-Compress/t/compress/encode.pl +++ b/cpan/IO-Compress/t/compress/encode.pl @@ -6,8 +6,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan skip_all => "Encode is not available" if $] < 5.006 ; @@ -15,7 +15,7 @@ BEGIN plan skip_all => "Encode is not available" if $@ ; - + # use Test::NoWarnings, if available my $extra = 0 ; @@ -34,16 +34,16 @@ sub run my $UnError = getErrorRef($UncompressClass); - my $string = "\x{df}\x{100}\x80"; + my $string = "\x{df}\x{100}\x80"; my $encString = Encode::encode_utf8($string); my $buffer = $encString; #for my $from ( qw(filename filehandle buffer) ) { # my $input ; -# my $lex = new LexFile my $name ; +# my $lex = LexFile->new( my $name ); +# # -# # if ($from eq 'buffer') # { $input = \$buffer } # elsif ($from eq 'filename') @@ -53,14 +53,14 @@ sub run # } # elsif ($from eq 'filehandle') # { -# $input = new IO::File "<$name" ; +# $input = IO::File->new( "<$name" ); # } for my $to ( qw(filehandle buffer)) { title "OO Mode: To $to, Encode by hand"; - my $lex2 = new LexFile my $name2 ; + my $lex2 = LexFile->new( my $name2 ); my $output; my $buffer; @@ -72,29 +72,29 @@ sub run } elsif ($to eq 'filehandle') { - $output = new IO::File ">$name2" ; + $output = IO::File->new( ">$name2" ); } my $out ; - my $cs = new $CompressClass($output, AutoClose =>1); + my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1); $cs->print($encString); $cs->close(); my $input; if ($to eq 'buffer') { $input = \$buffer } - else + else { $input = $name2 ; } - my $ucs = new $UncompressClass($input, Append => 1); + my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1); my $got; 1 while $ucs->read($got) > 0 ; - + is $got, $encString, " Expected output"; - + my $decode = Encode::decode_utf8($got); @@ -108,36 +108,36 @@ sub run title "Catch wide characters"; my $out; - my $cs = new $CompressClass(\$out); + my $cs = $CompressClass->can('new')->( $CompressClass, \$out); my $a = "a\xFF\x{100}"; eval { $cs->syswrite($a) }; - like($@, qr/Wide character in ${CompressClass}::write/, + like($@, qr/Wide character in ${CompressClass}::write/, " wide characters in ${CompressClass}::write"); } - + { title "Unknown encoding"; my $output; - eval { my $cs = new $CompressClass(\$output, Encode => 'fred'); } ; - like($@, qr/${CompressClass}: Encoding 'fred' is not available/, + eval { my $cs = $CompressClass->can('new')->( $CompressClass, \$output, Encode => 'fred'); } ; + like($@, qr/${CompressClass}: Encoding 'fred' is not available/, " Encoding 'fred' is not available"); } - + { title "Encode option"; - + for my $to ( qw(filehandle filename buffer)) { title "Encode: To $to, Encode option"; - my $lex2 = new LexFile my $name2 ; + my $lex2 = LexFile->new( my $name2 ); my $output; my $buffer; if ($to eq 'buffer') - { - $output = \$buffer + { + $output = \$buffer } elsif ($to eq 'filename') { @@ -145,18 +145,18 @@ sub run } elsif ($to eq 'filehandle') { - $output = new IO::File ">$name2" ; + $output = IO::File->new( ">$name2" ); } my $out ; - my $cs = new $CompressClass($output, AutoClose =>1, Encode => 'utf8'); + my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1, Encode => 'utf8'); ok $cs->print($string); ok $cs->close(); my $input; if ($to eq 'buffer') - { - $input = \$buffer + { + $input = \$buffer } elsif ($to eq 'filename') { @@ -164,35 +164,34 @@ sub run } else { - $input = new IO::File "<$name2" ; + $input = IO::File->new( "<$name2" ); } - + { - my $ucs = new $UncompressClass($input, AutoClose =>1, Append => 1); + my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, AutoClose =>1, Append => 1); my $got; 1 while $ucs->read($got) > 0 ; ok length($got) > 0; is $got, $encString, " Expected output"; - + my $decode = Encode::decode_utf8($got); - + is $decode, $string, " Expected output"; } - - + + # { -# my $ucs = new $UncompressClass($input, Append => 1, Decode => 'utf8'); +# my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1, Decode => 'utf8'); # my $got; # 1 while $ucs->read($got) > 0 ; -# ok length($got) > 0; +# ok length($got) > 0; # is $got, $string, " Expected output"; -# } - } +# } + } } } - -1; +1; diff --git a/cpan/IO-Compress/t/compress/generic.pl b/cpan/IO-Compress/t/compress/generic.pl index d9695e88dc..2c24bb85e5 100644 --- a/cpan/IO-Compress/t/compress/generic.pl +++ b/cpan/IO-Compress/t/compress/generic.pl @@ -9,8 +9,8 @@ use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); use CompTestUtils; our ($UncompressClass); -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; @@ -27,10 +27,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 0, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -53,13 +53,13 @@ sub run title "Testing $CompressClass Errors"; # Buffer not writable - eval qq[\$a = new $CompressClass(\\1) ;] ; + eval qq[\$a = $CompressClass->new(\\1) ;] ; like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ; - + my($out, $gz); - + my $x ; - $gz = new $CompressClass(\$x); + $gz = $CompressClass->can('new')->($CompressClass, \$x); foreach my $name (qw(read readline getc)) { @@ -83,20 +83,20 @@ sub run my $out = "" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok ! -e $name, " $name does not exist"; - - $a = new $UncompressClass "$name" ; + + $a = $UncompressClass->can('new')->( $UncompressClass, "$name" ); is $a, undef; my $gc ; - my $guz = new $CompressClass(\$gc); + my $guz = $CompressClass->can('new')->( $CompressClass, \$gc); $guz->write("abc") ; $guz->close(); my $x ; - my $gz = new $UncompressClass(\$gc); + my $gz = $UncompressClass->can('new')->( $UncompressClass, \$gc); foreach my $name (qw(print printf write)) { @@ -114,14 +114,14 @@ sub run my ($a, $x, @x) = ("","","") ; # Buffer not a scalar reference - eval qq[\$a = new $CompressClass \\\@x ;] ; + eval qq[\$a = $CompressClass->new( \\\@x );] ; like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref"); - + # Buffer not a scalar reference - eval qq[\$a = new $UncompressClass \\\@x ;] ; + eval qq[\$a = $UncompressClass->new( \\\@x );] ; like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref"); } - + foreach my $Type ( $CompressClass, $UncompressClass) { # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate @@ -129,27 +129,27 @@ sub run my ($a, $x, @x) = ("","","") ; # Odd number of parameters - eval qq[\$a = new $Type "abc", -Output ] ; + eval qq[\$a = $Type->new( "abc", -Output ) ] ; like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1"); # Unknown parameter - eval qq[\$a = new $Type "anc", -Fred => 123 ;] ; + eval qq[\$a = $Type->new( "anc", -Fred => 123 );] ; like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred"); # no in or out param - eval qq[\$a = new $Type ;] ; + eval qq[\$a = $Type->new();] ; like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter"); - } + } { - # write a very simple compressed file - # and read back + # write a very simple compressed file + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -158,7 +158,7 @@ EOM { my $x ; - ok $x = new $CompressClass $name ; + ok $x = $CompressClass->can('new')->( $CompressClass, $name ); is $x->autoflush(1), 0, "autoflush"; is $x->autoflush(1), 1, "autoflush"; ok $x->opened(), "opened"; @@ -171,7 +171,7 @@ EOM { my $uncomp; - ok my $x = new $UncompressClass $name, -Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1 ); ok $x->opened(), "opened"; my $len ; @@ -187,12 +187,12 @@ EOM } { - # write a very simple compressed file - # and read back + # write a very simple compressed file + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -201,7 +201,7 @@ EOM { my $x ; - ok $x = new $CompressClass $name ; + ok $x = $CompressClass->can('new')->( $CompressClass, $name ); is $x->write(''), 0, "Write empty string is ok"; is $x->write(undef), 0, "Write undef is ok"; @@ -211,7 +211,7 @@ EOM { my $uncomp; - my $x = new $UncompressClass $name ; + my $x = $UncompressClass->can('new')->( $UncompressClass, $name ); ok $x, "creates $UncompressClass $name" ; my $data = ''; @@ -225,11 +225,11 @@ EOM { # write a very simple file with using an IO filehandle - # and read back + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -237,9 +237,9 @@ this is a test EOM { - my $fh = new IO::File ">$name" ; + my $fh = IO::File->new( ">$name" ); ok $fh, "opened file $name ok"; - my $x = new $CompressClass $fh ; + my $x = $CompressClass->can('new')->( $CompressClass, $fh ); ok $x, " created $CompressClass $fh" ; is $x->fileno(), fileno($fh), "fileno match" ; @@ -254,8 +254,8 @@ EOM my $uncomp; { my $x ; - ok my $fh1 = new IO::File "<$name" ; - ok $x = new $UncompressClass $fh1, -Append => 1 ; + ok my $fh1 = IO::File->new( "<$name" ); + ok $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, -Append => 1 ); ok $x->fileno() == fileno $fh1 ; 1 while $x->read($uncomp) > 0 ; @@ -268,11 +268,11 @@ EOM { # write a very simple file with using a glob filehandle - # and read back + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); #my $name = "/tmp/fred"; my $hello = <<EOM ; @@ -281,10 +281,10 @@ this is a test EOM { - title "$CompressClass: Input from typeglob filehandle"; + title "$CompressClass: Input from typeglob filehandle"; ok open FH, ">$name" ; - - my $x = new $CompressClass *FH ; + + my $x = $CompressClass->can('new')->( $CompressClass, *FH ); ok $x, " create $CompressClass" ; is $x->fileno(), fileno(*FH), " fileno" ; @@ -299,10 +299,10 @@ EOM my $uncomp; { - title "$UncompressClass: Input from typeglob filehandle, append output"; + title "$UncompressClass: Input from typeglob filehandle, append output"; my $x ; ok open FH, "<$name" ; - ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0 + ok $x = $UncompressClass->can('new')->( $UncompressClass, *FH, -Append => 1, Transparent => 0 ) or diag $$UnError ; is $x->fileno(), fileno FH, " fileno ok" ; @@ -316,7 +316,7 @@ EOM } { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); #my $name = "/tmp/fred"; my $hello = <<EOM ; @@ -330,8 +330,8 @@ EOM open(SAVEOUT, ">&STDOUT"); my $dummy = fileno SAVEOUT; open STDOUT, ">$name" ; - - my $x = new $CompressClass '-' ; + + my $x = $CompressClass->can('new')->( $CompressClass, '-' ); $x->write($hello); $x->close; @@ -343,7 +343,7 @@ EOM #hexDump($name); { - title "Input from stdin via filename '-'"; + title "Input from stdin via filename '-'"; my $x ; my $uncomp ; @@ -352,7 +352,7 @@ EOM open(SAVEIN, "<&STDIN"); ok open(STDIN, "<$name"), " redirect STDIN"; my $dummy = fileno SAVEIN; - $x = new $UncompressClass '-', Append => 1, Transparent => 0 + $x = $UncompressClass->can('new')->( $UncompressClass, '-', Append => 1, Transparent => 0 ) or diag $$UnError ; ok $x, " created object" ; is $x->fileno(), $stdinFileno, " fileno ok" ; @@ -366,12 +366,12 @@ EOM } { - # write a compressed file to memory - # and read back + # write a compressed file to memory + # and read back #======================================== #my $name = "test.gz" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -381,8 +381,8 @@ EOM my $buffer ; { my $x ; - ok $x = new $CompressClass(\$buffer) ; - + ok $x = $CompressClass->can('new')->( $CompressClass, \$buffer) ; + ok ! defined $x->autoflush(1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->fileno() ; @@ -391,7 +391,7 @@ EOM ok $x->write($hello) ; ok $x->flush(); ok $x->close ; - + writeFile($name, $buffer) ; #is anyUncompress(\$buffer), $hello, " any ok"; } @@ -400,7 +400,7 @@ EOM my $uncomp; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->autoflush(1) ; @@ -422,17 +422,17 @@ EOM my $buffer = ''; { my $x ; - $x = new $CompressClass(\$buffer); + $x = $CompressClass->can('new')->( $CompressClass, \$buffer); ok $x, "new $CompressClass" ; ok $x->close, "close ok" ; - + } my $keep = $buffer ; my $uncomp= ''; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; 1 while $x->read($uncomp) > 0 ; @@ -449,7 +449,7 @@ EOM #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -460,7 +460,7 @@ EOM my $contents = '' ; { - my $x = new $CompressClass $name ; + my $x = $CompressClass->can('new')->( $CompressClass, $name ); ok $x, " created $CompressClass object"; ok $x->write($hello), " write ok" ; @@ -492,7 +492,7 @@ EOM skip "zstd doesn't support trailing data", 11 if $CompressClass =~ /zstd/i ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -504,11 +504,11 @@ EOM { my $fh ; - ok $fh = new IO::File ">$name" ; + ok $fh = IO::File->new( ">$name" ); print $fh $header ; my $x ; - ok $x = new $CompressClass $fh, - -AutoClose => 0 ; + ok $x = $CompressClass->can('new')->( $CompressClass, $fh, + -AutoClose => 0 ); ok $x->binmode(); ok $x->write($hello) ; @@ -519,12 +519,12 @@ EOM my ($fil, $uncomp) ; my $fh1 ; - ok $fh1 = new IO::File "<$name" ; + ok $fh1 = IO::File->new( "<$name" ); # skip leading junk my $line = <$fh1> ; ok $line eq $header ; - ok my $x = new $UncompressClass $fh1, Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, Append => 1 ); ok $x->binmode(); 1 while $x->read($uncomp) > 0 ; @@ -554,7 +554,7 @@ EOM my $compressed ; { - ok my $x = new $CompressClass(\$compressed); + ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed); ok $x->write($hello) ; ok $x->close ; @@ -562,7 +562,7 @@ EOM } my $uncomp; - ok my $x = new $UncompressClass(\$compressed, Append => 1) ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, \$compressed, Append => 1) ; 1 while $x->read($uncomp) > 0 ; ok $uncomp eq $hello ; @@ -574,7 +574,7 @@ EOM # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -604,7 +604,7 @@ EOM } my $foo = "1234567890"; - + is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" } @@ -643,22 +643,22 @@ and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my %opts = () ; - my $iow = new $CompressClass $name, %opts; - is $iow->input_line_number, undef; + my $iow = $CompressClass->can('new')->( $CompressClass, $name, %opts ); + is $iow->input_line_number, undef; $iow->print($str) ; - is $iow->input_line_number, undef; + is $iow->input_line_number, undef; $iow->close ; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - - is $., 0; - is $io->input_line_number, 0; + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell 0" ; #my @lines = <$io>; @@ -667,10 +667,10 @@ EOT or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; - is $io->input_line_number, 6; + is $., 6; + is $io->input_line_number, 6; is $io->tell(), length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -679,44 +679,44 @@ EOT defined($io->getc) || $io->read($buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); - is $., 0, "line 0"; - is $io->input_line_number, 0; + is $., 0, "line 0"; + is $io->input_line_number, 0; ok ! $io->eof, "eof"; my @lines = $io->getlines; - is $., 1, "line 1"; - is $io->input_line_number, 1, "line number 1"; + 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); ok ! $io->eof; my $line = $io->getline(); ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., 2; - is $io->input_line_number, 2; + is $., 2; + is $io->input_line_number, 2; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { # Record mode my $reclen = 7 ; @@ -725,15 +725,15 @@ EOT local $/ = \$reclen; my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., $expected_records; - is $io->input_line_number, $expected_records; + is $., $expected_records; + is $io->input_line_number, $expected_records; ok $io->eof; - is @lines, $expected_records, + is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; @@ -751,26 +751,26 @@ EOT push(@lines, $a); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - is $., 3; - is $io->input_line_number, 3; - ok @lines == 3 + + is $., 3; + is $io->input_line_number, 3; + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + eval { $io->read(1) } ; like $@, mkErr("buffer parameter is read-only"); @@ -781,18 +781,18 @@ EOT is $io->read($buf, 3), 3 ; is $buf, "Thi"; - + is $io->sysread($buf, 3, 2), 3 ; is $buf, "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; - + # read the rest of the file $buf = ''; my $remain = length($str) - 9; @@ -812,15 +812,15 @@ EOT ok $io->eof; # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -837,25 +837,25 @@ of a paragraph and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $str); my @tmp; my $buf; { - my $io = new $UncompressClass $name, -Transparent => 1 ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 ); + isa_ok $io, $UncompressClass ; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell == 0" ; my @lines = $io->getlines(); - is @lines, 6, "got 6 lines"; + is @lines, 6, "got 6 lines"; ok $lines[1] eq "of a paragraph\n" ; ok join('', @lines) eq $str ; - is $., 6; - is $io->input_line_number, 6; + is $., 6; + is $io->input_line_number, 6; ok $io->tell() == length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -864,42 +864,42 @@ EOT defined($io->getc) || $io->read($buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; - is $., 1; - is $io->input_line_number, 1; + is $., 1; + is $io->input_line_number, 1; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = $io->getline; - is $., 1; - is $io->input_line_number, 1; + is $., 1; + is $io->input_line_number, 1; is $line, $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; - is $., 2; - is $io->input_line_number, 2; + is $., 2; + is $io->input_line_number, 2; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# [$lines[0]]\n" ; ok $lines[1] eq "and a single line.\n\n"; } - + { # Record mode my $reclen = 7 ; @@ -908,15 +908,15 @@ EOT local $/ = \$reclen; my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., $expected_records; - is $io->input_line_number, $expected_records; + is $., $expected_records; + is $io->input_line_number, $expected_records; ok $io->eof; - is @lines, $expected_records, + is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; @@ -934,12 +934,12 @@ EOT push(@lines, $a); $err++ if $. != ++$no; } - - is $., 3; - is $io->input_line_number, 3; + + is $., 3; + is $io->input_line_number, 3; ok $err == 0 ; ok $io->eof; - + ok @lines == 3 ; ok join("-", @lines) eq @@ -947,30 +947,30 @@ EOT "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test Read - + { my $io = $UncompressClass->new($name); - + $buf = "abcd"; is $io->read($buf, 0), 0, "Requested 0 bytes" ; is $buf, "", "Buffer empty"; ok $io->read($buf, 3) == 3 ; ok $buf eq "Thi"; - + ok $io->sysread($buf, 3, 2) == 3 ; ok $buf eq "Ths i"; ok ! $io->eof; - + $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; - + # read the rest of the file $buf = ''; my $remain = length($str) - 9; @@ -990,15 +990,15 @@ EOT ok $io->eof; # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -1029,24 +1029,24 @@ EOT { title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); if ($trans) { writeFile($name, $str) ; } else { - my $iow = new $CompressClass $name; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); $iow->print($str) ; $iow->close ; } - - my $io = $UncompressClass->new($name, + + my $io = $UncompressClass->new($name, -Append => $append, -Transparent => $trans); - + my $buf; - + is $io->tell(), 0; if ($append) { @@ -1073,7 +1073,7 @@ EOT my $buffer ; my $buff ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; @@ -1095,7 +1095,7 @@ EOT $output = \$buffer; } - my $iow = new $CompressClass $output ; + my $iow = $CompressClass->can('new')->( $CompressClass, $output ); $iow->print($first) ; ok $iow->seek(5, SEEK_CUR) ; ok $iow->tell() == length($first)+5; @@ -1121,7 +1121,7 @@ EOT ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ; my $io = $UncompressClass->new($input, Strict => 1); - ok $io->seek(length($first), SEEK_CUR) + ok $io->seek(length($first), SEEK_CUR) or diag $$UnError ; ok ! $io->eof; is $io->tell(), length($first); @@ -1146,9 +1146,9 @@ EOT title "seek error cases" ; my $b ; - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; - ok ! $a->error() + ok ! $a->error() or die $a->error() ; eval { $a->seek(-1, 10) ; }; like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter"); @@ -1160,7 +1160,7 @@ EOT $a->close ; - my $u = new $UncompressClass(\$b) ; + my $u = $UncompressClass->can('new')->( $UncompressClass, \$b) ; eval { $u->seek(-1, 10) ; }; like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter"); @@ -1171,7 +1171,7 @@ EOT eval { $u->seek(-1, SEEK_CUR) ; }; like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards"); } - + foreach my $fb (qw(filename buffer filehandle)) { foreach my $append (0, 1) @@ -1179,7 +1179,7 @@ EOT { title "$CompressClass -- Append $append, Output to $fb" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $already = 'already'; my $buffer = $already; @@ -1194,17 +1194,17 @@ EOT } elsif ($fb eq 'filehandle') { - $output = new IO::File ">$name" ; + $output = IO::File->new( ">$name" ); print $output $buffer; } - my $a = new $CompressClass($output, Append => $append) ; + my $a = $CompressClass->can('new')->( $CompressClass, $output, Append => $append) ; ok $a, " Created $CompressClass"; my $string = "appended"; $a->write($string); $a->close ; - my $data ; + my $data ; if ($fb eq 'buffer') { $data = $buffer; @@ -1224,7 +1224,7 @@ EOT my $uncomp; - my $x = new $UncompressClass(\$data, Append => 1) ; + my $x = $UncompressClass->can('new')->( $UncompressClass, \$data, Append => 1) ; ok $x, " created $UncompressClass"; my $len ; @@ -1232,7 +1232,7 @@ EOT $x->close ; is $uncomp, $string, ' Got uncompressed data' ; - + } } } @@ -1243,13 +1243,13 @@ EOT { title "$UncompressClass -- InputLength, read from $type, good data => $good"; - my $compressed ; + my $compressed ; my $string = "some data"; my $appended = "append"; if ($good) { - my $c = new $CompressClass(\$compressed); + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->write($string); $c->close(); } @@ -1261,7 +1261,7 @@ EOT my $comp_len = length $compressed; $compressed .= $appended; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; writeFile ($name, $compressed); @@ -1275,12 +1275,12 @@ EOT } elsif ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass($input, + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, InputLength => $comp_len, Transparent => 1) ; ok $x, " created $UncompressClass"; @@ -1302,20 +1302,20 @@ EOT } - + foreach my $append (0, 1) { title "$UncompressClass -- Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $string = "appended"; - my $compressed ; - my $c = new $CompressClass(\$compressed); + my $compressed ; + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->write($string); $c->close(); - my $x = new $UncompressClass(\$compressed, Append => $append) ; + my $x = $UncompressClass->can('new')->( $UncompressClass, \$compressed, Append => $append) ; ok $x, " created $UncompressClass"; my $already = 'already'; @@ -1334,7 +1334,7 @@ EOT } is $output, $string, ' Got uncompressed data' ; } - + foreach my $file (0, 1) { @@ -1342,7 +1342,7 @@ EOT { title "ungetc, File $file, Transparent $trans" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $string = 'abcdeABCDE'; my $b ; @@ -1352,7 +1352,7 @@ EOT } else { - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; $a->write($string); $a->close ; } @@ -1399,7 +1399,7 @@ EOT ok ! $u->eof(); is $u->read($buff), length($extra) ; is $buff, $extra; - + is $u->read($buff, 1), 0; ok $u->eof() ; @@ -1413,19 +1413,19 @@ EOT { title "write tests - invalid data" ; - #my $lex = new LexFile my $name1 ; + #my $lex = LexFile->new( my $name1 ); my($Answer); #ok ! -e $name1, " File $name1 does not exist"; my @data = ( - [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], - [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], - [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], - #[ "not readable", 'xx' ], + [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], + #[ "not readable", 'xx' ], # same filehandle twice, 'xx' ) ; @@ -1435,7 +1435,7 @@ EOT title "${CompressClass}::write( $send )"; my($copy); eval "\$copy = $send"; - my $x = new $CompressClass(\$Answer); + my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); ok $x, " Created $CompressClass object"; eval { $x->write($copy) } ; #like $@, "/^$get/", " error - $get"; @@ -1443,8 +1443,8 @@ EOT } # @data = ( - # [ '[ $name1 ]', "input file '$name1' does not exist" ], - # #[ "not readable", 'xx' ], + # [ '[ $name1 ]', "input file '$name1' does not exist" ], + # #[ "not readable", 'xx' ], # # same filehandle twice, 'xx' # ) ; # @@ -1454,14 +1454,14 @@ EOT # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; - # my $x = new $CompressClass(\$Answer); + # my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); # ok $x, " Created $CompressClass object"; # ok ! $x->write($copy), " write fails" ; # like $$Error, "/^$get/", " error - $get"; # } #exit; - + } @@ -1495,17 +1495,17 @@ EOT # # if (! ref $_[0]) # { - # $_[0] = $to + # $_[0] = $to # if $_[0] eq $from ; - # return ; + # return ; # # } # # if (ref $_[0] eq 'SCALAR') # { - # $_[0] = \$to + # $_[0] = \$to # if defined ${ $_[0] } && ${ $_[0] } eq $from ; - # return ; + # return ; # # } # @@ -1526,7 +1526,7 @@ EOT # my $file1 = "file1" ; # my $file2 = "file2" ; # my $file3 = "file3" ; - # my $lex = new LexFile $file1, $file2, $file3 ; + # my $lex = LexFile->new( $file1, $file2, $file3 ); # # writeFile($file1, "F1"); # writeFile($file2, "F2"); @@ -1564,15 +1564,15 @@ EOT # { # my ($send, $get) = @$data ; # - # my $fh1 = new IO::File "< $file1" ; - # my $fh2 = new IO::File "< $file2" ; - # my $fh3 = new IO::File "< $file3" ; + # my $fh1 = IO::File->new( "< $file1" ); + # my $fh2 = IO::File->new( "< $file2" ); + # my $fh3 = IO::File->new( "< $file3" ); # # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; # my $Answer ; - # my $x = new $CompressClass(\$Answer); + # my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); # ok $x, " Created $CompressClass object"; # my $len = length $get; # is $x->write($copy), length($get), " write $len bytes"; @@ -1583,7 +1583,7 @@ EOT # # # } - # + # # } } @@ -1599,15 +1599,15 @@ EOT my $appended = "append"; my $string = "some data"; - my $compressed ; + my $compressed ; - my $c = new $CompressClass(\$compressed); + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->close(); my $comp_len = length $compressed; $compressed .= $appended if $append && $CompressClass !~ /zstd/i; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; writeFile ($name, $compressed); @@ -1621,7 +1621,7 @@ EOT } elsif ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } @@ -1632,7 +1632,7 @@ EOT # Check that readline returns undef - my $x = new $UncompressClass $input, Transparent => 0 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1648,12 +1648,12 @@ EOT # Check that read returns an empty string if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass $input, Transparent => 0 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1672,12 +1672,12 @@ EOT if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass $input, Transparent => 0, - Append => 1 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0, + Append => 1 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1694,11 +1694,11 @@ EOT if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass($input, Append => 1 ); + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1 ); isa_ok $x, $UncompressClass; my $buffer = "123"; @@ -1718,30 +1718,30 @@ EOT my $original = join '', map { chr } 0x00 .. 0xff ; $original .= "data1\r\ndata2\r\ndata3\r\n" ; - - + + title "$UncompressClass -- round trip test"; my $string = $original; - my $lex = new LexFile( my $name, my $compressed) ; + my $lex = LexFile->new( my $name, my $compressed) ; my $input ; writeFile ($name, $original); - my $c = new $CompressClass($compressed); + my $c = $CompressClass->can('new')->( $CompressClass, $compressed); isa_ok $c, $CompressClass; $c->print($string); $c->close(); - my $u = new $UncompressClass $compressed, Transparent => 0 + my $u = $UncompressClass->can('new')->( $UncompressClass, $compressed, Transparent => 0 ) or diag "$$UnError" ; isa_ok $u, $UncompressClass; my $buffer; is $u->read($buffer), length($original), "read bytes"; is $buffer, $original, " round tripped ok"; - - } + + } } 1; diff --git a/cpan/IO-Compress/t/compress/merge.pl b/cpan/IO-Compress/t/compress/merge.pl index 9cb359c109..a0442ed041 100644 --- a/cpan/IO-Compress/t/compress/merge.pl +++ b/cpan/IO-Compress/t/compress/merge.pl @@ -3,15 +3,15 @@ use strict; use warnings; use bytes; -use Test::More ; +use Test::More ; use CompTestUtils; use Compress::Raw::Zlib 2 ; -BEGIN -{ - plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " - . Compress::Raw::Zlib::zlib_version()) +BEGIN +{ + plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " + . Compress::Raw::Zlib::zlib_version()) if ZLIB_VERNUM() < 0x1210 ; # use Test::NoWarnings, if available @@ -32,7 +32,7 @@ sub run my $Error = getErrorRef($CompressClass); my $UnError = getErrorRef($UncompressClass); - # Tests + # Tests # destination is a file that doesn't exist -- should work ok unless AnyDeflate # destination isn't compressed at all # destination is compressed but wrong format @@ -43,7 +43,7 @@ sub run { title "Misc error cases"; - eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ; + eval { Compress::Raw::Zlib::InflateScan->new( Bufsize => 0 ) } ; like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ; @@ -58,23 +58,23 @@ sub run { if ($to_file) { title "$CompressClass - Merge to filename that isn't writable" } - else + else { title "$CompressClass - Merge to filehandle that isn't writable" } - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); # create empty file open F, ">$out_file" ; print F "x"; close F; ok -e $out_file, " file exists" ; ok !-z $out_file, " and is not empty" ; - + # make unwritable is chmod(0444, $out_file), 1, " chmod worked" ; ok -e $out_file, " still exists after chmod" ; SKIP: { - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if -w $out_file ; ok ! -w $out_file, " chmod made file unwritable" ; @@ -83,10 +83,10 @@ sub run if ($to_file) { $dest = $out_file } else - { $dest = new IO::File "<$out_file" } + { $dest = IO::File->new( "<$out_file" ) } my $gz = $CompressClass->new($dest, Merge => 1) ; - + ok ! $gz, " Did not create $CompressClass object"; ok $$Error, " Got error message" ; @@ -99,7 +99,7 @@ sub run # output is not compressed at all { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw(buffer file handle ) ) { @@ -120,7 +120,7 @@ sub run if ($to_file eq 'handle') { - $buffer = new IO::File "+<$out_file" + $buffer = IO::File->new( "+<$out_file" ) or die "# Cannot open $out_file: $!"; } else @@ -138,7 +138,7 @@ sub run # output is empty { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw(buffer file handle ) ) { @@ -159,7 +159,7 @@ sub run if ($to_file eq 'handle') { - $buffer = new IO::File "+<$out_file" + $buffer = IO::File->new( "+<$out_file" ) or die "# Cannot open $out_file: $!"; } else @@ -182,12 +182,12 @@ sub run { title "$CompressClass - Merge to file that doesn't exist"; - my $lex = new LexFile my $out_file ; - + my $lex = LexFile->new( my $out_file ); + ok ! -e $out_file, " Destination file, '$out_file', does not exist"; - ok my $gz1 = $CompressClass->new($out_file, Merge => 1) - or die "# $CompressClass->new failed: $$Error\n"; + ok my $gz1 = $CompressClass->can('new')->( $CompressClass, $out_file, Merge => 1) + or die "# $CompressClass->new(...) failed: $$Error\n"; #hexDump($buffer); $gz1->write("FGHI"); $gz1->close(); @@ -200,13 +200,13 @@ sub run { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw( buffer file handle ) ) { foreach my $content (undef, '', 'x', 'abcde') { - #next if ! defined $content && $to_file; + #next if ! defined $content && $to_file; my $buffer ; my $disp_content = defined $content ? $content : '<undef>' ; @@ -245,10 +245,10 @@ sub run # #} - my $dest = $buffer ; + my $dest = $buffer ; if ($to_file eq 'handle') { - $dest = new IO::File "+<$buffer" ; + $dest = IO::File->new( "+<$buffer" ); } my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1) @@ -278,7 +278,7 @@ sub run my $buffer ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file (0, 1) { @@ -298,7 +298,7 @@ sub run $buffer = \$x ; title "$TopType to Buffer, content is '$disp_content'"; } - + ok $Func->(\$content, $buffer), " Compress content"; #hexDump($buffer); diff --git a/cpan/IO-Compress/t/compress/multi.pl b/cpan/IO-Compress/t/compress/multi.pl index 48129a7c45..06d78b983a 100644 --- a/cpan/IO-Compress/t/compress/multi.pl +++ b/cpan/IO-Compress/t/compress/multi.pl @@ -47,7 +47,7 @@ EOM even more stuff EOM - my $b0length = length $buffers[0]; + my $b0length = length $buffers[0]; my $bufcount = @buffers; { @@ -55,7 +55,7 @@ EOM my $gz ; my $hsize ; my %headers = () ; - + foreach my $fb ( qw( file filehandle buffer ) ) { @@ -71,11 +71,11 @@ EOM Strict => 1, Comment => "this is a comment", ExtraField => ["so" => "me extra"], - HeaderCRC => 1); + HeaderCRC => 1); } - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $output ; if ($fb eq 'buffer') { @@ -84,14 +84,14 @@ EOM } elsif ($fb eq 'filehandle') { - $output = new IO::File ">$name" ; + $output = IO::File->new( ">$name" ); } else { $output = $name ; } - my $x = new $CompressClass($output, AutoClose => 1, %headers); + my $x = $CompressClass->can('new')->($CompressClass, $output, AutoClose => 1, %headers); isa_ok $x, $CompressClass, ' $x' ; foreach my $buffer (@buffs) { @@ -106,12 +106,12 @@ EOM $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->($unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -142,12 +142,12 @@ EOM $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->( $unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -183,12 +183,12 @@ EOM $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->( $unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -210,13 +210,13 @@ EOM $un .= $_; } is $., $lines, " \$. is $lines"; - + ok ! $gz->error(), " ! error()" or diag "Error is " . $gz->error() ; ok $gz->eof(), " eof()"; is $gz->streamCount(), $stream, " streamCount is $stream" or diag "Stream count is " . $gz->streamCount(); - is $un, $buff, " expected output" + is $un, $buff, " expected output" or diag "Stream count is " . $gz->streamCount(); ; #is $gz->tell(), length $buff, " tell is ok"; is $gz->nextStream(), 1, " nextStream ok"; diff --git a/cpan/IO-Compress/t/compress/newtied.pl b/cpan/IO-Compress/t/compress/newtied.pl index 41861e9072..e5ced14397 100644 --- a/cpan/IO-Compress/t/compress/newtied.pl +++ b/cpan/IO-Compress/t/compress/newtied.pl @@ -7,12 +7,12 @@ use Test::More ; use CompTestUtils; our ($BadPerl, $UncompressClass); - -BEGIN -{ + +BEGIN +{ plan(skip_all => "Extra Tied Filehandle needs Perl 5.6 or better - you have Perl $]" ) if $] < 5.006 ; - + my $tests ; $BadPerl = ($] >= 5.006 and $] <= 5.008) ; @@ -44,10 +44,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data ; $data = $init if defined $init ; @@ -75,7 +75,7 @@ sub run # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -101,7 +101,7 @@ sub run } my $foo = "1234567890"; - + ok syswrite($io, $foo, length($foo)) == length($foo) ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo } @@ -142,17 +142,17 @@ and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + ok ! $io->eof; ok ! eof $io; is $io->tell(), 0 ; @@ -162,11 +162,11 @@ EOT or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; + is $., 6; #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ; is $io->tell(), length($str) ; is tell($io), length($str) ; - + ok $io->eof; ok eof $io; @@ -176,8 +176,8 @@ EOT defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -185,27 +185,27 @@ EOT my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -217,26 +217,26 @@ EOT push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - ok @lines == 3 + + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); ok $io, "opened ok" ; - + #eval { read($io, $buf, -1); } ; #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ; @@ -247,22 +247,22 @@ EOT ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -273,11 +273,11 @@ EOT { title "seek tests" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $first ; ok seek $iow, 10, SEEK_CUR ; is tell($iow), length($first)+10; @@ -305,7 +305,7 @@ EOT { # seek error cases my $b ; - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; ok ! $a->error() ; eval { seek($a, -1, 10) ; }; @@ -318,7 +318,7 @@ EOT close $a ; - my $u = new $UncompressClass(\$b) ; + my $u = $UncompressClass->can('new')->( $UncompressClass, \$b) ; eval { seek($u, -1, 10) ; }; like $@, mkErr("seek: unknown value, 10, for whence parameter"); @@ -333,7 +333,7 @@ EOT { title 'fileno' ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -342,9 +342,9 @@ EOM { my $fh ; - ok $fh = new IO::File ">$name" ; + ok $fh = IO::File->new( ">$name" ); my $x ; - ok $x = new $CompressClass $fh ; + ok $x = $CompressClass->can('new')->( $CompressClass, $fh ); ok $x->fileno() == fileno($fh) ; ok $x->fileno() == fileno($x) ; @@ -356,8 +356,8 @@ EOM my $uncomp; { my $x ; - ok my $fh1 = new IO::File "<$name" ; - ok $x = new $UncompressClass $fh1, -Append => 1 ; + ok my $fh1 = IO::File->new( "<$name" ); + ok $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, -Append => 1 ); ok $x->fileno() == fileno $fh1 ; ok $x->fileno() == fileno $x ; diff --git a/cpan/IO-Compress/t/compress/oneshot.pl b/cpan/IO-Compress/t/compress/oneshot.pl index 790d1b2b0c..7e59fe58ed 100644 --- a/cpan/IO-Compress/t/compress/oneshot.pl +++ b/cpan/IO-Compress/t/compress/oneshot.pl @@ -73,16 +73,16 @@ sub run my $in ; eval { $a = $Func->($in, \$x) ;} ; - like $@, mkErr("^$TopType: input filename is undef or null string"), + like $@, mkErr("^$TopType: input filename is undef or null string"), ' Input filename undef' ; - $in = ''; + $in = ''; eval { $a = $Func->($in, \$x) ;} ; - like $@, mkErr("^$TopType: input filename is undef or null string"), + like $@, mkErr("^$TopType: input filename is undef or null string"), ' Input filename empty' ; { - my $lex1 = new LexFile my $in ; + my $lex1 = LexFile->new( my $in ); writeFile($in, "abc"); my $out = $in ; eval { $a = $Func->($in, $out) ;} ; @@ -92,7 +92,7 @@ sub run { my $dir ; - my $lex = new LexDir $dir ; + my $lex = LexDir->new( $dir ); my $d = quotemeta $dir; $a = $Func->("$dir", \$x) ; @@ -109,7 +109,7 @@ sub run eval { $a = $Func->(\$in, \$in) ;} ; like $@, mkErr("^$TopType: input and output buffer are identical"), ' Input and Output buffer are the same'; - + SKIP: { # Threaded 5.6.x seems to have a problem comparing filehandles. @@ -118,12 +118,12 @@ sub run skip 'Cannot compare filehandles with threaded $]', 2 if $] >= 5.006 && $] < 5.007 && $Config{useithreads}; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open OUT, ">$out_file" ; eval { $a = $Func->(\*OUT, \*OUT) ;} ; like $@, mkErr("^$TopType: input and output handle are identical"), ' Input and Output handle are the same'; - + close OUT; is -s $out_file, 0, " File zero length" ; } @@ -137,12 +137,12 @@ sub run eval { $a = $Func->(\$x, $object) ;} ; like $@, mkErr("^$TopType: illegal output parameter"), ' Bad Output Param'; - + # Buffer not a scalar reference eval { $a = $Func->(\$x, \%x) ;} ; like $@, mkErr("^$TopType: illegal output parameter"), ' Bad Output Param'; - + eval { $a = $Func->(\%x, \$x) ;} ; like $@, mkErr("^$TopType: illegal input parameter"), @@ -159,13 +159,13 @@ sub run $a = $Func->($filename, \$x) ; is $a, undef, " $TopType returned undef"; like $$Error, "/^input file '$filename' does not exist\$/", " input File '$filename' does not exist"; - + $filename = '/tmp/abd/abc.def'; ok ! -e $filename, " output File '$filename' does not exist"; $a = $Func->(\$x, $filename) ; is $a, undef, " $TopType returned undef"; like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), " output File '$filename' does not exist"; - + eval { $a = $Func->(\$x, '<abc>') } ; like $$Error, "/Need input fileglob for outout fileglob/", ' Output fileglob with no input fileglob'; @@ -199,7 +199,7 @@ sub run skip '\\ returns mutable value in 5.19.3', 1 if $] >= 5.019003; - + eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ; like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"), ' TrailingData output not writable'; @@ -335,7 +335,7 @@ sub run { title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ; - my $lex = new LexFile my $in_file ; + my $lex = LexFile->new( my $in_file ); writeFile($in_file, $buffer); my @output = ('first') ; my @input = ($in_file); @@ -350,7 +350,7 @@ sub run { title "$TopType - From Buff to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); @@ -365,11 +365,11 @@ sub run { title "$TopType - From Buff to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $of = new IO::File ">>$out_file" ; + my $of = IO::File->new( ">>$out_file" ); ok $of, " Created output filehandle" ; ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -384,7 +384,7 @@ sub run { title "$TopType - From Filename to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); ok ! -e $out_file, " Output file does not exist"; @@ -402,12 +402,12 @@ sub run { title "$TopType - From Filename to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $out = new IO::File ">>$out_file" ; + my $out = IO::File->new( ">>$out_file" ); ok &$Func($in_file, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -421,7 +421,7 @@ sub run { title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); my $out = $already; @@ -433,18 +433,18 @@ sub run is $got, $buffer, " Uncompressed matches original"; } - + { title "$TopType - From Handle to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - ok &$Func($in, $out_file, Append => $append), ' Compressed ok' + ok &$Func($in, $out_file, Append => $append), ' Compressed ok' or diag "error is $$Error" ; ok -e $out_file, " Created output file"; @@ -457,13 +457,13 @@ sub run { title "$TopType - From Handle to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $out = new IO::File ">>$out_file" ; + my $out = IO::File->new( ">>$out_file" ); ok &$Func($in, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -477,9 +477,9 @@ sub run { title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); my $out = $already ; @@ -494,7 +494,7 @@ sub run { title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); open(SAVEIN, "<&STDIN"); @@ -503,7 +503,7 @@ sub run my $out = $already; - ok &$Func('-', \$out, Append => $append), ' Compressed ok' + ok &$Func('-', \$out, Append => $append), ' Compressed ok' or diag $$Error ; open(STDIN, "<&SAVEIN"); @@ -528,11 +528,11 @@ sub run my $FuncInverse = getTopFuncRef($TopTypeInverse); my $ErrorInverse = getErrorRef($TopTypeInverse); - my $lex = new LexFile(my $file1, my $file2) ; + my $lex = LexFile->new( my $file1, my $file2) ; writeFile($file1, $OriginalContent1); writeFile($file2, $OriginalContent2); - my $of = new IO::File "<$file1" ; + my $of = IO::File->new( "<$file1" ); ok $of, " Created output filehandle" ; #my @input = ( undef, "", $file2, \undef, \'', \"abcde", $of) ; @@ -574,7 +574,7 @@ sub run $of->open("<$file1") ; my $output ; - ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok' + ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok' or diag $$Error; my $got = anyUncompress([ \$output, MultiStream => $ms ]); @@ -587,7 +587,7 @@ sub run { title "$TopType - From Array Ref to Filename, MultiStream $ms" ; - my $lex = new LexFile( my $file3) ; + my $lex = LexFile->new( my $file3) ; # rewind the filehandle $of->open("<$file1") ; @@ -605,9 +605,9 @@ sub run { title "$TopType - From Array Ref to Filehandle, MultiStream $ms" ; - my $lex = new LexFile(my $file3) ; + my $lex = LexFile->new( my $file3) ; - my $fh3 = new IO::File ">$file3"; + my $fh3 = IO::File->new( ">$file3" ); # rewind the filehandle $of->open("<$file1") ; @@ -667,7 +667,7 @@ sub run title 'Round trip binary data that happens to include \r\n' ; - my $lex = new LexFile(my $file1, my $file2, my $file3) ; + my $lex = LexFile->new( my $file1, my $file2, my $file3) ; my $original = join '', map { chr } 0x00 .. 0xff ; $original .= "data1\r\ndata2\r\ndata3\r\n" ; @@ -678,7 +678,7 @@ sub run ok &$Func($file1 => $file2), ' Compressed ok' ; ok &$FuncInverse($file2 => $file3), ' Uncompressed ok' ; is readFile($file3), $original, " round tripped ok"; - + } foreach my $bit ($UncompressClass, @@ -692,7 +692,7 @@ sub run my $C_Func = getTopFuncRef($CompressClass); - + my $data = "mary had a little lamb" ; my $keep = $data ; my $extra = "after the main event"; @@ -705,7 +705,7 @@ sub run skip "zstd doesn't support trailing data", 9 if $CompressClass =~ /zstd/i ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; my $compressed ; @@ -720,7 +720,7 @@ sub run { writeFile($name, $compressed); - $input = new IO::File "<$name" ; + $input = IO::File->new( "<$name" ); } my $trailing; @@ -735,7 +735,7 @@ sub run } is $trailing . $rest, $extra, " Got trailing data"; - + } } @@ -751,10 +751,10 @@ sub run # # my @inFiles = map { "in$_.tmp" } 1..4; # my @outFiles = map { "out$_.tmp" } 1..4; -# my $lex = new LexFile(@inFiles, @outFiles); +# my $lex = LexFile->new( @inFiles, @outFiles); # # writeFile($_, "data $_") foreach @inFiles ; -# +# # { # title "$TopType - Hash Ref: to filename" ; # @@ -791,8 +791,8 @@ sub run # my @buffer ; # my %hash = ( $inFiles[0] => undef, # $inFiles[1] => undef, -# $inFiles[2] => undef, -# ); +# $inFiles[2] => undef, +# ); # # ok &$Func( \%hash ), ' Compressed ok' ; # @@ -845,10 +845,10 @@ sub run # # my @inFiles = map { "in$_.tmp" } 1..4; # my @outFiles = map { "out$_.tmp" } 1..4; -# my $lex = new LexFile(@inFiles, @outFiles); +# my $lex = LexFile->new( @inFiles, @outFiles); # # writeFile($_, "data $_") foreach @inFiles ; -# +# # # # # if (0) @@ -888,7 +888,7 @@ sub run # # title "$TopType - From Array Ref to Filename" ; # # # # my ($file3) = ("file3"); -# # my $lex = new LexFile($file3) ; +# # my $lex = LexFile->new( $file3) ; # # # # # rewind the filehandle # # $of->open("<$file1") ; @@ -906,9 +906,9 @@ sub run # # title "$TopType - From Array Ref to Filehandle" ; # # # # my ($file3) = ("file3"); -# # my $lex = new LexFile($file3) ; +# # my $lex = LexFile->new( $file3) ; # # -# # my $fh3 = new IO::File ">$file3"; +# # my $fh3 = IO::File->new( ">$file3" ); # # # # # rewind the filehandle # # $of->open("<$file1") ; @@ -936,7 +936,7 @@ sub run my $tmpDir1 ; my $tmpDir2 ; - my $lex = new LexDir($tmpDir1, $tmpDir2) ; + my $lex = LexDir->new($tmpDir1, $tmpDir2) ; my $d1 = quotemeta $tmpDir1 ; my $d2 = quotemeta $tmpDir2 ; @@ -951,7 +951,7 @@ sub run { title "$TopType - From FileGlob to FileGlob files [@$files]" ; - ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok' or diag $$Error ; my @copy = @expected; @@ -967,7 +967,7 @@ sub run title "$TopType - From FileGlob to Array files [@$files]" ; my @buffer = ('first') ; - ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok' or diag $$Error ; is shift @buffer, 'first'; @@ -987,8 +987,8 @@ sub run title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ; my $buffer ; - ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, - MultiStream => $ms), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, + MultiStream => $ms), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1003,10 +1003,10 @@ sub run { title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ; - my $lex = new LexFile(my $filename) ; - + my $lex = LexFile->new( my $filename) ; + ok &$Func("<$tmpDir1/a*.tmp>" => $filename, - MultiStream => $ms), ' Compressed ok' + MultiStream => $ms), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1021,11 +1021,11 @@ sub run { title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ; - my $lex = new LexFile(my $filename) ; - my $fh = new IO::File ">$filename"; - - ok &$Func("<$tmpDir1/a*.tmp>" => $fh, - MultiStream => $ms, AutoClose => 1), ' Compressed ok' + my $lex = LexFile->new( my $filename) ; + my $fh = IO::File->new( ">$filename" ); + + ok &$Func("<$tmpDir1/a*.tmp>" => $fh, + MultiStream => $ms, AutoClose => 1), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1050,7 +1050,7 @@ sub run my $TopType = getTopFuncName($bit); my $buffer = $OriginalContent1; - my $buffer2 = $OriginalContent2; + my $buffer2 = $OriginalContent2; my $keep_orig = $buffer; my $comp = compressBuffer($UncompressClass, $buffer) ; @@ -1096,7 +1096,7 @@ sub run { title "$TopType - From Buff to Filename, Append($append)" ; - my $lex = new LexFile(my $out_file) ; + my $lex = LexFile->new( my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else @@ -1114,15 +1114,15 @@ sub run { title "$TopType - From Buff to Handle, Append($append)" ; - my $lex = new LexFile(my $out_file) ; + my $lex = LexFile->new( my $out_file) ; my $of ; if ($append) { writeFile($out_file, $incumbent) ; - $of = new IO::File "+< $out_file" ; + $of = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $of = new IO::File "> $out_file" ; + $of = IO::File->new( "> $out_file" ); } isa_ok $of, 'IO::File', ' $of' ; @@ -1138,7 +1138,7 @@ sub run { title "$TopType - From Filename to Filename, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else @@ -1158,15 +1158,15 @@ sub run { title "$TopType - From Filename to Handle, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; if ($append) { writeFile($out_file, $incumbent) ; - $out = new IO::File "+< $out_file" ; + $out = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $out = new IO::File "> $out_file" ; + $out = IO::File->new( "> $out_file" ); } isa_ok $out, 'IO::File', ' $out' ; @@ -1184,7 +1184,7 @@ sub run { title "$TopType - From Filename to Buffer, Append($append)" ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); my $output ; @@ -1199,14 +1199,14 @@ sub run { title "$TopType - From Handle to Filename, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else { ok ! -e $out_file, " Output file does not exist" } writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, $out_file, Append => $append, @opts), ' Uncompressed ok' ; @@ -1220,20 +1220,20 @@ sub run { title "$TopType - From Handle to Handle, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; if ($append) { writeFile($out_file, $incumbent) ; - $out = new IO::File "+< $out_file" ; + $out = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $out = new IO::File "> $out_file" ; + $out = IO::File->new( "> $out_file" ); } isa_ok $out, 'IO::File', ' $out' ; writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ; @@ -1247,9 +1247,9 @@ sub run { title "$TopType - From Filename to Buffer, Append($append)" ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); my $output ; $output = $incumbent if $append ; @@ -1263,7 +1263,7 @@ sub run { title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); open(SAVEIN, "<&STDIN"); @@ -1273,7 +1273,7 @@ sub run my $output ; $output = $incumbent if $append ; - ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok' + ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok' or diag $$Error ; open(STDIN, "<&SAVEIN"); @@ -1286,14 +1286,14 @@ sub run { title "$TopType - From Handle to Buffer, InputLength" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; my $expected = $buffer ; my $appended = 'appended'; my $len_appended = length $appended; writeFile($in_file, $comp . $appended . $comp . $appended) ; - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ; @@ -1317,7 +1317,7 @@ sub run { title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ; - my $lex = new LexFile my $in_file ; + my $lex = LexFile->new( my $in_file ); my $expected = $buffer ; my $appended = 'appended'; my $len_appended = length $appended; @@ -1329,7 +1329,7 @@ sub run my $output ; - ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' + ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' or diag $$Error ; my $buff ; @@ -1366,12 +1366,12 @@ sub run my $incumbent = "incumbent data" ; - my $lex = new LexFile(my $file1, my $file2) ; + my $lex = LexFile->new( my $file1, my $file2) ; writeFile($file1, compressBuffer($UncompressClass, $OriginalContent1)); writeFile($file2, compressBuffer($UncompressClass, $OriginalContent2)); - my $of = new IO::File "<$file1" ; + my $of = IO::File->new( "<$file1" ); ok $of, " Created output filehandle" ; #my @input = ($file2, \$undef, \$null, \$comp, $of) ; @@ -1393,7 +1393,7 @@ sub run { title "$TopType - From ArrayRef to Filename" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); $of->open("<$file1") ; ok &$Func(\@input, $output, AutoClose => 0, @opts), ' UnCompressed ok' ; @@ -1404,8 +1404,8 @@ sub run { title "$TopType - From ArrayRef to Filehandle" ; - my $lex = new LexFile my $output; - my $fh = new IO::File ">$output" ; + my $lex = LexFile->new( my $output ); + my $fh = IO::File->new( ">$output" ); $of->open("<$file1") ; ok &$Func(\@input, $fh, AutoClose => 0, @opts), ' UnCompressed ok' ; @@ -1422,8 +1422,8 @@ sub run ok &$Func(\@input, \@output, AutoClose => 0, @opts), ' UnCompressed ok' ; is_deeply \@input, \@keep, " Input array not changed" ; - is_deeply [map { defined $$_ ? $$_ : "" } @output], - ['first', @expected], + is_deeply [map { defined $$_ ? $$_ : "" } @output], + ['first', @expected], " Got Expected uncompressed data"; } @@ -1441,7 +1441,7 @@ sub run my $tmpDir1 ; my $tmpDir2 ; - my $lex = new LexDir($tmpDir1, $tmpDir2) ; + my $lex = LexDir->new($tmpDir1, $tmpDir2) ; my $d1 = quotemeta $tmpDir1 ; my $d2 = quotemeta $tmpDir2 ; @@ -1460,7 +1460,7 @@ sub run { title "$TopType - From FileGlob to FileGlob" ; - ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok' or diag $$Error ; my @copy = @expected; @@ -1476,7 +1476,7 @@ sub run title "$TopType - From FileGlob to Arrayref" ; my @output = (\'first'); - ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok' or diag $$Error ; my @copy = ('first', @expected); @@ -1492,7 +1492,7 @@ sub run title "$TopType - From FileGlob to Buffer" ; my $output ; - ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok' or diag $$Error ; is $output, join('', @expected), " got expected uncompressed data"; @@ -1501,9 +1501,9 @@ sub run { title "$TopType - From FileGlob to Filename" ; - my $lex = new LexFile my $output ; + my $lex = LexFile->new( my $output ); ok ! -e $output, " $output does not exist" ; - ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok' or diag $$Error ; ok -e $output, " $output does exist" ; @@ -1513,9 +1513,9 @@ sub run { title "$TopType - From FileGlob to Filehandle" ; - my $lex = new LexFile my $output ; - my $fh = new IO::File ">$output" ; - ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' + my $lex = LexFile->new( my $output ); + my $fh = IO::File->new( ">$output" ); + ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' or diag $$Error ; ok -e $output, " $output does exist" ; @@ -1534,7 +1534,7 @@ sub run title "More write tests" ; - my $lex = new LexFile(my $file1, my $file2, my $file3) ; + my $lex = LexFile->new( my $file1, my $file2, my $file3) ; writeFile($file1, "F1"); writeFile($file2, "F2"); @@ -1551,9 +1551,9 @@ sub run # { # my ($send, $get) = @$data ; # -# my $fh1 = new IO::File "< $file1" ; -# my $fh2 = new IO::File "< $file2" ; -# my $fh3 = new IO::File "< $file3" ; +# my $fh1 = IO::File->new( "< $file1" ); +# my $fh2 = IO::File->new( "< $file2" ); +# my $fh3 = IO::File->new( "< $file3" ); # # title "$send"; # my ($copy); @@ -1587,9 +1587,9 @@ sub run { my ($send, $get) = @$data ; - my $fh1 = new IO::File "< $file1" ; - my $fh2 = new IO::File "< $file2" ; - my $fh3 = new IO::File "< $file3" ; + my $fh1 = IO::File->new( "< $file1" ); + my $fh2 = IO::File->new( "< $file2" ); + my $fh3 = IO::File->new( "< $file3" ); title "$send"; my($copy); @@ -1604,8 +1604,8 @@ sub run } @data = ( - '[""]', - '[undef]', + '[""]', + '[undef]', ) ; @@ -1616,7 +1616,7 @@ sub run eval "\$copy = $send"; my $Answer ; eval { &$Func($copy, \$Answer) } ; - like $@, mkErr("^$TopFuncName: input filename is undef or null string"), + like $@, mkErr("^$TopFuncName: input filename is undef or null string"), " got error message"; } @@ -1624,11 +1624,11 @@ sub run { - # check setting $\ + # check setting $\ my $CompFunc = getTopFuncRef($CompressClass); my $UncompFunc = getTopFuncRef($UncompressClass); - my $lex = new LexFile my $file ; + my $lex = LexFile->new( my $file ); local $\ = "\n" ; my $input = "hello world"; @@ -1664,7 +1664,7 @@ sub run is $output, $input, "round trip ok" ; } - + } # TODO add more error cases diff --git a/cpan/IO-Compress/t/compress/prime.pl b/cpan/IO-Compress/t/compress/prime.pl index cae424c7ae..2b0af2835d 100644 --- a/cpan/IO-Compress/t/compress/prime.pl +++ b/cpan/IO-Compress/t/compress/prime.pl @@ -13,7 +13,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available $extra = 0 ; $extra = 1 @@ -54,11 +54,11 @@ EOM for my $useBuf (0 .. 1) { print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ; - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my $prime = substr($compressed, 0, $i); my $rest = substr($compressed, $i); - + my $start ; if ($useBuf) { $start = \$rest ; @@ -68,20 +68,20 @@ EOM writeFile($name, $rest); } - #my $gz = new $UncompressClass $name, - my $gz = new $UncompressClass $start, + #my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $start, -Append => 1, -BlockSize => $blocksize, -Prime => $prime, -Transparent => 0 - ; + ); ok $gz; ok ! $gz->error() ; my $un ; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; is $status, 0 ; - ok ! $gz->error() + ok ! $gz->error() or print "Error is '" . $gz->error() . "'\n"; is $un, $hello ; ok $gz->eof() ; @@ -90,5 +90,5 @@ EOM } } } - + 1; diff --git a/cpan/IO-Compress/t/compress/tied.pl b/cpan/IO-Compress/t/compress/tied.pl index 4552e1733a..98f9dcc481 100644 --- a/cpan/IO-Compress/t/compress/tied.pl +++ b/cpan/IO-Compress/t/compress/tied.pl @@ -8,9 +8,9 @@ use Test::More ; use CompTestUtils; our ($BadPerl, $UncompressClass); - -BEGIN -{ + +BEGIN +{ plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" ) if $] < 5.005 ; @@ -32,10 +32,10 @@ BEGIN plan tests => $tests + $extra ; } - - + + use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); - + sub myGZreadFile @@ -44,10 +44,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data ; $data = $init if defined $init ; @@ -71,9 +71,9 @@ sub run title "Testing $CompressClass"; - + my $x ; - my $gz = new $CompressClass(\$x); + my $gz = $CompressClass->can('new')->( $CompressClass, \$x); my $buff ; @@ -95,12 +95,12 @@ sub run title "Testing $UncompressClass"; my $gc ; - my $guz = new $CompressClass(\$gc); + my $guz = $CompressClass->can('new')->( $CompressClass, \$gc); $guz->write("abc") ; $guz->close(); my $x ; - my $gz = new $UncompressClass(\$gc); + my $gz = $UncompressClass->can('new')->( $UncompressClass, \$gc); my $buff ; @@ -125,7 +125,7 @@ sub run # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -148,7 +148,7 @@ sub run } my $foo = "1234567890"; - + ok syswrite($io, $foo, length($foo)) == length($foo) ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo } @@ -188,17 +188,17 @@ and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + ok ! $io->eof, " Not EOF"; is $io->tell(), 0, " Tell is 0" ; my @lines = <$io>; @@ -206,9 +206,9 @@ EOT or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; + is $., 6; is $io->tell(), length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -217,8 +217,8 @@ EOT defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -226,27 +226,27 @@ EOT my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -258,24 +258,24 @@ EOT push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - ok @lines == 3 + + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + if (! $BadPerl) { eval { read($io, $buf, -1) } ; @@ -286,22 +286,22 @@ EOT ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -319,24 +319,24 @@ and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $str); my @tmp; my $buf; { - my $io = new $UncompressClass $name, -Transparent => 1 ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 ); + ok defined $io; ok ! $io->eof; ok $io->tell() == 0 ; my @lines = <$io>; - ok @lines == 6; + ok @lines == 6; ok $lines[1] eq "of a paragraph\n" ; ok join('', @lines) eq $str ; - ok $. == 6; + ok $. == 6; ok $io->tell() == length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -345,8 +345,8 @@ EOT defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -354,27 +354,27 @@ EOT my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# [$lines[0]]\n" ; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -386,40 +386,40 @@ EOT push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - + ok @lines == 3 ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i"; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -450,24 +450,24 @@ EOT { title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); if ($trans) { writeFile($name, $str) ; } else { - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; } - - my $io = $UncompressClass->new($name, + + my $io = $UncompressClass->new($name, -Append => $append, -Transparent => $trans); - + my $buf; - + is $io->tell(), 0; if ($append) { diff --git a/cpan/IO-Compress/t/compress/truncate.pl b/cpan/IO-Compress/t/compress/truncate.pl index 24fe176ce8..555114dba7 100644 --- a/cpan/IO-Compress/t/compress/truncate.pl +++ b/cpan/IO-Compress/t/compress/truncate.pl @@ -13,7 +13,7 @@ sub run my $UncompressClass = getInverse($CompressClass); my $Error = getErrorRef($CompressClass); my $UnError = getErrorRef($UncompressClass); - + # my $hello = <<EOM ; #hello world #this is a test @@ -23,7 +23,7 @@ sub run # ASCII hex equivalent of the text above. This makes the test # harness behave identically on an EBCDIC platform. - my $hello = + my $hello = "\x68\x65\x6c\x6c\x6f\x20\x77\x6f\x72\x6c\x64\x0a\x74\x68\x69\x73" . "\x20\x69\x73\x20\x61\x20\x74\x65\x73\x74\x0a\x73\x6f\x6d\x65\x20" . "\x6d\x6f\x72\x65\x20\x73\x74\x75\x66\x66\x20\x6f\x6e\x20\x74\x68" . @@ -52,9 +52,9 @@ sub run foreach my $i (1 .. $fingerprint_size-1) { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + title "Fingerprint Truncation - length $i, Transparent $trans"; my $part = substr($compressed, 0, $i); @@ -68,9 +68,9 @@ sub run $input = \$part; } - my $gz = new $UncompressClass $input, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); if ($trans) { ok $gz; ok ! $gz->error() ; @@ -92,9 +92,9 @@ sub run # foreach my $i ($fingerprint_size .. $header_size -1) { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + title "Header Truncation - length $i, Source $fb, Transparent $trans"; my $part = substr($compressed, 0, $i); @@ -107,10 +107,10 @@ sub run { $input = \$part; } - - ok ! defined new $UncompressClass $input, + + ok ! defined $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); #ok $gz->eof() ; } @@ -118,15 +118,15 @@ sub run # In this case the uncompression object will have been created, # so need to check that subsequent reads from the object fail if ($header_size > 0) - { + { for my $mode (qw(block line para record slurp)) { title "Corruption after header - Mode $mode, Source $fb, Transparent $trans"; - - my $lex = new LexFile my $name ; + + my $lex = LexFile->new( my $name ); my $input; - + my $part = substr($compressed, 0, $header_size); # Append corrupt data $part .= "\xFF" x 100 ; @@ -139,11 +139,11 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -Strict => 1, -BlockSize => $blocksize, - -Transparent => $trans + -Transparent => $trans ) or diag $$UnError; my $un ; @@ -184,19 +184,19 @@ sub run } # Back to truncation tests - + foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) { next if $i == 0 ; - + for my $mode (qw(block line)) { title "Compressed Data Truncation - length $i, MOde $mode, Source $fb, Transparent $trans"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + my $part = substr($compressed, 0, $i); if ($fb eq 'filehandle') { @@ -207,11 +207,11 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -Strict => 1, -BlockSize => $blocksize, - -Transparent => $trans + -Transparent => $trans ) or diag $$UnError; my $un ; @@ -227,12 +227,12 @@ sub run } ok $gz->error() ; cmp_ok $gz->errorNo(), '<', 0 ; - # ok $gz->eof() + # ok $gz->eof() # or die "EOF"; $gz->close(); } } - + # RawDeflate and Zstandard do not have a trailer next if $CompressClass eq 'IO::Compress::RawDeflate' ; next if $CompressClass eq 'IO::Compress::Zstd' ; @@ -242,9 +242,9 @@ sub run { foreach my $lax (0, 1) { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ; my $part = substr($compressed, 0, $i); if ($fb eq 'filehandle') @@ -256,12 +256,12 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, -Strict => !$lax, - -Append => 1, - -Transparent => $trans; + -Append => 1, + -Transparent => $trans ); my $un = ''; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; @@ -269,7 +269,7 @@ sub run if ($lax) { is $un, $hello; - is $status, 0 + is $status, 0 or diag "Status $status Error is " . $gz->error() ; ok $gz->eof() or diag "Status $status Error is " . $gz->error() ; @@ -277,13 +277,13 @@ sub run } else { - cmp_ok $status, "<", 0 + cmp_ok $status, "<", 0 or diag "Status $status Error is " . $gz->error() ; ok $gz->eof() or diag "Status $status Error is " . $gz->error() ; ok $gz->error() ; } - + $gz->close(); } } @@ -292,4 +292,3 @@ sub run } 1; - diff --git a/cpan/IO-Compress/t/compress/zlib-generic.pl b/cpan/IO-Compress/t/compress/zlib-generic.pl index 94e5da9f72..5c4e3fc821 100644 --- a/cpan/IO-Compress/t/compress/zlib-generic.pl +++ b/cpan/IO-Compress/t/compress/zlib-generic.pl @@ -6,8 +6,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -32,10 +32,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -65,7 +65,7 @@ sub myGZreadFile title "flush" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -74,7 +74,7 @@ EOM { my $x ; - ok $x = new $CompressClass $name ; + ok $x = $CompressClass->can('new')->( $CompressClass, $name ); ok $x->write($hello), "write" ; ok $x->flush(Z_FINISH), "flush"; @@ -83,7 +83,7 @@ EOM { my $uncomp; - ok my $x = new $UncompressClass $name, -Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1 ); my $len ; 1 while ($len = $x->read($uncomp)) > 0 ; @@ -104,16 +104,16 @@ EOM my $buffer = ''; { my $x ; - ok $x = new $CompressClass(\$buffer) ; + ok $x = $CompressClass->can('new')->( $CompressClass, \$buffer); ok $x->close ; - + } my $keep = $buffer ; my $uncomp= ''; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; 1 while $x->read($uncomp) > 0 ; @@ -125,21 +125,21 @@ EOM } - + { title "inflateSync on plain file"; my $hello = "I am a HAL 9000 computer" x 2001 ; - my $k = new $UncompressClass(\$hello, Transparent => 1); + my $k = $UncompressClass->can('new')->( $UncompressClass, \$hello, Transparent => 1); ok $k ; - + # Skip to the flush point -- no-op for plain file my $status = $k->inflateSync(); - is $status, 1 + is $status, 1 or diag $k->error() ; - - my $rest; + + my $rest; is $k->read($rest, length($hello)), length($hello) or diag $k->error() ; ok $rest eq $hello ; @@ -156,23 +156,23 @@ EOM my $goodbye = "Will I dream?" x 2010; my ($x, $err, $answer, $X, $Z, $status); my $Answer ; - - ok ($x = new $CompressClass(\$Answer)); + + ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); ok $x ; - + is $x->write($hello), length($hello); - + # create a flush point ok $x->flush(Z_FULL_FLUSH) ; - + is $x->write($goodbye), length($goodbye); - + ok $x->close() ; - + my $k; - $k = new $UncompressClass(\$Answer, BlockSize => 1); + $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); ok $k ; - + my $initial; is $k->read($initial, 1), 1 ; is $initial, substr($hello, 0, 1); @@ -181,9 +181,9 @@ EOM $status = $k->inflateSync(); is $status, 1, " inflateSync returned 1" or diag $k->error() ; - - my $rest; - is $k->read($rest, length($hello) + length($goodbye)), + + my $rest; + is $k->read($rest, length($hello) + length($goodbye)), length($goodbye) or diag $k->error() ; ok $rest eq $goodbye, " got expected output" ; @@ -199,26 +199,26 @@ EOM my $hello = "I am a HAL 9000 computer" x 2001 ; my ($x, $err, $answer, $X, $Z, $status); my $Answer ; - - ok ($x = new $CompressClass(\$Answer)); + + ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); ok $x ; - + is $x->write($hello), length($hello); - + ok $x->close() ; - - my $k = new $UncompressClass(\$Answer, BlockSize => 1); + + my $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); ok $k ; - + my $initial; is $k->read($initial, 1), 1 ; is $initial, substr($hello, 0, 1); # Skip to the flush point $status = $k->inflateSync(); - is $status, 0 + is $status, 0 or diag $k->error() ; - + ok $k->close(); is $k->inflateSync(), 0 ; } @@ -227,7 +227,3 @@ EOM 1; - - - - diff --git a/cpan/IO-Compress/t/cz-01version.t b/cpan/IO-Compress/t/cz-01version.t index ff10f32b10..12574aa91c 100644 --- a/cpan/IO-Compress/t/cz-01version.t +++ b/cpan/IO-Compress/t/cz-01version.t @@ -11,8 +11,8 @@ use warnings ; use Test::More ; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -20,13 +20,13 @@ BEGIN plan tests => 2 + $extra ; - use_ok('Compress::Zlib', 2) ; + use_ok('Compress::Zlib', 2) ; } # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; my $zlib_h = ZLIB_VERSION ; my $libz = Compress::Zlib::zlib_version; @@ -35,10 +35,10 @@ SKIP: { or diag <<EOM; The version of zlib.h does not match the version of libz - + You have zlib.h version $zlib_h and libz version $libz - + You probably have two versions of zlib installed on your system. Try removing the one you don't want to use and rebuild. EOM diff --git a/cpan/IO-Compress/t/cz-03zlib-v1.t b/cpan/IO-Compress/t/cz-03zlib-v1.t index a85ed10e27..9b75f9b239 100644 --- a/cpan/IO-Compress/t/cz-03zlib-v1.t +++ b/cpan/IO-Compress/t/cz-03zlib-v1.t @@ -14,8 +14,8 @@ use Test::More ; use CompTestUtils; use Symbol; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -48,7 +48,7 @@ my $len = length $hello ; # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; @@ -145,11 +145,11 @@ ok !defined uncompress (\$compr) ; $hello = "I am a HAL 9000 computer" ; my @hello = split('', $hello) ; my ($err, $X, $status); - + ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; ok $x ; ok $err == Z_OK ; - + my $Answer = ''; foreach (@hello) { @@ -158,20 +158,20 @@ foreach (@hello) $Answer .= $X ; } - + ok $status == Z_OK ; ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - - + + my @Answer = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; ok $k ; ok $err == Z_OK ; - + my $GOT = ''; my $Z; foreach (@Answer) @@ -179,9 +179,9 @@ foreach (@Answer) ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; @@ -190,11 +190,11 @@ title 'deflate/inflate - small buffer with a number'; # ============================== $hello = 6529 ; - + ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; ok $x ; ok $err == Z_OK ; - + ok !defined $x->msg() ; ok $x->total_in() == 0 ; ok $x->total_out() == 0 ; @@ -204,19 +204,19 @@ $Answer = ''; $Answer .= $X ; } - + ok $status == Z_OK ; ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + ok !defined $x->msg() ; ok $x->total_in() == length $hello ; ok $x->total_out() == length $Answer ; - + @Answer = split('', $Answer) ; - + ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; ok $k ; ok $err == Z_OK ; @@ -224,16 +224,16 @@ ok $err == Z_OK ; ok !defined $k->msg() ; ok $k->total_in() == 0 ; ok $k->total_out() == 0 ; - + $GOT = ''; foreach (@Answer) { ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; @@ -242,27 +242,27 @@ is $k->total_in(), length $Answer ; ok $k->total_out() == length $hello ; - + title 'deflate/inflate - larger buffer'; # ============================== ok $x = deflateInit() ; - + ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ; my $Y = $X ; - - + + ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; $Y .= $X ; - - - + + + ok $k = inflateInit() ; - + ($Z, $status) = $k->inflate($Y) ; - + ok $status == Z_STREAM_END ; ok $contents eq $Z ; @@ -272,7 +272,7 @@ title 'deflate/inflate - preset dictionary'; my $dictionary = "hello" ; ok $x = deflateInit({-Level => Z_BEST_COMPRESSION, -Dictionary => $dictionary}) ; - + my $dictID = $x->dict_adler() ; ($X, $status) = $x->deflate($hello) ; @@ -281,9 +281,9 @@ ok $status == Z_OK ; ok $status == Z_OK ; $X .= $Y ; $x = 0 ; - + ok $k = inflateInit(-Dictionary => $dictionary) ; - + ($Z, $status) = $k->inflate($X); ok $status == Z_STREAM_END ; ok $k->dict_adler() == $dictID; @@ -296,7 +296,7 @@ ok $hello eq $Z ; #print "status=[$status] hello=[$hello] Z=[$Z]\n"; #} #ok $status == Z_STREAM_END ; -#ok $hello eq $Z +#ok $hello eq $Z # or print "status=[$status] hello=[$hello] Z=[$Z]\n"; @@ -306,19 +306,19 @@ ok $hello eq $Z ; title 'inflate - check remaining buffer after Z_STREAM_END'; # =================================================== - + { ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ; - + ($X, $status) = $x->deflate($hello) ; ok $status == Z_OK ; ($Y, $status) = $x->flush() ; ok $status == Z_OK ; $X .= $Y ; $x = 0 ; - + ok $k = inflateInit() ; - + my $first = substr($X, 0, 2) ; my $last = substr($X, 2) ; ($Z, $status) = $k->inflate($first); @@ -337,9 +337,9 @@ title 'inflate - check remaining buffer after Z_STREAM_END'; title 'memGzip & memGunzip'; { my ($name, $name1, $name2, $name3); - my $lex = new LexFile $name, $name1, $name2, $name3 ; + my $lex = LexFile->new( $name, $name1, $name2, $name3 ); my $buffer = <<EOM; -some sample +some sample text EOM @@ -361,14 +361,14 @@ EOM # uncompress with gzopen ok my $fil = gzopen($name, "rb") ; - + is $fil->gzread($uncomp, 0), 0 ; ok (($x = $fil->gzread($uncomp)) == $len) ; - + ok ! $fil->gzclose ; ok $uncomp eq $buffer ; - + #1 while unlink $name ; # now check that memGunzip can deal with it. @@ -376,10 +376,10 @@ EOM ok defined $ungzip ; ok $buffer eq $ungzip ; is $gzerrno, 0; - - # now do the same but use a reference - $dest = memGzip(\$buffer) ; + # now do the same but use a reference + + $dest = memGzip(\$buffer) ; ok length $dest ; is $gzerrno, 0; @@ -391,13 +391,13 @@ EOM # uncompress with gzopen ok $fil = gzopen($name1, "rb") ; - + ok (($x = $fil->gzread($uncomp)) == $len) ; - + ok ! $fil->gzclose ; ok $uncomp eq $buffer ; - + # now check that memGunzip can deal with it. my $keep = $dest; $ungzip = memGunzip(\$dest) ; @@ -459,7 +459,7 @@ EOM ok ! defined $ungzip ; cmp_ok $gzerrno, "==", Z_DATA_ERROR ; - + #1 while unlink $name ; # check corrupt header -- too short @@ -520,7 +520,7 @@ EOM { title "Check all bytes can be handled"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data = join '', map { chr } 0x00 .. 0xFF; $data .= "\r\nabd\r\n"; @@ -548,7 +548,7 @@ title 'memGunzip with a gzopen created file'; { my $name = "test.gz" ; my $buffer = <<EOM; -some sample +some sample text EOM @@ -572,50 +572,50 @@ EOM # Check - MAX_WBITS # ================= - + $hello = "Test test test test test"; @hello = split('', $hello) ; - + ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ; ok $x ; ok $err == Z_OK ; - + $Answer = ''; foreach (@hello) { ($X, $status) = $x->deflate($_) ; last unless $status == Z_OK ; - + $Answer .= $X ; } - + ok $status == Z_OK ; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - - + + @Answer = split('', $Answer) ; - # Undocumented corner -- extra byte needed to get inflate to return - # Z_STREAM_END when done. - push @Answer, " " ; - + # Undocumented corner -- extra byte needed to get inflate to return + # Z_STREAM_END when done. + push @Answer, " " ; + ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ; ok $k ; ok $err == Z_OK ; - + $GOT = ''; foreach (@Answer) { ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; - + } { @@ -626,32 +626,32 @@ EOM my $hello = "I am a HAL 9000 computer" x 2001 ; my $goodbye = "Will I dream?" x 2010; my ($err, $answer, $X, $status, $Answer); - + ok (($x, $err) = deflateInit() ) ; ok $x ; ok $err == Z_OK ; - + ($Answer, $status) = $x->deflate($hello) ; ok $status == Z_OK ; - + # create a flush point ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ; $Answer .= $X ; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + my ($first, @Answer) = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($first) ; ok $status == Z_OK ; @@ -661,11 +661,11 @@ EOM my $byte = shift @Answer; $status = $k->inflateSync($byte) ; last unless $status == Z_DATA_ERROR; - + } ok $status == Z_OK; - + my $GOT = ''; my $Z = ''; foreach (@Answer) @@ -675,9 +675,9 @@ EOM $GOT .= $Z if defined $Z ; # print "x $status\n"; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ; ok $GOT eq $goodbye ; @@ -687,19 +687,19 @@ EOM $Answer =~ /^(.)(.*)$/ ; my ($initial, $rest) = ($1, $2); - + ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($initial) ; ok $status == Z_OK ; $status = $k->inflateSync($rest) ; ok $status == Z_OK; - + ($GOT, $status) = $k->inflate($rest) ; - + ok $status == Z_DATA_ERROR ; ok $Z . $GOT eq $goodbye ; } @@ -710,7 +710,7 @@ EOM my $hello = "I am a HAL 9000 computer" x 2001 ; my $goodbye = "Will I dream?" x 2010; my ($input, $err, $answer, $X, $status, $Answer); - + ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION, -Strategy => Z_DEFAULT_STRATEGY) ) ; ok $x ; @@ -718,11 +718,11 @@ EOM ok $x->get_Level() == Z_BEST_COMPRESSION; ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; - + ($Answer, $status) = $x->deflate($hello) ; ok $status == Z_OK ; $input .= $hello; - + # error cases eval { $x->deflateParams() }; #like $@, mkErr("^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy"); @@ -736,56 +736,56 @@ EOM ok $x->get_Level() == Z_BEST_COMPRESSION; ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; - + # change both Level & Strategy $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_BEST_SPEED; ok $x->get_Strategy() == Z_HUFFMAN_ONLY; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - - # change only Level + + # change only Level $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_NO_COMPRESSION; ok $x->get_Strategy() == Z_HUFFMAN_ONLY; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - + # change only Strategy $status = $x->deflateParams(-Strategy => Z_FILTERED) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_NO_COMPRESSION; ok $x->get_Strategy() == Z_FILTERED; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + my ($first, @Answer) = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($Answer) ; - ok $status == Z_STREAM_END + ok $status == Z_STREAM_END or print "# status $status\n"; ok $Z eq $input ; } @@ -840,28 +840,28 @@ if ($] >= 5.005) # test inflate with a substr ok my $x = deflateInit() ; - + ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ; - + my $Y = $X ; - - + + ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; $Y .= $X ; - + my $append = "Appended" ; $Y .= $append ; - + ok $k = inflateInit() ; - + #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ; ($Z, $status) = $k->inflate(substr($Y, 0)) ; - + ok $status == Z_STREAM_END ; ok $contents eq $Z ; is $Y, $append; - + } if ($] >= 5.005) @@ -869,27 +869,27 @@ if ($] >= 5.005) # deflate/inflate in scalar context ok my $x = deflateInit() ; - + my $X = $x->deflate($contents); - + my $Y = $X ; - - + + $X = $x->flush(); $Y .= $X ; - + my $append = "Appended" ; $Y .= $append ; - + ok $k = inflateInit() ; - + $Z = $k->inflate(substr($Y, 0, -1)) ; #$Z = $k->inflate(substr($Y, 0)) ; - + ok $contents eq $Z ; is $Y, $append; - + } { @@ -897,8 +897,8 @@ if ($] >= 5.005) # CRC32 of this data should have the high bit set # value in ascii is ZgRNtjgSUW - my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; - my $expected_crc = 0xCF707A2B ; # 3480255019 + my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; + my $expected_crc = 0xCF707A2B ; # 3480255019 my $crc = crc32($data) ; is $crc, $expected_crc; @@ -912,7 +912,7 @@ if ($] >= 5.005) my $data = "\x6c\x70\x73\x63\x4f\x56\x73\x41\x4a\x69\x55\x66" . "\x4e\x43\x6f\x6d\x6b\x4f\x66\x57\x59\x42\x63\x50" . "\x68\x48\x5a\x5b\x62\x54"; - my $expected_crc = 0xAAD60AC7 ; # 2866154183 + my $expected_crc = 0xAAD60AC7 ; # 2866154183 my $crc = adler32($data) ; is $crc, $expected_crc; } @@ -930,11 +930,11 @@ if ($] >= 5.005) ok length $compressed > 4096 ; ok my $out = memGunzip(\$compressed) ; is $gzerrno, 0; - + ok $contents eq $out ; is length $out, length $contents ; - + } @@ -946,7 +946,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, Append => 1, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -996,8 +996,8 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0, - -ExtraField => "hello" x 10 ; + ok my $x = IO::Compress::Gzip->new( \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0, + -ExtraField => "hello" x 10 ); ok $x->write($string) ; ok $x->close ; @@ -1018,7 +1018,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name; + ok my $x = IO::Compress::Gzip->new( \$truncated, Append => 1, -Name => $Name ); ok $x->write($string) ; ok $x->close ; @@ -1037,7 +1037,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Comment => $Comment ); ok $x->write($string) ; ok $x->close ; @@ -1054,7 +1054,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -1071,19 +1071,19 @@ some text EOM my $buffer ; - ok my $x = new IO::Compress::Gzip \$buffer, + ok my $x = IO::Compress::Gzip->new( \$buffer, -Append => 1, -Strict => 0, -HeaderCRC => 1, -Name => "Fred", -ExtraField => "Extra", - -Comment => 'Comment'; + -Comment => 'Comment' ); ok $x->write($string) ; ok $x->close ; ok defined $buffer ; - ok my $got = memGunzip($buffer) + ok my $got = memGunzip($buffer) or diag "gzerrno is $gzerrno" ; is $got, $string ; is $gzerrno, 0; @@ -1098,7 +1098,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Gzip \$good, Append => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, Append => 1 ); ok $x->write($string) ; ok $x->close ; @@ -1176,7 +1176,7 @@ sub trickle title "Append & MultiStream Tests"; # rt.24041 - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data1 = "the is the first"; my $data2 = "and this is the second"; my $trailing = "some trailing data"; @@ -1185,7 +1185,7 @@ sub trickle title "One file"; $fil = gzopen($name, "wb") ; - ok $fil, "opened first file"; + ok $fil, "opened first file"; is $fil->gzwrite($data1), length $data1, "write data1" ; ok ! $fil->gzclose(), "Closed"; @@ -1194,7 +1194,7 @@ sub trickle title "Two files"; $fil = gzopen($name, "ab") ; - ok $fil, "opened second file"; + ok $fil, "opened second file"; is $fil->gzwrite($data2), length $data2, "write data2" ; ok ! $fil->gzclose(), "Closed"; @@ -1214,12 +1214,12 @@ sub trickle title "gzclose & gzflush return codes"; # rt.29215 - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data1 = "the is some text"; my $status; $fil = gzopen($name, "wb") ; - ok $fil, "opened first file"; + ok $fil, "opened first file"; is $fil->gzwrite($data1), length $data1, "write data1" ; $status = $fil->gzflush(0xfff); ok $status, "flush not ok" ; @@ -1233,17 +1233,17 @@ sub trickle { title "repeated calls to flush - no compression"; - my ($err, $x, $X, $status, $data); - + my ($err, $x, $X, $status, $data); + ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; is $data, "", "no output from second flush"; } @@ -1251,18 +1251,18 @@ sub trickle title "repeated calls to flush - after compression"; my $hello = "I am a HAL 9000 computer" ; - my ($err, $x, $X, $status, $data); - + my ($err, $x, $X, $status, $data); + ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ($data, $status) = $x->deflate($hello) ; cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; - + ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; is $data, "", "no output from second flush"; } diff --git a/cpan/IO-Compress/t/cz-06gzsetp.t b/cpan/IO-Compress/t/cz-06gzsetp.t index b2cc687f5a..e45fa4d8af 100644 --- a/cpan/IO-Compress/t/cz-06gzsetp.t +++ b/cpan/IO-Compress/t/cz-06gzsetp.t @@ -9,10 +9,10 @@ use lib qw(t t/compress); use strict; use warnings; use bytes; - + use Test::More ; use CompTestUtils; - + use Compress::Zlib 2 ; use IO::Compress::Gzip ; @@ -26,9 +26,9 @@ use IO::Uncompress::RawInflate ; our ($extra); - -BEGIN -{ + +BEGIN +{ # use Test::NoWarnings, if available $extra = 0 ; $extra = 1 @@ -43,12 +43,12 @@ plan tests => 51 + $extra ; # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; } - + { # gzsetparams title "Testing gzsetparams"; @@ -59,13 +59,13 @@ SKIP: { my $len_goodbye = length $goodbye; my ($input, $err, $answer, $X, $status, $Answer); - - my $lex = new LexFile my $name ; + + my $lex = LexFile->new( my $name ); ok my $x = gzopen($name, "wb"); $input .= $hello; is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ; - + # Error cases eval { $x->gzsetparams() }; like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)'); @@ -73,14 +73,14 @@ SKIP: { # Change both Level & Strategy $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; cmp_ok $status, '==', Z_OK, "status is Z_OK"; - + $input .= $goodbye; is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ; - + ok ! $x->gzclose, "closed" ; ok my $k = gzopen($name, "rb") ; - + # calling gzsetparams on reading is not allowed. $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ; @@ -116,29 +116,29 @@ foreach my $CompressClass ('IO::Compress::Gzip', #my ($input, $err, $answer, $X, $status, $Answer); my $compressed; - ok my $x = new $CompressClass(\$compressed) ; + ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed) ; my $input .= $hello; is $x->write($hello), $len_hello, "wrote $len_hello bytes" ; - + # Change both Level & Strategy ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok"; $input .= $goodbye; is $x->write($goodbye), $len_goodbye, "wrote $len_goodbye bytes" ; - + ok $x->close, "closed $CompressClass object" ; - my $k = new $UncompressClass(\$compressed); + my $k = $UncompressClass->can('new')->( $UncompressClass, \$compressed); isa_ok $k, $UncompressClass; - + my $len = length $input ; my $uncompressed; - is $k->read($uncompressed, $len), $len + is $k->read($uncompressed, $len), $len or diag "$IO::Uncompress::Gunzip::GunzipError" ; - ok $uncompressed eq $input, "got expected uncompressed data" - or diag("unc len = " . length($uncompressed) . ", input len = " . + 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" ; diff --git a/cpan/IO-Compress/t/cz-08encoding.t b/cpan/IO-Compress/t/cz-08encoding.t index ed5971bc8a..951efa44b5 100644 --- a/cpan/IO-Compress/t/cz-08encoding.t +++ b/cpan/IO-Compress/t/cz-08encoding.t @@ -38,7 +38,7 @@ BEGIN # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; @@ -47,13 +47,13 @@ SKIP: { { title "memGzip" ; # length of this string is 2 characters - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $cs = memGzip(Encode::encode_utf8($s)); # length stored at end of gzip file should be 4 my ($crc, $len) = unpack ("VV", substr($cs, -8, 8)); - + is $len, 4, " length is 4"; } @@ -65,7 +65,7 @@ SKIP: { is memGunzip(my $x = $co), $s, " match uncompressed"; utf8::upgrade($co); - + my $un = memGunzip($co); ok $un, " got uncompressed"; @@ -75,7 +75,7 @@ SKIP: { { title "compress/uncompress"; - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $s_copy = $s ; my $ces = compress(Encode::encode_utf8($s_copy)); @@ -84,21 +84,21 @@ SKIP: { my $un = Encode::decode_utf8(uncompress($ces)); is $un, $s, " decode_utf8 ok"; - + utf8::upgrade($ces); $un = Encode::decode_utf8(uncompress($ces)); is $un, $s, " decode_utf8 ok"; - + } { title "gzopen" ; - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $byte_len = length( Encode::encode_utf8($s) ); my ($uncomp) ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, " wrote $byte_len bytes" ; @@ -131,7 +131,7 @@ SKIP: { eval { uncompress($a) }; like($@, qr/Wide character in uncompress/, " wide characters in uncompress"); - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; eval { $fil->gzwrite($a); } ; @@ -139,4 +139,3 @@ SKIP: { ok ! $fil->gzclose, " gzclose ok" ; } - diff --git a/cpan/IO-Compress/t/cz-14gzopen.t b/cpan/IO-Compress/t/cz-14gzopen.t index 3d6a0626ee..59a4d82bec 100644 --- a/cpan/IO-Compress/t/cz-14gzopen.t +++ b/cpan/IO-Compress/t/cz-14gzopen.t @@ -28,156 +28,156 @@ BEGIN { { SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; # Check zlib_version and ZLIB_VERSION are the same. is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; } } - + { # gzip tests #=========== - + #my $name = "test.gz" ; - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my $hello = <<EOM ; hello world this is a test EOM - my $len = length $hello ; - + my $len = length $hello ; + my ($x, $uncomp) ; - + ok my $fil = gzopen($name, "wb") ; - + is $gzerrno, 0, 'gzerrno is 0'; is $fil->gzerror(), 0, "gzerror() returned 0"; - + is $fil->gztell(), 0, "gztell returned 0"; is $gzerrno, 0, 'gzerrno is 0'; - + is $fil->gzwrite($hello), $len ; is $gzerrno, 0, 'gzerrno is 0'; - + is $fil->gztell(), $len, "gztell returned $len"; is $gzerrno, 0, 'gzerrno is 0'; - + ok ! $fil->gzclose ; - + ok $fil = gzopen($name, "rb") ; - + ok ! $fil->gzeof() ; is $gzerrno, 0, 'gzerrno is 0'; is $fil->gztell(), 0; - - is $fil->gzread($uncomp), $len; - + + is $fil->gzread($uncomp), $len; + is $fil->gztell(), $len; ok $fil->gzeof() ; - + # gzread after eof bahavior - + my $xyz = "123" ; is $fil->gzread($xyz), 0, "gzread returns 0 on eof" ; is $xyz, "", "gzread on eof zaps the output buffer [Match 1,x behavior]" ; - + ok ! $fil->gzclose ; ok $fil->gzeof() ; - + ok $hello eq $uncomp ; } { title 'check that a number can be gzipped'; - my $lex = new LexFile my $name ; - - + my $lex = LexFile->new( my $name ); + + my $number = 7603 ; my $num_len = 4 ; - + ok my $fil = gzopen($name, "wb") ; - + is $gzerrno, 0; - + is $fil->gzwrite($number), $num_len, "gzwrite returned $num_len" ; is $gzerrno, 0, 'gzerrno is 0'; ok ! $fil->gzflush(Z_FINISH) ; - + is $gzerrno, 0, 'gzerrno is 0'; - + ok ! $fil->gzclose ; - + cmp_ok $gzerrno, '==', 0; - + ok $fil = gzopen($name, "rb") ; - + my $uncomp; ok ((my $x = $fil->gzread($uncomp)) == $num_len) ; - + ok $fil->gzerror() == 0 || $fil->gzerror() == Z_STREAM_END; ok $gzerrno == 0 || $gzerrno == Z_STREAM_END; ok $fil->gzeof() ; - + ok ! $fil->gzclose ; ok $fil->gzeof() ; - + ok $gzerrno == 0 or print "# gzerrno is $gzerrno\n" ; - + 1 while unlink $name ; - + ok $number == $uncomp ; ok $number eq $uncomp ; } { title "now a bigger gzip test"; - + my $text = 'text' ; - my $lex = new LexFile my $file ; - - + my $lex = LexFile->new( my $file ); + + ok my $f = gzopen($file, "wb") ; - + # generate a long random string my $contents = '' ; foreach (1 .. 5000) { $contents .= chr int rand 256 } - + my $len = length $contents ; - + is $f->gzwrite($contents), $len ; - + ok ! $f->gzclose ; - + ok $f = gzopen($file, "rb") ; - + ok ! $f->gzeof() ; - + my $uncompressed ; is $f->gzread($uncompressed, $len), $len ; - - is $contents, $uncompressed - - or print "# Length orig $len" . + + is $contents, $uncompressed + + or print "# Length orig $len" . ", Length uncompressed " . length($uncompressed) . "\n" ; - + ok $f->gzeof() ; ok ! $f->gzclose ; - + } { title "gzip - readline tests"; # ====================== - + # first create a small gzipped text file - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my @text = (<<EOM, <<EOM, <<EOM, <<EOM) ; this is line 1 EOM @@ -187,13 +187,13 @@ the line after the previous line EOM the final line EOM - + my $text = join("", @text) ; - + ok my $fil = gzopen($name, "wb") ; is $fil->gzwrite($text), length($text) ; ok ! $fil->gzclose ; - + # now try to read it back in ok $fil = gzopen($name, "rb") ; ok ! $fil->gzeof() ; @@ -204,15 +204,15 @@ EOM is $line, $text[$i] ; ok ! $fil->gzeof() ; } - + # now read the last line ok $fil->gzreadline($line) > 0; is $line, $text[-1] ; ok $fil->gzeof() ; - + # read past the eof is $fil->gzreadline($line), 0; - + ok $fil->gzeof() ; ok ! $fil->gzclose ; ok $fil->gzeof() ; @@ -220,7 +220,7 @@ EOM { title "A text file with a very long line (bigger than the internal buffer)"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ; my $line2 = "second line\n" ; @@ -228,7 +228,7 @@ EOM ok my $fil = gzopen($name, "wb"), " gzopen ok" ; is $fil->gzwrite($text), length $text, " gzwrite ok" ; ok ! $fil->gzclose, " gzclose" ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), " gzopen" ; ok ! $fil->gzeof(), "! eof" ; @@ -236,13 +236,13 @@ EOM my @got = (); my $line; while ($fil->gzreadline($line) > 0) { - $got[$i] = $line ; + $got[$i] = $line ; ++ $i ; } is $i, 2, " looped twice" ; is $got[0], $line1, " got line 1" ; is $got[1], $line2, " hot line 2" ; - + ok $fil->gzeof(), " gzeof" ; ok ! $fil->gzclose, " gzclose" ; ok $fil->gzeof(), " gzeof" ; @@ -250,30 +250,30 @@ EOM { title "a text file which is not terminated by an EOL"; - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + my $line1 = "hello hello, I'm back again\n" ; my $line2 = "there is no end in sight" ; - + my $text = $line1 . $line2 ; ok my $fil = gzopen($name, "wb"), " gzopen" ; is $fil->gzwrite($text), length $text, " gzwrite" ; ok ! $fil->gzclose, " gzclose" ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), " gzopen" ; - my @got = () ; + my @got = () ; my $i = 0 ; my $line; while ($fil->gzreadline($line) > 0) { - $got[$i] = $line ; + $got[$i] = $line ; ++ $i ; } is $i, 2, " got 2 lines" ; is $got[0], $line1, " line 1 ok" ; is $got[1], $line2, " line 2 ok" ; - + ok $fil->gzeof(), " gzeof" ; ok ! $fil->gzclose, " gzclose" ; } @@ -281,23 +281,23 @@ EOM { title 'mix gzread and gzreadline'; - + # case 1: read a line, then a block. The block is # smaller than the internal block used by # gzreadline - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $line1 = "hello hello, I'm back again\n" ; - my $line2 = "abc" x 200 ; + my $line2 = "abc" x 200 ; my $line3 = "def" x 200 ; my $line; - + my $text = $line1 . $line2 . $line3 ; my $fil; ok $fil = gzopen($name, "wb"), ' gzopen for write ok' ; is $fil->gzwrite($text), length $text, ' gzwrite ok' ; is $fil->gztell(), length $text, ' gztell ok' ; ok ! $fil->gzclose, ' gzclose ok' ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), ' gzopen for read ok' ; ok ! $fil->gzeof(), ' !gzeof' ; @@ -319,12 +319,12 @@ EOM { title "Pass gzopen a filehandle - use IO::File" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; - my $f = new IO::File ">$name" ; + my $f = IO::File->new( ">$name" ); ok $f; my $fil; @@ -334,11 +334,11 @@ EOM ok ! $fil->gzclose ; - $f = new IO::File "<$name" ; + $f = IO::File->new( "<$name" ); ok $fil = gzopen($name, "rb") ; my $uncomp; my $x; - ok (($x = $fil->gzread($uncomp)) == $len) + ok (($x = $fil->gzread($uncomp)) == $len) or print "# length $x, expected $len\n" ; ok $fil->gzeof() ; @@ -352,7 +352,7 @@ EOM { title "Pass gzopen a filehandle - use open" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; @@ -389,7 +389,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) title "Pass gzopen a filehandle - use $stdin" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; @@ -397,12 +397,12 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) ok open(SAVEOUT, ">&STDOUT"), " save STDOUT"; my $dummy = fileno SAVEOUT; ok open(STDOUT, ">$name"), " redirect STDOUT" ; - + my $status = 0 ; my $fil = gzopen($stdout, "wb") ; - $status = $fil && + $status = $fil && ($fil->gzwrite($hello) == $len) && ($fil->gzclose == 0) ; @@ -417,7 +417,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) ok $fil = gzopen($stdin, "rb") ; my $uncomp; my $x; - ok (($x = $fil->gzread($uncomp)) == $len) + ok (($x = $fil->gzread($uncomp)) == $len) or print "# length $x, expected $len\n" ; ok $fil->gzeof() ; @@ -433,7 +433,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'test parameters for gzopen'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $fil; @@ -462,7 +462,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'Read operations when opened for writing'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $fil; ok $fil = gzopen($name, "wb"), ' gzopen for writing' ; ok !$fil->gzeof(), ' !eof'; ; @@ -473,7 +473,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'write operations when opened for reading'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $text = "hello" ; my $fil; ok $fil = gzopen($name, "wb"), " gzopen for writing" ; @@ -489,22 +489,22 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) SKIP: { - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if $^O eq 'cygwin'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, "abc"); - chmod 0444, $name + chmod 0444, $name or skip "Cannot create non-writable file", 3 ; - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if -w $name ; ok ! -w $name, " input file not writable"; my $fil = gzopen($name, "wb") ; ok !$fil, " gzopen returns undef" ; - ok $gzerrno, " gzerrno ok" or + ok $gzerrno, " gzerrno ok" or diag " gzerrno $gzerrno\n"; chmod 0777, $name ; @@ -512,14 +512,14 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) SKIP: { - my $lex = new LexFile my $name ; - skip "Cannot create non-readable file", 3 + my $lex = LexFile->new( my $name ); + skip "Cannot create non-readable file", 3 if $^O eq 'cygwin'; writeFile($name, "abc"); chmod 0222, $name ; - skip "Cannot create non-readable file", 3 + skip "Cannot create non-readable file", 3 if -r $name ; ok ! -r $name, " input file not readable"; @@ -536,7 +536,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) title "gzseek" ; my $buff ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; @@ -580,11 +580,11 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { # seek error cases - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); - ok ! $a->gzerror() + ok ! $a->gzerror() or print "# gzerrno is $Compress::Zlib::gzerrno \n" ; eval { $a->gzseek(-1, 10) ; }; like $@, mkErr("gzseek: unknown value, 10, for whence parameter"); @@ -610,7 +610,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title "gzread ver 1.x compat -- the output buffer is always zapped."; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); $a->gzwrite("fred"); @@ -632,7 +632,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzreadline does not support $/'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); my $text = "fred\n"; @@ -656,12 +656,12 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzflush called twice with Z_SYNC_FLUSH - no compression'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $a = gzopen($name, "w"); - + + is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; - is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; } @@ -669,13 +669,13 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzflush called twice - after compression'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $a = gzopen($name, "w"); my $text = "fred\n"; my $len = length $text; is $a->gzwrite($text), length($text), "gzwrite ok"; - + + is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; - is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; } diff --git a/cpan/IO-Compress/t/globmapper.t b/cpan/IO-Compress/t/globmapper.t index 0c60aa6b21..c97beb610a 100644 --- a/cpan/IO-Compress/t/globmapper.t +++ b/cpan/IO-Compress/t/globmapper.t @@ -13,8 +13,8 @@ use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan(skip_all => "File::GlobMapper needs Perl 5.005 or better - you have Perl $]" ) if $] < 5.005 ; @@ -26,7 +26,7 @@ Perl $]" ) plan tests => 68 + $extra ; - use_ok('File::GlobMapper') ; + use_ok('File::GlobMapper') ; } { @@ -36,21 +36,21 @@ Perl $]" ) for my $delim ( qw/ ( ) { } [ ] / ) { - $gm = new File::GlobMapper("${delim}abc", '*.X'); + $gm = File::GlobMapper->new("${delim}abc", '*.X'); ok ! $gm, " new failed" ; - is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", + is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", " catch unmatched $delim"; } for my $delim ( qw/ ( ) [ ] / ) { - $gm = new File::GlobMapper("{${delim}abc}", '*.X'); + $gm = File::GlobMapper->new("{${delim}abc}", '*.X'); ok ! $gm, " new failed" ; - is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", + is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", " catch unmatched $delim inside {}"; } - + } { @@ -58,10 +58,10 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); my $d = quotemeta $tmpDir; - my $gm = new File::GlobMapper("$d/Z*", '*.X'); + my $gm = File::GlobMapper->new("$d/Z*", '*.X'); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -77,12 +77,12 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/ab*.tmp", "*X"); + my $gm = File::GlobMapper->new("$tmpDir/ab*.tmp", "*X"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -106,12 +106,12 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp"); + my $gm = File::GlobMapper->new("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -130,12 +130,12 @@ Perl $]" ) title 'test wildcard mapping of {} in destination'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "*.X"); + my $gm = File::GlobMapper->new("$tmpDir/abc{1,3}.tmp", "*.X"); #diag "Input pattern is $gm->{InputPattern}"; ok $gm, " created GlobMapper object" ; @@ -146,7 +146,7 @@ Perl $]" ) [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmp.X)], ], " got mapping"; - $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X") + $gm = File::GlobMapper->new("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X") or diag $File::GlobMapper::Error ; #diag "Input pattern is $gm->{InputPattern}"; ok $gm, " created GlobMapper object" ; @@ -165,13 +165,13 @@ Perl $]" ) title 'test wildcard mapping of multiple * to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X"); - ok $gm, " created GlobMapper object" + my $gm = File::GlobMapper->new("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X"); + ok $gm, " created GlobMapper object" or diag $File::GlobMapper::Error ; my $map = $gm->getFileMap() ; @@ -187,12 +187,12 @@ Perl $]" ) title 'test wildcard mapping of multiple ? to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X"); + my $gm = File::GlobMapper->new("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -208,12 +208,12 @@ Perl $]" ) title 'test wildcard mapping of multiple ?,* and [] to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #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 = File::GlobMapper->new("$tmpDir/?b[a-z]*.tmp", "$tmpDir/X-#3-#2-#1-X"); ok $gm, " created GlobMapper object" ; #diag "Input pattern is $gm->{InputPattern}"; @@ -230,12 +230,12 @@ Perl $]" ) title 'input glob matches a file multiple times'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch "$tmpDir/abc.tmp"; - my $gm = new File::GlobMapper("$tmpDir/{a*,*c}.tmp", '*.X'); + my $gm = File::GlobMapper->new("$tmpDir/{a*,*c}.tmp", '*.X'); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -253,12 +253,12 @@ Perl $]" ) title 'multiple input files map to one output file'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc def) ; - my $gm = new File::GlobMapper("$tmpDir/*.tmp", "$tmpDir/fred"); + my $gm = File::GlobMapper->new("$tmpDir/*.tmp", "$tmpDir/fred"); ok ! $gm, " did not create GlobMapper object" ; is $File::GlobMapper::Error, 'multiple input files map to one output file', " Error is expected" ; @@ -273,13 +273,13 @@ Perl $]" ) title "globmap" ; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-#2-#1-X"); - ok $map, " got map" + ok $map, " got map" or diag $File::GlobMapper::Error ; is @{ $map }, 3, " returned 3 maps"; @@ -305,4 +305,3 @@ Perl $]" ) # {} and {,} are special cases # {ab*,de*} # {abc,{},{de,f}} => abc {} de f - |