Unrated severityNVD Advisory· Published May 27, 2026· Updated May 27, 2026
CVE-2026-48962
CVE-2026-48962
Description
IO::Compress versions before 2.220 for Perl can execute arbitrary code in File::GlobMapper via an attacker-controlled output glob.
_parseOutputGlob() wraps the caller-supplied output glob string in double quotes and stores it in the parser state; _getFiles() then runs the stored expression through eval STRING. A literal double quote in the output glob closes the dquote wrapper, and the characters that follow are evaluated as Perl.
Arbitrary Perl in the output glob executes at the calling process's privilege.
AI Insight
LLM-synthesized narrative grounded in this CVE's description and references.
Arbitrary Perl code execution via eval in IO::Compress's File::GlobMapper output glob.
Vulnerability
The vulnerability exists in the File::GlobMapper component of the Perl module IO::Compress versions before 2.220. The _parseOutputGlob() function wraps the caller-supplied output glob string in double quotes and stores it in the parser state. Subsequently, _getFiles() runs the stored expression through Perl's eval STRING. If an attacker controls the output glob string and includes a literal double quote, they can close the injected double-quote wrapper and inject arbitrary Perl code that will be evaluated [1].
Exploitation
An attacker needs to supply a crafted output glob string to File::GlobMapper, for example when using glob mapping in a script that uses IO::Compress. The attacker does not require network access unless the glob string is provided externally. The exploit requires no authentication beyond having the ability to pass the malicious string to the affected code path. The injection occurs when _getFiles() evaluates $self->{OutputPattern} via eval; a double quote in the string escapes the wrapper, and the following characters are executed as Perl code [2].
Impact
Successful exploitation allows arbitrary Perl code execution at the privilege level of the calling process. This can lead to full compromise of the application or system, including data exfiltration, file manipulation, or lateral movement [1].
Mitigation
The fix was released in IO::Compress version 2.220 on 16 May 2026, which removes the use of eval in File::GlobMapper by implementing a safer escaping mechanism [1][2]. Users should upgrade to version 2.220 or later. No known workarounds exist for earlier versions; the only mitigation is to update the module. The vulnerability is not listed on CISA's Known Exploited Vulnerabilities (KEV) catalog at this time.
References
AI Insight generated on May 27, 2026. Synthesized from this CVE's description and the cited reference URLs; citations are validated against the source bundle.
Affected products
2(expand)+ 1 more
- (no CPE)
- (no CPE)range: <2.220
Patches
9f2db247bf90dremove use of eval in globmapper. #73
2 files changed · +94 −10
lib/File/GlobMapper.pm+43 −9 modified@@ -29,6 +29,11 @@ our ($VERSION, @EXPORT_OK); $VERSION = '1.001'; @EXPORT_OK = qw( globmap ); +our $BEGIN_DELIM = "\xFF"; +our $END_DELIM = "\xFE"; +our $BACKSLASH_ESC = "\xFD"; +our $HASH_ESC = "\xFC"; +our $STAR_ESC = "\xFB"; our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); $noPreBS = '(?<!\\\)' ; # no preceding backslash @@ -310,14 +315,23 @@ sub _parseOutputGlob } my $noPreBS = '(?<!\\\)' ; # no preceding backslash - #warn "noPreBS = '$noPreBS'\n"; + my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash - #$string =~ s/${noPreBS}\$(\d)/\${$1}/g; - $string =~ s/${noPreBS}#(\d)/\${$1}/g; - $string =~ s#${noPreBS}\*#\${inFile}#g; - $string = '"' . $string . '"'; + # escape any use of the delimiter symbols + # $string =~ s/(${BEGIN_DELIM}|${END_DELIM}|${BACKSLASH_ESC})/$1$1/g; + + # escape \# and \* + $string =~ s/\\#/${HASH_ESC}/g; + $string =~ s/\\\*/${STAR_ESC}/g; + + # Transform "#3" to BEGIN_DELIM 3 END_DELIM + $string =~ s/${noPreESC}#(\d)/${BEGIN_DELIM}${1}${END_DELIM}/g; + + $string =~ s#\*#${BEGIN_DELIM}${END_DELIM}#g; + + # print "INPUT '$self->{InputPattern}'\n"; + # print "OUTPUT '$self->{OutputGlob}' => '$string'\n"; - #print "OUTPUT '$self->{OutputGlob}' => '$string'\n"; $self->{OutputPattern} = $string ; return 1 ; @@ -335,11 +349,31 @@ sub _getFiles next if $inFiles{$inFile} ++ ; my $outFile = $inFile ; + my @matches ; + + my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash - if ( $inFile =~ m/$self->{InputPattern}/ ) + if (@matches = ($inFile =~ m/$self->{InputPattern}/ )) { - no warnings 'uninitialized'; - eval "\$outFile = $self->{OutputPattern};" ; + $outFile = $self->{OutputPattern}; + my $ix = 1; + + # get the filename glob + $outFile =~ s/${noPreESC}${BEGIN_DELIM}${END_DELIM}/$inFile/g; + + # now each of the #1, #2,... + for my $pattern (@matches) + { + $outFile =~ s/${noPreESC}${BEGIN_DELIM}${ix}${END_DELIM}/$pattern/g; + + ++ $ix; + } + + # unescape + $outFile =~ s/${BEGIN_DELIM}${BEGIN_DELIM}/${BEGIN_DELIM}/g; + $outFile =~ s/${END_DELIM}${END_DELIM}/${END_DELIM}/g; + $outFile =~ s/${HASH_ESC}/#/g; + $outFile =~ s/${STAR_ESC}/*/g; if (defined $outInMapping{$outFile}) {
t/globmapper.t+51 −1 modified@@ -24,7 +24,7 @@ Perl $]" ) $extra = 1 if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; - plan tests => 68 + $extra ; + plan tests => 76 + $extra ; use_ok('File::GlobMapper') ; } @@ -290,6 +290,56 @@ Perl $]" ) ], " got mapping"; } +{ + title "check escaping"; + + my $tmpDir ;#= 'td'; + my $lex = LexDir->new( $tmpDir ); + + my $BEGIN_DELIM = "\xFF"; + my $END_DELIM = "\xFE"; + + #mkdir $tmpDir, 0777 ; + + touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; + + my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-${BEGIN_DELIM}#2-#1${END_DELIM}-X"); + ok $map, " got map" + or diag $File::GlobMapper::Error ; + + is @{ $map }, 3, " returned 3 maps"; + is_deeply $map, + [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-${BEGIN_DELIM}c1-a${END_DELIM}-X")], + [map { "$tmpDir/$_" } ("abc2.tmp", "X-${BEGIN_DELIM}c2-a${END_DELIM}-X")], + [map { "$tmpDir/$_" } ("abc3.tmp", "X-${BEGIN_DELIM}c3-a${END_DELIM}-X")], + ], " got mapping"; +} + +{ + title "check backslash escaping"; + + my $tmpDir ;#= 'td'; + my $lex = LexDir->new( $tmpDir ); + + my $BEGIN_DELIM = "\xFF"; + my $END_DELIM = "\xFE"; + + #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" + or diag $File::GlobMapper::Error ; + + is @{ $map }, 3, " returned 3 maps"; + is_deeply $map, + [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-c1-#1*-X")], + [map { "$tmpDir/$_" } ("abc2.tmp", "X-c2-#1*-X")], + [map { "$tmpDir/$_" } ("abc3.tmp", "X-c3-#1*-X")], + ], " got mapping"; +} + # TODO # test each of the wildcard metacharacters can be mapped to the output filename #
6d0514b86ceeMerge pull request #49 from donbright/patch-3
1 file changed · +15 −3
lib/IO/Compress/Gzip.pm+15 −3 modified@@ -839,7 +839,8 @@ Unix variants and unknown Operating Systems. This parameter allows additional metadata to be stored in the ExtraField in the gzip header. An RFC 1952 compliant ExtraField consists of zero or more subfields. Each subfield consists of a two byte header followed by the -subfield data. +subfield data. (The RFC 16-bit subfield length (LEN) is calculated +automatically and will be included in the generated gzip data) The list of subfields can be supplied in any of the following formats @@ -960,7 +961,18 @@ The ID header in an C<ExtraField> sub-field can consist of any two bytes. =head2 Examples -TODO +``` +use IO::Compress::Gzip qw(gzip $GzipError); +gzip \"payload" => "test.gz", + Name => "test", + Comment => "springtime", + ExtraField => [ "xy" => "flowers", "ok"=>"bees"], + OS_Code => 2, + HeaderCRC => 0, + TextFlag => 1, + Time => 42, + or die "Cannot create gzip file: $GzipError" ; +``` =head1 Methods @@ -1228,7 +1240,7 @@ See L<IO::Compress::FAQ|IO::Compress::FAQ/"Compressed files and Net::FTP"> =head1 SUPPORT General feedback/questions/bug reports should be sent to -L<https://github.com/pmqs/IO-Copress/issues> (preferred) or +L<https://github.com/pmqs/IO-Compress/issues> (preferred) or L<https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Copress>. =head1 SEE ALSO
a8f28b36cf4dPoint links to rfcs to ietf.org
11 files changed · +31 −31
lib/Compress/Zlib.pm+3 −3 modified@@ -1484,9 +1484,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Compress/Deflate.pm+3 −3 modified@@ -930,9 +930,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Compress/FAQ.pod+1 −1 modified@@ -197,7 +197,7 @@ L<ftp://ftp.info-zip.org/pub/infozip/doc/> =head2 Gzip Resources The primary reference for gzip files is RFC 1952 -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1952> The primary site for gzip is L<http://www.gzip.org>.
lib/IO/Compress/Gzip.pm+3 −3 modified@@ -1242,9 +1242,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Compress/RawDeflate.pm+3 −3 modified@@ -985,9 +985,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Compress/Zip.pm+3 −3 modified@@ -2121,9 +2121,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Uncompress/AnyInflate.pm+3 −3 modified@@ -976,9 +976,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Uncompress/Gunzip.pm+3 −3 modified@@ -1100,9 +1100,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Uncompress/Inflate.pm+3 −3 modified@@ -972,9 +972,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Uncompress/RawInflate.pm+3 −3 modified@@ -1100,9 +1100,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
lib/IO/Uncompress/Unzip.pm+3 −3 modified@@ -1943,9 +1943,9 @@ L<Archive::Tar|Archive::Tar>, L<IO::Zlib|IO::Zlib> For RFC 1950, 1951 and 1952 see -L<http://www.faqs.org/rfcs/rfc1950.html>, -L<http://www.faqs.org/rfcs/rfc1951.html> and -L<http://www.faqs.org/rfcs/rfc1952.html> +L<https://datatracker.ietf.org/doc/html/rfc1950>, +L<https://datatracker.ietf.org/doc/html/rfc1951> and +L<https://datatracker.ietf.org/doc/html/rfc1952> The I<zlib> compression library was written by Jean-loup Gailly C<gzip@prep.ai.mit.edu> and Mark Adler C<madler@alumni.caltech.edu>.
955244f9ac06Rename test file to fix manifest warning
1 file changed · +0 −0
t/113issues.t+0 −0 renamed
90b51dbbd785IO::Compress: Generalize for EBCDIC
3 files changed · +19 −5
lib/IO/Uncompress/Bunzip2.pm+3 −1 modified@@ -130,7 +130,9 @@ sub chkTrailer sub isBzip2Magic { my $buffer = shift ; - return $buffer =~ /^BZh\d$/; + + # ASCII: B Z h 0 9 + return $buffer =~ qr/^\x42\x5A\x68[\x30-\x39]$/; } 1 ;
t/105oneshot-zip-only.t+12 −2 modified@@ -295,9 +295,17 @@ for my $stream (0, 1) } } -{ +my $ebcdic_skip_msg = "Input file is in an alien character set"; + +SKIP: { + skip $ebcdic_skip_msg, 3 if ord "A" != 65; + title "Regression: ods streaming issue"; + # To execute this test on a non-ASCII machine, we could open the zip file + # without using the Name parameter, or xlate the parameter to ASCII, and + # also xlate the contents to native. + # The file before meta.xml in test.ods is content.xml. # Issue was triggered because content.xml was stored # as streamed and the code to walk the compressed streaming @@ -323,7 +331,9 @@ for my $stream (0, 1) } -{ +SKIP: { + skip $ebcdic_skip_msg, 3 if ord "A" != 65; + title "Regression: odt non-streaming issue"; # https://github.com/pmqs/IO-Compress/issues/13
t/112utf8-zip.t+4 −2 modified@@ -190,11 +190,13 @@ BEGIN { ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; } -{ +SKIP: { title "unzip: EFS => 1 filename not valid utf8 - language encoding flag set"; + # The name hard-coded into this pre-built file is not illegal UTF-EBCDIC + skip "ASCII-centric test", 1, unless ord "A" == 65; + my $filename = "t/files/bad-efs.zip" ; - my $name = "\xF0\xA4\xAD"; eval { my $u = IO::Uncompress::Unzip->new( $filename, efs => 1 ) or die "Cannot open $filename: $UnzipError" };
fdf9958972abFix warnings once in multiple locations
7 files changed · +49 −40
lib/IO/Compress/Base.pm+21 −17 modified@@ -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;
lib/IO/Compress/Deflate.pm+1 −0 modified@@ -149,6 +149,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError); }
lib/IO/Compress/Gzip.pm+1 −0 modified@@ -167,6 +167,7 @@ sub mkTrailer sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError); }
lib/IO/Compress/RawDeflate.pm+1 −0 modified@@ -134,6 +134,7 @@ sub getZlibParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::RawInflate', \$IO::Uncompress::RawInflate::RawInflateError); }
lib/IO/Uncompress/AnyInflate.pm+1 −1 modified@@ -26,7 +26,7 @@ $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');
lib/IO/Uncompress/AnyUncompress.pm+1 −1 modified@@ -18,7 +18,7 @@ $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');
lib/IO/Uncompress/Base.pm+23 −21 modified@@ -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; +}
11b34f573818Avoid duplicate use statements
2 files changed · +3 −5
lib/IO/Compress/RawDeflate.pm+2 −3 modified@@ -7,8 +7,9 @@ use warnings; use bytes; use IO::Compress::Base 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); +use IO::Compress::Base::Common 2.096 qw(:Status :Parse); use IO::Compress::Adapter::Deflate 2.096 ; +use Compress::Raw::Zlib 2.096 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); require Exporter ; @@ -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],
lib/IO/Uncompress/AnyInflate.pm+1 −2 modified@@ -6,7 +6,7 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 (); +use IO::Compress::Base::Common 2.096 qw(:Parse); use IO::Uncompress::Adapter::Inflate 2.096 (); @@ -48,7 +48,6 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.096 qw(:Parse); return ( 'rawinflate' => [Parse_boolean, 0] ) ; }
29a7c586f7adAvoid using indirect calls
59 files changed · +1000 −997
bin/zipdetails+9 −9 modified@@ -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) { @@ -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) {
lib/Compress/Zlib.pm+2 −2 modified@@ -134,12 +134,12 @@ sub gzopen($$) _set_gzerr(0) ; if ($writing) { - $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, + $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,
lib/File/GlobMapper.pm+2 −2 modified@@ -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 ;
lib/IO/Compress/Adapter/Bzip2.pm+2 −2 modified@@ -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) @@ -96,7 +96,7 @@ 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)
lib/IO/Compress/Adapter/Deflate.pm+2 −2 modified@@ -24,13 +24,13 @@ 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;
lib/IO/Compress/Base/Common.pm+4 −4 modified@@ -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]" ;
lib/IO/Compress/Base.pm+5 −5 modified@@ -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 ;
lib/IO/Compress/Bzip2.pm+3 −3 modified@@ -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.
lib/IO/Compress/Deflate.pm+3 −3 modified@@ -178,7 +178,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 +455,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 +492,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.
lib/IO/Compress/FAQ.pod+12 −12 modified@@ -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,7 +167,7 @@ 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. @@ -416,7 +416,7 @@ 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>; @@ -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; @@ -590,9 +590,9 @@ header data. The code that I want to focus on is at the bottom. # 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; @@ -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;
lib/IO/Compress/Gzip.pm+3 −3 modified@@ -285,7 +285,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 +573,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 +610,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.
lib/IO/Compress/RawDeflate.pm+4 −4 modified@@ -178,7 +178,7 @@ 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') @@ -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.
lib/IO/Compress/Zip.pm+16 −14 modified@@ -19,25 +19,26 @@ use Compress::Raw::Zlib 2.096 (); 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 ; - require IO::Compress::Lzma ; - import IO::Compress::Lzma 2.096 ; + eval { require IO::Compress::Adapter::Lzma ; + IO::Compress::Adapter::Lzma->import( 2.096 ); + require IO::Compress::Lzma ; + 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 ); } ; } @@ -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.
lib/IO/Uncompress/Adapter/Bunzip2.pm+2 −2 modified@@ -16,7 +16,7 @@ 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 ; @@ -59,7 +59,7 @@ 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)
lib/IO/Uncompress/Adapter/Identity.pm+1 −1 modified@@ -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(''),
lib/IO/Uncompress/Adapter/Inflate.pm+4 −4 modified@@ -23,20 +23,20 @@ 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)
lib/IO/Uncompress/AnyInflate.pm+3 −3 modified@@ -135,7 +135,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 +444,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 +479,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.
lib/IO/Uncompress/AnyUncompress.pm+3 −3 modified@@ -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.
lib/IO/Uncompress/Base.pm+5 −5 modified@@ -430,7 +430,7 @@ sub _create 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': $!", $!) ; } @@ -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 ; @@ -573,7 +573,7 @@ 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}; @@ -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} ;
lib/IO/Uncompress/Bunzip2.pm+3 −3 modified@@ -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.
lib/IO/Uncompress/Gunzip.pm+3 −3 modified@@ -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.
lib/IO/Uncompress/Inflate.pm+3 −3 modified@@ -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.
lib/IO/Uncompress/RawInflate.pm+3 −3 modified@@ -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.
lib/IO/Uncompress/Unzip.pm+9 −9 modified@@ -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() } ; } @@ -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;
t/001bzip2.t+15 −15 modified@@ -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;
t/002any-transparent.t+3 −3 modified@@ -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 ;
t/004gziphdr.t+123 −124 modified@@ -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,23 +351,23 @@ 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"], [ { \1 , "abc" } => "SubField ID not two chars long"], [ { "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 ; } }
t/005defhdr.t+19 −19 modified@@ -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,15 +287,15 @@ 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) = ''; 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;
t/006zip.t+83 −83 modified@@ -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,24 +69,24 @@ sub getContent { title "Create a simple zip - All Deflate"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', '', '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,24 +102,24 @@ 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', '', '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,24 +135,24 @@ 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', 'and', '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,24 +164,24 @@ SKIP: { title "Create a simple zip - All STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', '', '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,24 +222,24 @@ 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 ', '', '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";
t/011-streamzip.t+4 −4 modified@@ -54,15 +54,15 @@ EOM -my $lex = new LexFile my $stderr ; +my $lex = LexFile->new( my $stderr ); 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";
t/01misc.t+23 −23 modified@@ -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";
t/020isize.t+4 −4 modified@@ -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";
t/050interop-gzip.t+4 −4 modified@@ -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 @@ -46,7 +46,7 @@ sub readWithGzip { my $file = shift ; - my $lex = new LexFile my $outfile; + my $lex = LexFile->new( my $outfile ); my $comp = "$GZIP -d -c" ; @@ -71,7 +71,7 @@ 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 ; @@ -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
t/101truncate-rawdeflate.t+8 −8 modified@@ -55,15 +55,15 @@ 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; @@ -87,14 +87,14 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') 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() ; @@ -112,14 +112,14 @@ 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 ;
t/105oneshot-gzip-only.t+3 −3 modified@@ -46,7 +46,7 @@ sub gzipGetHeader 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(); @@ -63,7 +63,7 @@ sub gzipGetHeader { 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 ; @@ -106,7 +106,7 @@ 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 ; my $before = time ;
t/105oneshot-zip-bzip2-only.t+5 −5 modified@@ -52,7 +52,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(); @@ -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 ; @@ -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);
t/105oneshot-zip-only.t+7 −7 modified@@ -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);
t/107multi-zip-only.t+3 −3 modified@@ -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' ; @@ -70,7 +70,7 @@ push @buffers, undef; 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 ;
t/108anyunc-transparent.t+3 −3 modified@@ -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 ;
t/112utf8-zip.t+18 −18 modified@@ -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}', @@ -52,8 +52,8 @@ BEGIN { 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; @@ -114,7 +114,7 @@ BEGIN { { 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,18 +161,18 @@ 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 + my $u = IO::Uncompress::Unzip->new( $file1 ) or die "Cannot open $file1: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; @@ -184,7 +184,7 @@ BEGIN { my $filename = "t/files/bad-efs.zip" ; my $name = "\xF0\xA4\xAD"; - my $u = new IO::Uncompress::Unzip $filename, efs => 0 + my $u = IO::Uncompress::Unzip->new( $filename, efs => 0 ) or die "Cannot open $filename: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; @@ -196,7 +196,7 @@ 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,13 +207,13 @@ 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 } ; + eval { my $zip = IO::Compress::Zip->new( $file1, + Name => $name, Efs => 1 ) } ; like $@, qr/Wide character in zip filename/, " wide characters in zip filename";
t/compress/any.pl+6 −6 modified@@ -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,10 +58,10 @@ 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" or print "# $$AnyError\n"; @@ -78,10 +78,10 @@ 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" or print "# $$AnyError\n";
t/compress/anyunc.pl+6 −6 modified@@ -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,8 +54,8 @@ 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" or print "# $$AnyError\n"; @@ -72,8 +72,8 @@ 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" or print "# $$AnyError\n";
t/compress/CompTestUtils.pm+31 −29 modified@@ -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,15 +669,15 @@ 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(); 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() ;
t/compress/destroy.pl+8 −8 modified@@ -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 @@ sub run { - ok my $x = new $CompressClass $name, -AutoClose => 1 ; + ok my $x = $CompressClass->can('new')->( $CompressClass, $name, -AutoClose => 1 ); ok $x->write($hello) ; } @@ -56,17 +56,17 @@ sub run # 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) ; } @@ -77,13 +77,13 @@ sub run { 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 ; @@ -95,7 +95,7 @@ sub run { 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 ;
t/compress/encode.pl+14 −14 modified@@ -41,7 +41,7 @@ sub run #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') @@ -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,12 +72,12 @@ 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(); @@ -89,7 +89,7 @@ sub run $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 ; @@ -108,7 +108,7 @@ 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/, @@ -119,7 +119,7 @@ sub run { title "Unknown encoding"; my $output; - eval { my $cs = new $CompressClass(\$output, Encode => 'fred'); } ; + eval { my $cs = $CompressClass->can('new')->( $CompressClass, \$output, Encode => 'fred'); } ; like($@, qr/${CompressClass}: Encoding 'fred' is not available/, " Encoding 'fred' is not available"); } @@ -131,7 +131,7 @@ sub run { title "Encode: To $to, Encode option"; - my $lex2 = new LexFile my $name2 ; + my $lex2 = LexFile->new( my $name2 ); my $output; my $buffer; @@ -145,11 +145,11 @@ 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(); @@ -164,11 +164,11 @@ 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; @@ -181,7 +181,7 @@ sub run # { -# 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;
t/compress/generic.pl+231 −231 modified@@ -9,8 +9,8 @@ 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,42 +114,42 @@ 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 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 @@ sub run { 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 @@ sub run { 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 @@ sub run } { - # 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 @@ sub run { 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 @@ sub run { my $uncomp; - my $x = new $UncompressClass $name ; + my $x = $UncompressClass->can('new')->( $UncompressClass, $name ); ok $x, "creates $UncompressClass $name" ; my $data = ''; @@ -225,21 +225,21 @@ sub run { # 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 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 @@ sub run 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 @@ sub run { # 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 @@ sub run 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 @@ sub run 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 @@ sub run } { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); #my $name = "/tmp/fred"; my $hello = <<EOM ; @@ -330,8 +330,8 @@ sub run 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 @@ sub run #hexDump($name); { - title "Input from stdin via filename '-'"; + title "Input from stdin via filename '-'"; my $x ; my $uncomp ; @@ -352,7 +352,7 @@ sub run 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 @@ sub run } { - # 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 @@ sub run 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 @@ sub run ok $x->write($hello) ; ok $x->flush(); ok $x->close ; - + writeFile($name, $buffer) ; #is anyUncompress(\$buffer), $hello, " any ok"; } @@ -400,7 +400,7 @@ sub run 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 @@ sub run 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 @@ sub run #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -460,7 +460,7 @@ sub run 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 @@ sub run 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 @@ sub run { 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 @@ sub run 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,15 +554,15 @@ sub run my $compressed ; { - ok my $x = new $CompressClass(\$compressed); + ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed); ok $x->write($hello) ; ok $x->close ; $compressed .= $trailer ; } 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 @@ 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); @@ -604,7 +604,7 @@ sub run } 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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 @@ sub run 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,43 +934,43 @@ sub run 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 "This- is- an example\n" . "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 @@ sub run 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 @@ sub run { 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 @@ sub run 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 @@ sub run $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 @@ sub run 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 @@ sub run 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 @@ sub run $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,15 +1171,15 @@ sub run 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) { { 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 @@ sub run } 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,15 +1224,15 @@ sub run my $uncomp; - my $x = new $UncompressClass(\$data, Append => 1) ; + my $x = $UncompressClass->can('new')->( $UncompressClass, \$data, Append => 1) ; ok $x, " created $UncompressClass"; my $len ; 1 while ($len = $x->read($uncomp)) > 0 ; $x->close ; is $uncomp, $string, ' Got uncompressed data' ; - + } } } @@ -1243,13 +1243,13 @@ sub run { 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 @@ sub run 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 @@ sub run } 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 @@ sub run } - + 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,15 +1334,15 @@ sub run } is $output, $string, ' Got uncompressed data' ; } - + foreach my $file (0, 1) { foreach my $trans (0, 1) { 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 @@ sub run } else { - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; $a->write($string); $a->close ; } @@ -1399,7 +1399,7 @@ sub run 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 @@ sub run { 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,16 +1435,16 @@ sub run 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"; like $@, "/not a scalar reference /", " error - not a scalar reference"; } # @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 @@ sub run # 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 @@ sub run # # 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 @@ sub run # 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 @@ 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 "${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 @@ sub run # # # } - # + # # } } @@ -1599,15 +1599,15 @@ sub run 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 @@ sub run } 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 @@ sub run # 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 @@ sub run # 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 @@ sub run 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 @@ sub run 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 @@ sub run 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;
t/compress/merge.pl+13 −13 modified@@ -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) } ; @@ -61,7 +61,7 @@ sub run 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; @@ -83,7 +83,7 @@ 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) ; @@ -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,7 +200,7 @@ sub run { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw( buffer file handle ) ) { @@ -248,7 +248,7 @@ sub run 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) {
t/compress/multi.pl+9 −9 modified@@ -75,7 +75,7 @@ sub run } - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $output ; if ($fb eq 'buffer') { @@ -84,14 +84,14 @@ sub run } 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 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } 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 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } 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 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->( $unc, $cc, @opts, Strict => 1, AutoClose => 1,
t/compress/newtied.pl+15 −15 modified@@ -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); @@ -142,16 +142,16 @@ sub run 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; @@ -273,11 +273,11 @@ sub run { 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 @@ sub run { # 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 @@ sub run 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 @@ sub run { title 'fileno' ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -342,9 +342,9 @@ sub run { 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 @@ sub run 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 ;
t/compress/oneshot.pl+74 −74 modified@@ -82,7 +82,7 @@ sub run ' 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) ; @@ -118,7 +118,7 @@ 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"), @@ -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; @@ -437,9 +437,9 @@ sub run { 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); @@ -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"); @@ -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) ; @@ -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" ; @@ -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; @@ -751,7 +751,7 @@ 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 ; # @@ -845,7 +845,7 @@ 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 ; # @@ -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 ; @@ -1003,7 +1003,7 @@ 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' @@ -1021,8 +1021,8 @@ sub run { title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ; - my $lex = new LexFile(my $filename) ; - my $fh = new IO::File ">$filename"; + my $lex = LexFile->new( my $filename) ; + my $fh = IO::File->new( ">$filename" ); ok &$Func("<$tmpDir1/a*.tmp>" => $fh, MultiStream => $ms, AutoClose => 1), ' Compressed ok' @@ -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"); @@ -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; @@ -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' ; @@ -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 ; @@ -1501,7 +1501,7 @@ 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' or diag $$Error ; @@ -1513,8 +1513,8 @@ sub run { title "$TopType - From FileGlob 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" ); ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' or diag $$Error ; @@ -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); @@ -1628,7 +1628,7 @@ sub run 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";
t/compress/prime.pl+3 −3 modified@@ -54,7 +54,7 @@ sub run 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); @@ -68,8 +68,8 @@ sub run 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,
t/compress/tied.pl+69 −69 modified@@ -8,9 +8,9 @@ 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,27 +188,27 @@ sub run 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>; is @lines, 6, " Line is 6" 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,36 +217,36 @@ sub run defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); ok !$io->eof; 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 @@ sub run 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 @@ sub run 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 @@ sub run 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,36 +345,36 @@ sub run defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); ok ! $io->eof; 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 @@ sub run 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 @@ sub run { 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) {
t/compress/truncate.pl+15 −15 modified@@ -52,7 +52,7 @@ 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"; @@ -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,7 +92,7 @@ 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"; @@ -108,9 +108,9 @@ 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() ; } @@ -124,7 +124,7 @@ sub run 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); @@ -140,10 +140,10 @@ 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 ; @@ -194,7 +194,7 @@ sub run 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); @@ -208,10 +208,10 @@ 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 ; @@ -242,7 +242,7 @@ 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" ; @@ -257,11 +257,11 @@ 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; + -Transparent => $trans ); my $un = ''; my $status = 1 ; $status = $gz->read($un) while $status > 0 ;
t/compress/zlib-generic.pl+12 −12 modified@@ -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 @@ sub myGZreadFile { 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 @@ sub myGZreadFile { 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,7 +104,7 @@ sub myGZreadFile my $buffer = ''; { my $x ; - ok $x = new $CompressClass(\$buffer) ; + ok $x = $CompressClass->can('new')->( $CompressClass, \$buffer); ok $x->close ; } @@ -113,7 +113,7 @@ sub myGZreadFile 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 ; @@ -131,7 +131,7 @@ sub myGZreadFile 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 @@ -157,7 +157,7 @@ sub myGZreadFile 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); @@ -170,7 +170,7 @@ sub myGZreadFile ok $x->close() ; my $k; - $k = new $UncompressClass(\$Answer, BlockSize => 1); + $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); ok $k ; my $initial; @@ -200,14 +200,14 @@ sub myGZreadFile 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;
t/cz-03zlib-v1.t+13 −13 modified@@ -337,7 +337,7 @@ 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 text @@ -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"; @@ -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,13 +1071,13 @@ 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 ; @@ -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"; @@ -1214,7 +1214,7 @@ 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;
t/cz-06gzsetp.t+3 −3 modified@@ -60,7 +60,7 @@ SKIP: { 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; @@ -116,7 +116,7 @@ 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" ; @@ -129,7 +129,7 @@ foreach my $CompressClass ('IO::Compress::Gzip', 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 ;
t/cz-08encoding.t+2 −2 modified@@ -98,7 +98,7 @@ SKIP: { 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); } ;
t/cz-14gzopen.t+23 −23 modified@@ -41,7 +41,7 @@ BEGIN { #=========== #my $name = "test.gz" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <<EOM ; hello world @@ -93,7 +93,7 @@ EOM { title 'check that a number can be gzipped'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $number = 7603 ; @@ -138,7 +138,7 @@ EOM 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") ; @@ -176,7 +176,7 @@ EOM # ====================== # 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 @@ -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" ; @@ -251,7 +251,7 @@ 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" ; @@ -285,7 +285,7 @@ EOM # 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 $line3 = "def" x 200 ; @@ -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,7 +334,7 @@ EOM ok ! $fil->gzclose ; - $f = new IO::File "<$name" ; + $f = IO::File->new( "<$name" ); ok $fil = gzopen($name, "rb") ; my $uncomp; my $x; @@ -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 ; @@ -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" ; @@ -492,7 +492,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) 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 or skip "Cannot create non-writable file", 3 ; @@ -512,7 +512,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) SKIP: { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); skip "Cannot create non-readable file", 3 if $^O eq 'cygwin'; @@ -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,7 +580,7 @@ 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"); @@ -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,7 +656,7 @@ 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"); @@ -669,7 +669,7 @@ 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";
t/globmapper.t+22 −22 modified@@ -36,15 +36,15 @@ 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", " 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", " 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,12 +165,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" or diag $File::GlobMapper::Error ; @@ -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,7 +273,7 @@ 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 ) ;
3ba1ed6bb5e9Merge pull request #1 from mstock/feature/language-encoding-flag
3 files changed · +72 −3
lib/IO/Compress/Zip.pm+10 −3 modified@@ -325,8 +325,8 @@ sub mkHeader $gpFlag |= ZIP_GP_FLAG_LZMA_EOS_PRESENT if $method == ZIP_CM_LZMA ; -# $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING -# if $param->getValue('utf8') && (length($filename) || length($comment)); + $gpFlag |= ZIP_GP_FLAG_LANGUAGE_ENCODING + if $param->getValue('utf8') && (length($filename) || length($comment)); my $version = $ZIP_CM_MIN_VERSIONS{$method}; $version = ZIP64_MIN_VERSION @@ -682,7 +682,7 @@ our %PARAMS = ( 'name' => [IO::Compress::Base::Common::Parse_any, ''], 'filtername'=> [IO::Compress::Base::Common::Parse_code, undef], 'canonicalname'=> [IO::Compress::Base::Common::Parse_boolean, 0], -# 'utf8' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'utf8' => [IO::Compress::Base::Common::Parse_boolean, 0], 'time' => [IO::Compress::Base::Common::Parse_any, undef], 'extime' => [IO::Compress::Base::Common::Parse_any, undef], 'exunix2' => [IO::Compress::Base::Common::Parse_any, undef], @@ -1343,6 +1343,13 @@ filenames before they are stored in C<$zipfile>. FilterName => sub { s[^$dir/][] } ; } +=item C<< Utf8 => 0|1 >> + +This option allows to control the language encoding (EFS) flag. If set, the +filename and comment fields for the file must be encoded using UTF-8. + +This option defaults to B<false>. + =item C<< Time => $number >> Sets the last modified time field in the zip header to $number.
lib/IO/Uncompress/Unzip.pm+2 −0 modified@@ -554,6 +554,7 @@ sub _readZipHeader($) my $extraField; my @EXTRA = (); my $streamingMode = ($gpFlag & ZIP_GP_FLAG_STREAMING_MASK) ? 1 : 0 ; + my $utf8 = ($gpFlag & ZIP_GP_FLAG_LANGUAGE_ENCODING) ? 1 : 0; return $self->HeaderError("Encrypted content not supported") if $gpFlag & (ZIP_GP_FLAG_ENCRYPTED_MASK|ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK); @@ -708,6 +709,7 @@ sub _readZipHeader($) 'UncompressedLength' => $uncompressedLength , 'CRC32' => $crc32 , 'Name' => $filename, + 'Utf8' => $utf8, 'Time' => _dosToUnixTime($lastModTime), 'Stream' => $streamingMode,
t/112utf8-zip.t+60 −0 added@@ -0,0 +1,60 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + @INC = ("../lib", "lib/compress"); + } +} + +use lib qw(t t/compress); +use strict; +use warnings; +use bytes; + +use Test::More ; +use CompTestUtils; + +use IO::Compress::Zip qw($ZipError); +use IO::Uncompress::Unzip qw($UnzipError); + +BEGIN { + # use Test::NoWarnings, if available + my $extra = 0 ; + $extra = 1 + if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; + + plan tests => 7 + $extra; +} + +{ + title "Create a simple zip - language encoding flag set"; + + my $lex = new LexFile my $file1; + + my $zip = new IO::Compress::Zip $file1, + Name => "one", Utf8 => 1; + + my $content = 'Hello, world!'; + is $zip->write($content), length($content), "write"; + $zip->newStream(Name=> "two", Utf8 => 1); + is $zip->write($content), length($content), "write"; + $zip->newStream(Name=> "three", Utf8 => 0); + is $zip->write($content), length($content), "write"; + $zip->newStream(Name=> "four"); + is $zip->write($content), length($content), "write"; + ok $zip->close(), "closed"; + + my $u = new IO::Uncompress::Unzip $file1 + or die "Cannot open $file1: $UnzipError"; + + my $status; + my @utf8; + for ($status = 1; $status > 0; $status = $u->nextStream()) + { + push @utf8, $u->getHeaderInfo()->{Utf8}; + } + + die "Error processing $file1: $status $!\n" + if $status < 0; + + is_deeply \@utf8, [1, 1, 0, 0], "language encoding flag set"; +} \ No newline at end of file
Vulnerability mechanics
Root cause
"Unsanitized user-controlled output glob string is passed through Perl's eval STRING, allowing arbitrary code injection."
Attack vector
An attacker who can control the output glob parameter passed to `File::GlobMapper::globmap()` can inject arbitrary Perl code. The `_parseOutputGlob()` function wraps the output glob in double quotes (`'"' . $string . '"'`). A literal double-quote character in the attacker-supplied output glob closes the wrapper, and any subsequent characters are evaluated as Perl code by `eval STRING` in `_getFiles()` [patch_id=2622217]. The injected Perl executes at the privilege level of the calling process. No authentication or special network position is required beyond the ability to supply the output glob argument.
Affected code
The vulnerability resides in `lib/File/GlobMapper.pm`. The function `_parseOutputGlob()` wraps the caller-supplied output glob string in double quotes and stores it in `$self->{OutputPattern}`. The function `_getFiles()` then runs that stored expression through `eval STRING` (line: `eval "\$outFile = $self->{OutputPattern};"`). No sanitization of the output glob string is performed before the `eval` call [patch_id=2622217].
What the fix does
The patch in commit `f2db247bf90d4cc7ee2710be384946081f3b4610` (patch_id=2622217) removes the `eval STRING` call entirely. Instead of constructing a Perl expression and evaluating it, the new code uses delimiter substitution: it replaces `#N` patterns with `\xFF N \xFE` delimiters and the `*` wildcard with `\xFF\xFE`, then performs plain string substitution in `_getFiles()` using those delimiters. This eliminates the code-injection vector because user-controlled strings are never passed through `eval`. The changelog entry for version 2.220 confirms: "remove use of eval in globmapper. #73" [ref_id=1].
Preconditions
- inputAttacker must be able to supply the output glob argument to File::GlobMapper::globmap()
- authNo authentication or special privileges required beyond access to the globmap function
Generated on May 27, 2026. Inputs: CWE entries + fix-commit diffs from this CVE's patches. Citations validated against bundle.
References
3News mentions
0No linked articles in our index yet.