Unrated severityNVD Advisory· Published May 27, 2026· Updated May 27, 2026
CVE-2026-48961
CVE-2026-48961
Description
IO::Compress versions from 2.207 before 2.220 for Perl ship a zipdetails CLI tool that crashes with undefined subroutine on Info-ZIP Unix Extra Field with 8-byte UID or GID.
When decode_ux() in bin/zipdetails handles an Info-ZIP Unix Extra Field (tag 0x7875) with UID Size or GID Size set to 8, causing zipdetails to decode an 8-byte UID or GID value, it dispatches through decodeLitteEndian(), which calls a misnamed helper unpackValueQ. The actual function defined in the same file is unpackValue_Q (with underscore); the call raises 'Undefined subroutine &main::unpackValueQ' and the script exits with status 255.
Library callers of IO::Compress and IO::Uncompress are not affected; the defect is in the bundled CLI tool.
AI Insight
LLM-synthesized narrative grounded in this CVE's description and references.
IO::Compress zipdetails CLI crashes on Info-ZIP Unix Extra Field with 8-byte UID/GID due to a function name typo.
Vulnerability
The vulnerability resides in the zipdetails CLI tool bundled with IO::Compress versions from 2.207 up to (but not including) 2.220. When processing an Info-ZIP Unix Extra Field (tag 0x7875) where the UID Size or GID Size is set to 8, the decode_ux() function attempts to call unpackValueQ, but the actual function defined in the same file is unpackValue_Q (with an underscore). This mismatch causes Perl to raise an 'Undefined subroutine &main::unpackValueQ' error, and the script exits with status 255. Library callers of IO::Compress and IO::Uncompress are not affected; the defect is isolated to the CLI tool [1][2].
Exploitation
An attacker must supply a crafted ZIP archive that includes an Info-ZIP Unix Extra Field with a UID or GID size of 8 bytes. The victim must then run zipdetails on that archive. No authentication, network position, or special privileges are required beyond access to the file. The crash occurs deterministically during parsing of the malformed extra field; no user interaction beyond executing the tool is needed [1][2].
Impact
Successful exploitation causes a denial of service: zipdetails crashes immediately with an undefined subroutine error and exits with status 255. There is no risk of information disclosure, data corruption, or arbitrary code execution. The impact is limited to the CLI tool; applications using the IO::Compress or IO::Uncompress libraries are unaffected [1][2].
Mitigation
The issue is fixed in IO-Compress version 2.220, released on 16 May 2026, which updates zipdetails to version 4.006 [1][2]. Users should upgrade to IO-Compress 2.220 or later. No workaround exists for affected versions; users are advised to avoid running zipdetails on untrusted ZIP archives until the upgrade is applied [1][2].
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.207, <2.220
Patches
933c89d03d6e7Update zipdetails to version 4.006.
1 file changed · +93 −26
bin/zipdetails+93 −26 modified@@ -29,7 +29,7 @@ use Encode; use Getopt::Long; use List::Util qw(min max); -my $VERSION = '4.005' ; +my $VERSION = '4.006' ; sub fatal_tryWalk; sub fatal_truncated ; @@ -118,7 +118,7 @@ use constant ZIP_EXTRA_SUBFIELD_MAX_SIZE => ZIP_EXTRA_MAX_SIZE - ZIP_EXTRA_SUBFIELD_HEADER_SIZE; use constant ZIP_EOCD_MIN_SIZE => 22 ; - +use constant ZIP_CENTRAL_HDR_MIN_SIZE => 46 ; use constant ZIP_LD_FILENAME_OFFSET => 30; use constant ZIP_CD_FILENAME_OFFSET => 46; @@ -132,7 +132,7 @@ my %ZIP_CompressionMethods = 4 => 'Reduced compression factor 3', 5 => 'Reduced compression factor 4', 6 => 'Imploded', - 7 => 'Reserved for Tokenizing compression algorithm', + 7 => 'Tokenized', 8 => 'Deflated', 9 => 'Deflate64', 10 => 'PKWARE Data Compression Library Imploding', @@ -145,7 +145,7 @@ my %ZIP_CompressionMethods = 17 => 'Reserved by PKWARE', 18 => 'IBM/TERSE or Xceed BWT', # APPNOTE has IBM/TERSE. Xceed reuses it unofficially 19 => 'IBM LZ77 z Architecture (PFS)', - 20 => 'Ipaq8', # see https://encode.su/threads/1048-info-zip-lpaq8 + 20 => 'Zstandard (Deprecated) or Ipaq8', # Deprecated ZStandard and see https://encode.su/threads/1048-info-zip-lpaq8 92 => 'Reference', # Winzip Only from version 25 93 => 'Zstandard', 94 => 'MP3', @@ -2127,7 +2127,7 @@ sub LocalHeader } # Defer test for directory payload until Central Header processing. - # Need to have external file attributes to deal with sme edge conditions. + # Need to have external file attributes to deal with some edge conditions. # # APPNOTE 6.3.10, sec 4.3.8 # warning $FH->tell - $filenameLength, "Directory '$filename' must not have a payload" # if ! $streaming && $filename =~ m#/$# && $localEntry->uncompressedSize ; @@ -3363,7 +3363,7 @@ sub DataDescriptor } # Defer test for directory payload until central header processing. - # Need to have external file attributes to deal with sme edge conditions. + # Need to have external file attributes to deal with some edge conditions. # # APPNOTE 6.3.10, sec 4.3.8 # my $filename = $localEntry->filename; # warning undef, "Directory '$filename' must not have a payload" @@ -4049,7 +4049,7 @@ sub walkExtra # Belt & Braces - should now be at $endExtraOffset # error here means issue in an extra handler - # should noy happen, but just in case + # should not happen, but just in case # TODO -- need tests for this my $here = $FH->tell() ; if ($here > $endExtraOffset) @@ -4179,7 +4179,7 @@ sub walk_Zip64_in_LD if ($assumeLengthsPresent || $assumeAllFieldsPresent || full32 $entry->std_uncompressedSize ) { - # TODO defer a warning if in local header & central/local don't have std_uncompressedSizeset to 0xffffffff + # TODO defer a warning if in local header & central/local don't have std_uncompressedSize set to 0xffffffff my $fieldName = 'Uncompressed Size'; if (length $zip64Extended < 8) { @@ -4838,7 +4838,7 @@ sub decode_Minizip_Hash # 0x1a51 Minizip Hash # Definition in https://github.com/zlib-ng/minizip-ng/blob/master/doc/mz_extrafield.md#hash-0x1a51 - # caller ckecks there are at least 4 bytes available + # caller checks there are at least 4 bytes available my $extraID = shift ; my $len = shift; my $entry = shift; @@ -5080,13 +5080,21 @@ sub decode_Ux out_v " GID"; } -sub decodeLitteEndian +sub canDecodeLittleEndian +{ + my $value = shift; + + state $valid = { 0 => 1, 1 => 1, 2 => 1, 4 => 2, 8 => 1} ; + return $valid->{$value}; +} + +sub decodeLittleEndian { my $value = shift ; if (length $value == 8) { - return unpackValueQ ($value) + return unpackValue_Q ($value) } elsif (length $value == 4) { @@ -5102,7 +5110,7 @@ sub decodeLitteEndian } else { # TODO - fix this - internalFatal undef, "unsupported decodeLitteEndian length '" . length ($value) . "'"; + internalFatal undef, "unsupported decodeLittleEndian length '" . length ($value) . "'"; } } @@ -5137,9 +5145,21 @@ sub decode_ux } myRead(my $data, $uidSize); - out2 $data, "UID", decodeLitteEndian($data); + if (canDecodeLittleEndian($uidSize)) + { + out2 $data, "UID", decodeLittleEndian($data); + } + else + { + out2 $data, "UID", "Invalid UID Value: " . hexDump($data); + info $FH->tell() - $uidSize, extraFieldIdentifier($extraID) . ": UID value is not a valid value" + } $available -= $uidSize ; } + else + { + info $FH->tell() - 1, extraFieldIdentifier($extraID) . ": 'UID Size' should not be zero" + } if ($available < 1) { @@ -5163,9 +5183,21 @@ sub decode_ux } myRead(my $data, $gidSize); - out2 $data, "GID", decodeLitteEndian($data); + if (canDecodeLittleEndian($gidSize)) + { + out2 $data, "GID", decodeLittleEndian($data); + } + else + { + out2 $data, "GID", "Invalid GID Value: " .hexDump($data); + info $FH->tell() - $gidSize, extraFieldIdentifier($extraID) . ": GID value is not a valid value" + } $available -= $gidSize ; } + else + { + info $FH->tell() - 1, extraFieldIdentifier($extraID) . ": 'GID Size' should not be zero" + } } @@ -5622,6 +5654,9 @@ sub peekAtOffset my $offset = shift; my $len = shift; + return undef + if $offset + $len > $FILELEN; + my $here = $FH->tell(); seekTo($offset) ; @@ -5631,7 +5666,7 @@ sub peekAtOffset seekTo($here); length $buffer == $len - or return ''; + or return undef; return $buffer; } @@ -5677,7 +5712,7 @@ sub chckForAPKSigningBlock my $cdOffset = shift; my $cdSize = shift; - # APK Signing Block comes directy before the Central directory + # APK Signing Block comes directly before the Central directory # See https://source.android.com/security/apksigning/v2 # If offset available is less than 44, it isn't an APK signing block @@ -5840,7 +5875,7 @@ sub scanCentralDirectory if (! full32 $locHeaderOffset) { # Check for corrupt offset - # 1. ponting paset EOF + # 1. pointing paset EOF # 2. offset points forward in the file # 3. value at offset is not a CD record signature @@ -6103,7 +6138,39 @@ sub findCentralDirectoryOffset if (needZip64EOCDLocator($diskNumber, $cdDiskNumber, $entriesOnThisDisk, $totalEntries, $centralDirOffset, $centralDirSize) && ! emptyArchive($here, $diskNumber, $cdDiskNumber, $entriesOnThisDisk, $totalEntries, $centralDirOffset, $centralDirSize)) { + # Possible/probable that need a zip64 record + # Must have if -- centralDirOffset > 0xFFFFFFFF or centralDirSize + + my $want_zip64 = 0; + + # Edge condition where centralDirOffset is exactly full32, but archive isn't a zip64 file + # Check if offset to central header is full32 and the central signature is not present + if (full32($centralDirOffset)) + { + my $value = peekAtOffset($centralDirOffset, 4); + $want_zip64 = 1 + if defined $value && unpack( "V", $value) != ZIP_CENTRAL_HDR_SIG ; + } + + # Already past point of no return? + $want_zip64 = 1 + if $here > MAX32 + ZIP_EOCD_MIN_SIZE + ZIP_CENTRAL_HDR_MIN_SIZE; + + # may look like there should be a zip64 entry, but not always the case + { + my $gotSig = peekAtOffset($here - ZIP64_END_CENTRAL_LOC_HDR_SIZE, 4) ; + if (defined $gotSig && unpack("V", $gotSig) != ZIP64_END_CENTRAL_LOC_HDR_SIG) + { + warning $$here - ZIP64_END_CENTRAL_LOC_HDR_SIZE - 4, sprintf("Expected signature for " . Signatures::nameAndHex(ZIP64_END_CENTRAL_LOC_HDR_SIG) . " not found, got 0x%X", $gotSig); + } + else + { + $want_zip64 = 1; + } + } + ($centralDirOffset, $centralDirSize) = offsetFromZip64($fh, $here, ZIP_EOCD_MIN_SIZE + $commentLength + $trailingBytes) + if $want_zip64; } elsif ($is64bit) { @@ -6236,7 +6303,7 @@ sub nibbles { package HeaderOffsetIndex; - # Store a list of header offsets recorded when scannning the central directory + # Store a list of header offsets recorded when scanning the central directory sub new { @@ -7651,7 +7718,7 @@ at hand to help understand the output from this program. By default the program expects to be given a well-formed zip file. It will navigate the zip file by first parsing the zip C<Central Directory> at the end of the file. If the C<Central Directory> is found, it will then walk -sequentally through the zip records starting at the beginning of the file. +sequentially through the zip records starting at the beginning of the file. See L<Advanced Analysis> for other processing options. If the program finds any structural or portability issues with the zip file @@ -7672,7 +7739,7 @@ C<--utc> option to display these fields in Coordinated Universal Time (UTC). =head3 Filenames & Comments Filenames and comments are decoded/encoded using the default system -encoding of the host running C<zipdetails>. When the sytem encoding cannot +encoding of the host running C<zipdetails>. When the system encoding cannot be determined C<cp437> will be used. The exceptions are @@ -7710,7 +7777,7 @@ where the zip files contains sensitive data that cannot be shared. =item C<--scan> -Pessimistically scan the zip file loking for possible zip records. Can be +Pessimistically scan the zip file looking for possible zip records. Can be error-prone. For very large zip files this option is slow. Consider using the C<--walk> option first. See L<"Advanced Analysis Options"> @@ -8020,7 +8087,7 @@ any zip metadata that is still present in the file. When either of these options is enabled, this program will bypass the initial step of reading the C<Central Directory> at the end of the file and simply scan the zip file sequentially from the start of the file looking -for zip metedata records. Although this can be error prone, for the most +for zip metadata records. Although this can be error prone, for the most part it will find any zip file metadata that is still present in the file. The difference between the two options is how aggressive the sequential @@ -8038,7 +8105,7 @@ record and display it. =head3 C<--walk> The C<--walk> option optimistically assumes that it has found a real zip -metatada record and so starts the scan for the next record directly after +metadata record and so starts the scan for the next record directly after the record it has just output. =head3 C<--scan> @@ -8047,8 +8114,8 @@ The C<--scan> option is pessimistic and assumes the 4-byte signature sequence may have been a false-positive, so before starting the scan for the next resord, it will rewind to the location in the file directly after the 4-byte sequecce it just processed. This means it will rescan data that -has already been processed. For very lage zip files the C<--scan> option -can be really realy slow, so trying the C<--walk> option first. +has already been processed. For very large zip files the C<--scan> option +can be really really slow, so trying the C<--walk> option first. B<Important Note>: If the zip file being processed contains one or more nested zip files, and the outer zip file uses the C<STORE> compression @@ -8099,7 +8166,7 @@ can display the filenames using the C<--encoding> option A less common variation of this is where the C<EFS> bit is set, signalling that the filename will be encoded in UTF-8, but the filename is not encoded -in UTF-8. To deal with this scenarion, use the C<--no-language-encoding> +in UTF-8. To deal with this scenario, use the C<--no-language-encoding> option along with the C<--encoding> option.
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
"Typo in subroutine name: `decodeLitteEndian` calls `unpackValueQ` but the defined function is `unpackValue_Q`, causing an undefined-subroutine crash when an 8-byte UID/GID is encountered."
Attack vector
An attacker crafts a ZIP archive containing an Info-ZIP Unix Extra Field (tag 0x7875) where the UID Size or GID Size byte is set to 8. When a user runs the `zipdetails` CLI tool against this archive, `decode_ux()` reads the 8-byte value and dispatches through `decodeLitteEndian()`, which calls the misnamed `unpackValueQ` instead of the correctly named `unpackValue_Q`. Perl raises "Undefined subroutine &main::unpackValueQ" and the script exits with status 255. No authentication or special privileges are required — the attacker only needs to supply a malicious ZIP file to the victim.
Affected code
The defect is in `bin/zipdetails`, specifically in the `decode_ux()` subroutine that handles the Info-ZIP Unix Extra Field (tag 0x7875). When `decode_ux()` reads a UID Size or GID Size of 8 bytes, it calls `decodeLitteEndian()` (note the typo "Litte"), which in turn calls `unpackValueQ` — but the actual function defined in the same file is named `unpackValue_Q` (with an underscore). This mismatch causes an "Undefined subroutine &main::unpackValueQ" fatal error [patch_id=2622226].
What the fix does
The patch in commit `33c89d03d6e746ed2ead4f2f6570d47864c61bc7` [patch_id=2622226] makes three changes. First, it corrects the subroutine call from `unpackValueQ` to `unpackValue_Q` inside `decodeLittleEndian` (also fixing the misspelled function name from `decodeLitteEndian` to `decodeLittleEndian`). Second, it adds a new `canDecodeLittleEndian` function that validates the size byte (accepting 0, 1, 2, 4, 8) before calling `decodeLittleEndian`. Third, `decode_ux()` now checks `canDecodeLittleEndian($uidSize)` and `canDecodeLittleEndian($gidSize)` before attempting to decode, and outputs a hex dump with an info warning for invalid sizes instead of crashing. This closes the crash by both fixing the typo and adding a safety guard against unsupported size values.
Preconditions
- inputVictim must run the zipdetails CLI tool against a crafted ZIP file
- inputThe ZIP file must contain an Info-ZIP Unix Extra Field (tag 0x7875) with UID Size or GID Size set to 8
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.