pax_global_header00006660000000000000000000000064135730560170014521gustar00rootroot0000000000000052 comment=31f0eb9df98da1b6752d53af1172cfbaf043df46 libio-compress-perl-2.093/000077500000000000000000000000001357305601700154255ustar00rootroot00000000000000libio-compress-perl-2.093/Changes000066400000000000000000001253651357305601700167340ustar00rootroot00000000000000CHANGES ------- 2.093 7 December 2019 * No changes 2.092 4 December 2019 * No changes 2.091 23 November 2019 * 000prereq.t: Drop LZMA Module as optional 00d3c110ce6fd6e77dbede3e3aa6125394141891 3697a7ced67d0989f2678514e9b04cbec3198f12 7494437856fb815ba2d6b8762ef6fc623a6384e2 * 011streamzip.t: Fixes for 5.6 2078eb58c5f483341ac7e5c6fc5d48a0a752c585 2f370b8ffb09b5cc5ad0830f9ef798b24a62f424 30101188220dddbfaf1c42a2a91b9bac147909ab 2.090 9 November 2019 * MANIFEST error for streamzip https://github.com/pmqs/IO-Compress/issues/6 70dd9bb4d27bd23d47ac9392320f55c124bc347b 2.089 3 November 2019 * bin/streamzip Add streamzip to EXE_FILES https://github.com/pmqs/IO-Compress/issues/5 7f5ed78e5652125c9ba78aab720e18d384d59c00 fb8cd6480af6303f58fd2e12d4999cd1830f0c5f 2.088 31 October 2019 * t/105oneshot-zip-only.t Fix reset of CompSize 6034da95f1dc5a594edc0d26e6add8d86990ad56 * Add Support Details ad66b6ec4cf175a70e53f74572eed5f403648f11 * Update site for Bzip2 to sourceware 77497aeb2a234889a2b2c4ac7ea2f620895b16a9 * Fix number of tests bc4e234449a82fb00f66af752dfc4c96097b2a4d * Add streamzip script to bin 76d2795d0587bafb0cc398e97142740acba82a42 * zipdetails * Update zipdetails to version 1.11 8958cb3aa90745a4b3369479846846fdca6b4f76 * Zip64 extra field typo f186380d701fe5257f9fc92d69160dc6382cfc24 * t/105oneshot-zip-only.t test with deflated directory 16bfffcf5089af67cb7f68685cc61d06409cba73 * t/105oneshot-zip-only.t Add test for encrypted Zip files 5ad813115aed000f88d7df28261b43c00ae56525 2c64e255feb5a1ee33d033f7eccb6feca12ebe97 * Documentation Updates https://github.com/pmqs/IO-Compress/issues/2 e1fd0d4eda0a8496981cbd83ad06906f4ae586a5 * Mention xz, lzma etc https://github.com/pmqs/IO-Compress/issues/4 126f7b9da97b572d0fb89a9bdcc190c5405c72b8 2.087 10 August 2019 * IO::Uncompress::Unzip nextStream not updating filehandle correctly https://github.com/pmqs/IO-Compress/issues/3 25152f04f5b1bd9341502e42a5877c72eac3f291 * Added travis & appveyor files for CI in GitHub 2.086 31 March 2019 * IO::Compress::Zip & IO::Uncompress::Unzip Added support for Language Encoding Flag via the EFS option. Starting point was pull request https://github.com/pmqs/IO-Compress/pull/1 * zipdetails - some support for MVS (Z390) zip files * IO::Uncompress::Base Issue with trailing data after zip archive #128626 for IO-Compress: mainframe zip archive * t/cz-14gzopen.t cperl error found in http://www.cpantesters.org/cpan/report/448cafc4-3108-11e9-9b6b-d3d33d7b1231 Perl has this: "Not enough arguments for Compress::Zlib::gzopen" cperl uses this: "Not enough arguments for subroutine entry Compress::Zlib::gzopen" * Handlers being called when optional modules are not installed #128538: $SIG{__DIE__} * #128194: Beef up diag when system returns error * Moved source to github https://github.com/pmqs/IO-Compress * Add META_MERGE to Makefile.PL * Added meta-json.t & meta-yaml.t 2.084 5 January 2019 * IO::Uncompress::AnyUncompress.pm Added support for IO::Uncompress::Zstd and IO::Uncompress::UnLzip 2.083 30 December 2018 * IO::Compress::* * IO::Uncompress::* The BinModeIn and BinModeOut options in are now no-ops. ALL files will be read/written in binmode. * IO::Uncompress::Unzip Fixed issue with unziping a member from a streamed zip file. Issue triggered by a libreoffice document. Test added to 105oneshot-zip-only.t Thanks to Fabrizio Pivari for the bug report. * Added U64::isZero * bin/zipdetails Added 'Data Stream Alignment' (tag 0xa11e) to extra fields. Field sourced from https://support.pkware.com/display/PKZIP/Proposed+ZIP+Format+Specification+Additions * Compress::Zlib.pm #125140: Tiny POD error in Compress::Zlib 2.081 4 April 2018 * previous release used $^W instead of use warnings. Fixed. 2.080 2 April 2018 * bin/zipdetails #124003: zipdetails SYNOPSIS section got a typo: zipdetaile-> zipdetails * IO::Uncompress::Base.pm Changes for Archive::Zip::SimpleUnzip * bin/zipdetails Fix issues with zip64 archives. * bin/zipdetails Cope with zip archives where there is padding data after the compressed payload. Example is Microsoft appx file. * File::GlobMapper #120580: File::GlobMapper::$VERSION needs increment; trailing whitespace * t/cz-03zlib-v1.t valgrind errors fixed in Compress::Raw::Zlib 2.0.75 for issue #121074 #121076: uninitialized errors from valgrind 2.074 19 Feb 2017 * Fix bad 2.073 release 2.073 18 Feb 2017 * #120239: [PATCH] ISA fixes for c3 2.072 12 Feb 2017 * Makefile.PL #120084: Need Fix for Makefile.PL depending on . in @INC 2.070 28 Dec 2016 * File::GlobMapper #117675: Fix prototype errors while lazy loading the module * zipdetails #116538: CVE-2016-1238: avoid loading optional modules from default . 2.069 26 Sept 2015 * IO::Compress::FAQ - Added a section of bgzip RT #103295: IO::Compress Feature request * IO::Compress::Zip - Zip64 needs to be first in extra field to workaround a Windows Explorer Bug See http://www.info-zip.org/phpBB3/viewtopic.php?f=3&t=440 for details 2.068 23 Dec 2014 * Disable running of some of the slower test harnesses by default. COMPRESS_ZLIB_RUN_MOST needs set to run them. Make life more bearable on legacy platforms 2.067 8 Dec 2014 * RT #100257: IO::Compress::RawDeflate unnecessarily loads IO::Seekable 2.066 21 Sept 2014 * IO::Uncompress::Gzip Documentation of ExtraFlags stated the XFL values for BEST_COMPRESSION and BEST_SPEED use the values 2 & 4 respectively. They should be 4 & 2. Code for setting XFL was correct. * RT #95494: IO::Uncompress::Gunzip: Can no longer gunzip to in-memory file handle 2.064 1 February 2014 * RT #90216: IO-Compress/t/050interop-gzip.t: Use android-compatible flags when calling gzip 2.063 20 October 2013 * RT#89305: Typo in Compress::Zlib _combine function documentation 2.062 11 August 2013 * RT#87335: [PATCH] Fix up tests for imminent bleadperl changes * RT#84647: typo fixes * RT#86814: IO::Compress::Gzip test t/100generic-bzip2.t hangs on Cygwin 2.061 19 May 2013 * zipdetails (1.06) Get it to cope with Android 'zipalign' non-standard extra fields. These are used to make sure that a non-compressed member starts on a 4 byte boundary. * RT#84647: unzip example with IO::Uncompress::Unzip 2.060 7 January 2013 * Updated POD RT# 82138: Example code not clear - gunzip() takes filenames! * IO::Compress::Base Remove the flush call when opening a filehandle. 2.059 10 December 2012 * IO::Compress::Base Added "Encode" option. Fixes the encoding half of RT# 42656. Decode is still TODO 2.058 12 November 2012 * RT# 81119: Latest IO::Compress 2.057 fails tests on 5.8.x 2.057 10 November 2012 * IO::Compress::Zip Allow member name & Zip Comment to be "0" * IO::Compress::Base::Common Remove "-r" test - the file open will catch this. RT# 80855: IO::Compress::Base::Common returns that it cannot read readable files in NFS * RT# 79820: Install to 'site' instead of 'perl' when perl version is 5.11+ * General Performance improvements. 2.055 5 August 2012 * FAQ Added a few paragraphs on how to deal with pbzip2 files [RT# #77743: Interoperability problems with pbzip2] * Compress::Zip speed up compress, uncompress, memGzip & memGunzip. [RT# #77350: Compress::Zlib::uncompress() is slowed down needlessly by parameter validation 2.052 29 April 2012 * IO::Compress::Zip Force a ZIP64 archive when it contains >= 0xFFFF entries. * Typos in POD [RT# #76130: Gunzip Pod typo in OO section: $$output instead of $$input 2.049 18 February 2012 * IO::Compress::Zip Error in t/cz-03zlib-v1.t that caused warnings with 5.15 [RT# 110736: warnings from cpan/IO-Compress/t/cz-03zlib-v1.t] 2.048 29 January 2012 * Set minimum zlib version to 1.2.0 * IO::Compress test suite fails with Compress::Raw::Zlib 2.047 and zlib < 1.2.4 [RT# 74503] 2.047 28 January 2012 * Set minimum Perl version to 5.6 * IO::Compress::Zip - In one-shot zip, set the Text Flag if "-T" thinks the file is a text file. - In one-shot mode, wrote mod time & access time in wrong order in the "UT" extended field. 2.046 18 December 2011 * Minor update to bin/zipdetails * Typo in name of IO::Compress::FAQ.pod * IO::Uncompress::Unzip - Example for walking a zip file used eof to control the outer loop. This is wrong. * IO::Compress::Zip - Change default for CanonicalName to false. [RT# 72974] 2.045 3 December 2011 * Restructured IO::Compress::FAQ.pod 2.044 2 December 2011 * Moved FAQ.pod under the lib directory so it can get installed * Added bin/zipdetails * IO::Compress::Zip - In one-shot mode enable Zip64 mode if the input file/buffer >= 0xFFFFFFFF bytes. * IO::Compress::FAQ - Updates 2.043 20 November 2011 * IO::Compress::Base - Fixed issue that with handling of Zip files with two (or more) entries that were STORED. Symptom is the first is uncompressed ok, but the next will terminate early if the size of the file is greater than BlockSize. Regression test added to t/006zip.t [RT# 72548] 2.042 17 November 2011 * IO::Compress::Zip - Added exUnixN option to allow creation of the "ux" extra field. This allows 32-bit UID/GID to be stored. - In one-shot mode use exUnixN rather than exUnix2 for the UID/GID. * IO::Compress::Zlib::Extra::parseExtraField - Fixed bad test for length of ID field [RT# 72329 & #72505] 2.040 28 October 2011 * t/105oneshot-zip-only.t - CanonicalName test failure on Windows [RT# 68926] * IO::Compress::Zip - ExtAttr now populates MSDOS attributes 2.039 28 October 2011 * IO::Compress::Zip - Added CanonicalName option. Note this option is set to true by default. - Added FilterName option * IO::Unompress::Base - Fixed issue where setting $\ would corrupt the uncompressed data. Thanks to Steffen Goeldner for reporting the issue. * t/050interop-*.t - Handle case when external command contains a whitespace RT #71335 2.037 22 June 2011 * IO::Uncompress - get globmapper tests working on VMS [RT# 68926] * IO::Uncompress::Unzip - Fixed limitation where Streamed Stored content was not supported. 2.036 18 June 2011 * IO::Compress::Zip & IO::Uncompress::Unzip - Added support for LZMA (method 14) compression/uncompresion. * IO::Compress::Unzip - Fixed CRC issue when compression is Store or Bzip2 and Strict option is set. * IO::Compress::Zip - Fixed Zip64 issue where the content size is exactly 0xFFFFFFFF 2.035 6 May 2011 * RT #67931: Test failure on Windows 2.034 2 May 2011 * Compress::Zlib - Silence pod warnings. [RT# 64876] - Removed duplicate words in pod. * IO::Compress::Base - RT #56942: Testsuite fails when being run in parallel - Reduce symbol import - patch from J. Nick Koston - If the output buffer parameter passed to read has a value of undef, and Append mode was specified when the file was opened, and eof is reached, then the buffer paramer was left as undef. This is different from when Append isn't specified - the buffer parameter is set to an empty string. - There are a couple of issues with reading a file that contains an empty file that is compressed. Create with -- touch /tmp/empty; gzip /tmp/empty. Issue 1 - eof is not true immediately. Have to read from the file to trigger eof. Issue 2 - readline incorrectly returns an empty string the first time it is called, and (correctly) undef thereafter. [RT #67554] 2.033 11 Jan 2011 * Fixed typos & spelling errors. [perl# 81816] 2.032 4 Jan 2011 * IO::Uncompress::Base - An input file that had a valid header, and so would allow creation of the uncompression object, but was then followed by corrupt data would trigger an infinite loop when using the input line oprator. [RT #61915] * IO::Compress::Gzip - XFL default settings for max compression & fastest algorithm were the wrong way around. Thanks to Andrey Zholos for spotting this. * IO::Compress::Base::Common - Fixed precedence problem in parameter parsing code. 2.030 22 July 2010 * IO::Compress::Zip - Updates to documentation. - Changes default value for ExtAttr on Unix to 0100644 * IO::Uncompress::Unzip Reworked the "Name" option and examples in the pod. * IO::Uncompress::Base Fixed problem with nextStream not returning 0 when there is no next stream and Transparent is false. 2.027 24 April 2010 * Compress::Zlib Remove autoload code from Zlib.pm. [perl #74088] 2.026 7 April 2010 * IO::Uncompress::Zip - Some updates to IO::Compress::Zip documentation. - Fixed default setting for ExtAttr. 2.025 27 March 2010 * IO::Uncompress::Unzip The "Name" option wasn't documented. * Allow zlib version check to be disabled by setting TEST_SKIP_VERSION_CHECK environment variable. [RT #54510] 2.024 7 January 2010 * Compress::Zlib Get memGunzip & memGzip to set $gzerrno [RT# 47283] * Compress::Zlib Export memGunzip, memGzip and zlib_version on demand [RT# 52992] * examples/io/anycat This sample was using IO::Uncompress::AnyInflate. Much better to use IO::Uncompress::AnyUncompress. 2.023 9 November 2009 * IO::Compress::AnyUncompress Added support for lzma_alone & xz. 2.022 9 October 2009 * IO::Compress - Makefile.PL Fix for core. 2.021 30 August 2009 * IO::Compress::Base.pm - Less warnnings when reading from a closed filehandle. [RT# 48350] - Fixed minor typo in an error message. [RT# 39719] * Makefile.PL The PREREQ_PM dependency on Scalar::Util got dropped when IO-Compress was created in 2.017. [RT# 47509] * IO::Compress::Zip.pm - Removed restriction that zip64 is only supported in streaming mode. - The "version made by" and "extract" fields in the zip64 end central record were swapped. - In the End Central Header record the "offset to the start of the central directory" will now always be set to 0xFFFFFFFF when zip64 is enabled. - In the End Central Header record the "total entries in the central directory" field will be set to 0xFFFF if zip64 is enabled AND there are more than 0xFFFF entries present. * IO::Uncompress::Unzip.pm - Don't consume lots of memory when walking a zip file. This makes life more bearable when dealing with zip64. * Compress::Zlib.pm - documented that memGunzip cannot cope with concatenated gzip data streams. * Changed test harness so that it can cope with PERL5OPT=-MCarp=verbose [RT# 47225] * IO::Compress::Gzip::Constants.pm - GZIP_FEXTRA_MAX_SIZE was set to 0xFF. Should be 0xFFFF. This issue came up when attempting to unzip a file created by MS Office 2007. 2.020 3 June 2009 * IO::Uncompress::Base.pm - Fixed problem with LimitOutput where a call to uncompress created more uncompressed output, but didn't consume any of the input buffer. The symptom is the underlying compression library (zlib or bzip2) thinks the input stream is corrupt. [RT #46582] 2.019 4 May 2009 * IO::Uncompress::Adapter::Bunzip2 - Fixed problem with EOF check. 2.018 3 May 2009 * IO::Uncompress::Bunzip2 - The interface to Compress-Raw-Bzip2 now uses the new LimitOutput feature. This will make all of the bzip2-related IO-Compress modules less greedy in their memory consumption. * IO::Compress::Zip - Fixed exTime & exUnix2 - Fixed 'Use of uninitialized value in pack' warning when using ZIP_CM_STORE. 2.017 30 March 2009 * Merged IO-Compress-Base, IO-Compress-Bzip2, IO-Compress-Zlib & Compress-Zlib into IO-Compress. * The interface to Compress-Raw-Zlib now uses the new LimitOutput feature. This will make all of the zlib-related IO-Compress modules less greedy in their memory consumption. * Removed MAN3PODS from Makefile.PL * A few changes to get the test harness to work on VMS courtesy of Craig. A. Berry. * IO::Compress::Base & IO::Uncompress::Base Downgraded some croaks in the constructors to just set $! (by letting the code attempt to open a file and fail). This makes the behavior more consistent to a standard open. [RT #42657] * IO::Uncompress::Base Doing a seek with MultiStream could drop some of the uncompressed data. Fixed. * IO::Compress::Zip - Fixed problem with the uncompressed & uncompressed fields when zip64 is enabled. They were set to 0x0000FFFF instead of 0xFFFFFFFF. Also the ZIP64 extra field was 4 bytes short. Problem spotted by Dino Chiesa. * IO::Uncompress::Unzip - use POSIX::mktime instead of Time::Local::timelocal to convert the zip DOS time field into Unix time. * Compress::Zlib - Documented Compress::Zlib::zlib_version() 2.015 3 September 2008 * Makefile.PL Backout changes made in 2.014 2.014 2 September 2008 * Makefile.PL Updated to check for indirect dependencies. 2.013 18 July 2008 * IO::Compress::Base - Allow IO::Compress::Base::Parameters::parse to accept an IO::Compress::Base::Parameters object. 2.012 15 July 2008 * IO::Compress::Base - Silenced an uninitialised value warning when reading a line at a time from a zip file where the content uses ZIP_CM_STORE. [Problem spotted & fixed by Jeff Holt] * IO::Compress::Base & IO::Uncompress::Base - local-ise $!, $? et al in the DESTROY methods. 2.011 17 May 2008 * IO::Compress::Base - Fixed problem that prevented the creation of a zip file that contained more than one compression method. * IO::Compress::Base::Common - The private Validator class in this module clashes with another CPAN module. Moved Validator into the IO::Compress::Base::Common namespace. [RT #35954] * IO::Uncompress::Unzip - Print an error message if the zip file contains a member compressed with bzip2 and IO::Uncompress::Bunzip2 is not available. - Could not cope with mixed compression zip files. For example a zip file that contains both STORED and DEFLATED content. [RT #35573] 2.010 5 May 2008 * Fixed problem that meant Perl 5.10 could not upgrade this module. [RT #35342 & 35341] 2.009 20 April 2008 * Removed the alpha status from File::GlobMapper * IO::Compress::Base When writing output never output a zero length buffer. Done to improve interoperability with other tied filenandle modules. * Changed IO::Uncompress::Base to not use the offset parameter of the read method when reading from a filehandle. The object returned from Net::FTP::retr implements a non-standard read method. The third parameter is used for a timeout value rather than an offset. [rt.cpan#33231] * Changed IO::Uncompress::Base to not use the eof method when reading from a filehandle. The object returned from Net::FTP::retr implements both the read method and the eof method. Unfortunately the implementation of the read method uses non-buffered IO (by using sysread) while the eof method uses buffered IO. Mixing buffered and non-buffered IO results in data corruption. * IO::Compress::Zip - Added exUnix2 option to allow storing of UID & GID. - When running on a Unix derivative the ExtAttr option now defaults to the equivalent of 0666. For all other systems the default remains 0. * Compress::Zlib - Minor documentation issue with flush. [rt.cpan.org #31446] 2.008 2 November 2007 * Minor documentation changes in README * t/compress/truncate.pl EBCDIC Cleanup. * IO::Compress::Gzip::Constants.pm Tidied up the character classes used to defined invalid FNAME & FCOMMENT fields for EBCDIC. * Compress::Zlib lib/Compress/Zlib.pm -- 1.x Backward Compatibility issues gzclose - documented return value was wrong, should be 0 for ok. gzflush - return value didn't match 1.x, should return 0 if ok. [rt.cpan.org #29215] and Debian bug #440943 http://bugs.debian.org/440943 2.006 1 September 20007 * Makefile.PL Added INSTALLDIRS directive to install as a core module when built on a perl >= 5.9. * IO::Uncompress::RawDeflate - Fixed export problem - "$RawDeflateError" and "rawdeflate" were not being exported with ":all". * Compress::Zlib - t/03zlib-v1.t Fixed crc32 and adler32 tests in to remove ascii assumption. - lib/Compress/Zlib.pm Make gzreadline not support $/, just like in Compress::Zlib 1.x Folk who want $/ with readline support can get it in IO::Uncompress::Gunzip. [rt.cpan.org #28663] and Debian bug #435656 http://bugs.debian.org/435656 2.005 18 June 2007 * Stephen Turner reported a problem when using IO::Uncompress::Gunzip with XML::Parser. Turns out there were two issues. Firstly an IO::Uncompress object isn't an IO::Handle. It is now. Secondly the implementation of "read" wasn't honouring this SCALAR will be grown or shrunk to the length actually read. In particular it didn't do the right thing on EOF. This has been fixed. * IO::Compress::Gzip & IO::Uncompress::Gunzip - RFC1952 says that the FNAME & FCOMMENT header fields must be ISO 8859-1 (LATIN-1) characters. The code can optionally police this. Added a fix for this logic when running on EBCDIC. * Compress::Zlib Added info about removing Compress::Zlib version 1, before installing version 2. 2.004 3 March 2007 * Made seek less wasteful of memory. * IO::Compress::Zip - Added Zip64 documentation. - Fixed extended timestamp. Creation time isn't available in Unix so only store the modification time and the last access time in the extended field. - Fixed file mode. - Added ExtAttr option to control the value of the "external file attributes" field in the central directory. - Added Unix2 extended attribute ("Ux"). This stores the UID & GID. * IO::Compress::Gzip - Fixed 050interop-gzip.t for Windows * IO::Compress::Bzip2 - Fixed 050interop-bzip2.t for Windows * Compress::Zlib - rewrote memGzip using IO::Compress::Gzip::gzip 2.003 2 January 2007 * Added explicit version checking 2.002 29 December 2006 * Documentation updates. * Added IO::Handle to the ISA test in isaFilehandle * Add an explicit use_ok test for Scalar::Util in the test harness. The error message reported by 01misc implied the problem was somewhere else. Also explicitly check that 'dualvar' is available. * Compress::Zlib - Fix append mode with gzopen. rt-cpan.org 24041 - Allow gzopen to read from and write to a scalar reference. 2.001 1 November 2006 * Remove beta status. 2.000_14 26 October 2006 * IO::Uncompress::Base Added support for $/ in record mode * IO::Uncompress::Base The readline interface was substantially slower than the 1.x equivalent. This has now been sorted. Thanks to Andreas J. Koenig for spotting the problem. * IO::Uncompress::AnyUncompress Added IO::Uncompress::Lzf to the list of supported uncompressors. * IO::Uncompress::Base Added TrailingData to one-shot interface. * IO::Uncompress::AnyUncompress Remove raw-deflate (RFC1951) from the default list of compressors to check. It can still be included if the new RawInflate parameter is supplied. This change was made because the only way to tell if content is raw-deflate is to attempt to uncompress it - a few false positives have popped up recently, which suggests that auto-detecting raw deflate is far from perfect. The equivalent change has been made to IO::Uncompress::AnyInflate. [Core patch #28445] * Don't check that filehandles are writable. It would seem that "-w *STDOUT" on windows returns false. [Core Patch #28415] * IO::Uncompress::Deflate Beefed up the magic signature check. Means less false positives when auto-detecting the compression type. * IO::Uncompress::UnZip Tighten up the zip64 extra field processing to cope with the case wheere only some of the local header fields are superseded. * IO::Uncompress::AnyInflate Remove raw-deflate (RFC 1951) from the default list of compressors to check. It can still be included if the new RawInflate parameter is supplied. This change was made because the only way to tell if content is raw-deflate is to attempt to uncompress it - a few false positives have popped up recently, which suggests that auto-detecting raw deflate is far from perfect. The equivalent change has been made to IO::Uncompress::AnyUncompress. [Core patch #28445] 2.000_13 20 June 2006 * Store compress & uncompressed sizes as 64-bit. * For one-shot uncompression, like this unzip "some.zip" => \@a, MultiStream => 1; Push each uncompressed stream from "some.zip" onto @a. * Added IO::Compress::Base::FilterEnvelope * Added IO::Uncompress::Base::nextStream * The '-' filehandle now maps to either *STDIN or *STDOUT. This keeps mod_perl happier. Was using these before new IO::File("<-") new IO::File(">-") * Preliminary support for reading zip files with zip64 members. 2.000_12 3 May 2006 * Moved the code for creating and parsing the gzip extra field into IO::Compress::Zlib::Extra.pm so that IO::Compress::Zip & IO::Uncompress::Unzip can use it as well. * Added ExtraFieldLocal & ExtraFieldCentral options to IO::Compress::Zip. These allow the creation of user-defined extra fields in the local and central headers, just like the ExtraField option in IO::Compress::Gzip. * Moved the zip constants into IO::Compress::Zip::Constants * Added exTime option to IO::Compress::Zip. This allows creation of the extended timestamp extra field. * Added Minimal option to IO::Compress::Zip. This disables the creation of all extended fields. * Added TextFlag option to IO::Compress::Zip. * Documented Comment and ZipComment options in IO::Compress::Zip. * Compress::Zlib Fixed gzread to zap the output buffer to an empty string when zero bytes are requested. This matches the behaviour of C::Z 1.x 2.000_11 10 April 2006 * Transparent + InputLength made more robust where input data is not compressed. * Updated Documentation for zip modules. * Changed IO::Compress::Zip 'Store' option to 'Method' and added symbolic constants ZIP_CM_STORE, ZIP_CM_DEFLATE and ZIP_CM_BZIP2 to allow the compression method to be picked by the user. * Added support to allow bzip2 compressed data to be written/read with IO::Compress::Zip and IO::Uncompress::Unzip. * Beefed up 050interop-gzip.t to check that the external gzip command works as expected before starting the tests. This means that this test harness will just be skipped on problematic systems. * Merged core patch 27565 from Steve Peters. This works around a problem with gzip on OpenBSD where it doesn't seem to like compressing files < 10 bytes long. * Beefed up 050interop-bzip2.t to check that the external bzip2 command works as expected before starting the tests. This means that this test harness will just be skipped on problematic systems. 2.000_10 13 March 2006 * AnyUncompress doesn't assume that IO-Compress-Zlib is installed any more. * Documentation updates. * Compress::Zlib Changed gzread so that its behaviour matches C::Z::gzread 1.x if it is called after eof. In this case it will write an empty string into the output parameter. This change is solely for backward compatibility reasons. 2.000_09 3 March 2006 * Released to CPAN. 2.000_08 2 March 2006 * Split IO::Compress::Base into its own distribution. * Split IO::Compress::Bzip2 into its own distribution. * Added opened, autoflush and input_line_number. * Beefed up support for $. * Split IO::Compress::Zlib into its own distribution. * Beefed up support for zip/unzip * Breakout zlib specific code into separate modules. * Limited support for reading/writing zip files 2.000_06 5 October 2005 * Added eof parameter to Compress::Zlib::inflate method. * Fixed issue with 64-bit 2.000_05 4 October 2005 * Renamed IO::* to IO::Compress::* & IO::Uncompress::* 2.000_04 23 September 2005 * Fixed some more non-portable test that were failing on VMS. * fixed problem where error messages in the oneshot interface were getting lost. 2.000_03 12 September 2005 * Fixed some non-portable test that were failing on VMS. * Fixed export of zlib constants from the IO::* classes 2.000_02 6 September 2005 * Split Append mode into Append and Merge * Fixed typos in the documentation. * Added pod/FAQ.pod * Added libscan to Makefile.PL * Added InputLength for IO::Gunzip et al 2.000_01 22 August 2005 * Fixed VERSION in Compress::Gzip::Constants * Removed Compress::Gzip::Info from the distribution. 2.000_00 21 August 2005 * First Beta relase of Compress::zlib rewrite. Compress-Zlib version 1 Changes 1.38 - 6 September 2005 * Integrate core change 25304 -- Symbian Update * Added libscan to Makefile.PL 1.37 - 12 August 2005 * Change to t/03examples.t for VMS from Abe Timmerman 1.36 - 3 August 2005 * Renamed zlib-src-1.2.3 to zlib-src to help VMS * Fixed Makefile.PL for VMS * Fixed t/03examples.t for VMS * Added a couple of notes about incompatibility with Unix compress. 1.35 - 16 July 2005 * Updated zlib source to 1.2.3 * Fixed problem with where two calls to gzclose would hang the debugger. See https://rt.cpan.org/Ticket/Display.html?id=13789 * Added code from Alexey Tourbin to use XSLoader when available, and DynaLoader otherwise. * Documented that the compress & uncompress functions were not the same as the Unix utilities of the same name. * Fixed 05gzsetp -- it left a temp file hanging around. * Integrate core change 24787 - SvUPGRADE returns void in blead * Integrate core change 24788 - Makefile.PL adjustments for the core 1.34 - 30 January 2005 * Fixed typo in the README * Fixed examples.t on Win32 where paths have embedded whitespace. * Fix for Cygwin and core integration from Jos I. Boumans * Upgrade zlib source to 1.2.2 1.33 - 14 January 2004 * Reworked Makefile.PL to avoid creating a private copy of zlib. This both simplifies the build, plus it makes life easier for VMS. * Patches for Makefile.PL to get it to work on VMS supplied by Craig A. Berry. * memGunzip has very slow on FreeBSD. Turns out to be down to the way realloc works on FreeBSD. Changed both inflate & deflate to use exponentially increasing buffer sizes when they need to realloc. Thanks to Peter Jeremy for the lowdown on FreeBSD memory allocation. 1.32 - 26 November 2003 * Steve Hay reported a problem on rt.cpan.org with Windows and MSCV++ 6.0 where the source from the zlib directory was getting installed with the rest of the module. https://rt.cpan.org/Ticket/Display.html?id=1741 This has been fixed by renaming the "zlib" directory to "zlib-src" thus avoiding a conflict with the name of this Perl module. * Fixed a bug in the inflate method where the input buffer is an lvalue (via substr). Problem & solution reported by Salvador Fandiqo. * Tightened up the logic in Makefile.PL when BUILD_ZLIB is True. Issue spotted by Ralf S. Engelschall. 1.31 - 29 October 2003 * Reinstated the creation of .bak files - $^I seems to need a backup file on Windows. For OpenVMS, the extension _bak is used. 1.30 - 28 October 2003 * Bundled a sub-set of the zlib source with the module and changed the default make behaviour to build with the included zlib source. The previous behaviour of using a pre-built zlib library is still available for those that want it. * Added prototypes to the subs in Zlib.pm that didn't already have them. Patch from Ed Avis. * No .bak files are created by Makefile.PL any more - this keep distclean much happier. Patch suggested by Ed Avis. This also fixes a similar problem reported by Dr. Martin Zinser on OpenVMS. * Documentation for some of the gz functions updated. * Format strings modified in DispStream to keep OpenVMS happy. Problem reported by Dr. Martin Zinser. 1.22 - 17 June 2003 * Makefile.PL now displays a warning about not installing Compress::Zlib via the CPAN shell. * Fix to allow intermingling of gzread & gzreadline - patch supplied by Doug Perham. * memGunzip will silently now work if the gzip trailer is missing. Some HTTP Origin Servers seem to leave it out. 1.21 - 28 April 2003 * Tests 148 & 150 from t/02zlib.t were failing on redhat 9. * Added a few words about the problems with Mac OS X to the README file. 1.20 - 4 April 2003 * Fixed bug in gzopen where $gzerrno wasn't being set correctly. The symptom was $gzerrno was set to Z_MEM_ERROR although the file was opened ok. If gzopen failed, $gzerrno was being set correctly. This problem wasn't spotted before because the typical test to determine whether gzopen passed or failed was to check its return value. 1.19 - 31 October 2002 * fixed a problem with t/02zlib.t that was failing with redhat 8. 1.18 - 24 October 2002 * fixed a Win32 problem in t/02zlib.t by changing sysread to read. * zlib 1.0.5 & older doesn't have gzsetparams & gzeof. Added a new variable to config.in to flag an old version of zlib. Split out the tests for gzsetparams into t/05gzsetp.t 1.17 - 23 May 2002 * Moved the test to check the versions of libz & zlib.h into a separate file and added troubleshooting notes to README. * In gzopen, only attempt to call "tell" for normal files. * Fixed to work in taint mode. * Broke changes out of README into Changes file. * Replaced internal use of Z_PARTIAL_FLUSH symbol with Z_SYNC_FLUSH. zlib.h says /* will be removed, use Z_SYNC_FLUSH instead */ 1.16 - 13 December 2001 * Fixed bug in Makefile.PL that stopped "perl Makefile.PL PREFIX=..." working. 1.15 - 4th December 2001 * Changes a few types to get the module to build on 64-bit Solaris * Changed the up/downgrade logic to default to the older constructs, and to only call a downgrade if specifically requested. Some older versions of Perl were having problems with the in-place edit. * added the new XS constant code. 1.14 - 27th August 2001 * Memory overwrite bug fixed in "inflate". Kudos to Rob Simons for reporting the bug and to Anton Berezin for fixing it for me. 1.13 - 31st June 2001 * Make sure config.in is consistent when released. 1.12 - 28th April 2001 * Modified Makefile.PL to only enable the warnings pragma if using perl 5.6.1 or better. 1.11 - 17th February 2001 * Added logic in Makefile.PL to toggle between using $^W and the warnings pragma in the module. * The module, the examples & the test harness are now all strict & warnings clean. 1.10 - 5th February 2001 * fixed a bug in memGunzip. Used Z_ERR instead of Z_DATA_ERROR. 1.09 - 15th January 2001 * Silenced a few compiler warnings. * Updated zlib home site in README & Zlib.pm to www.info-zip.org * Minor typo in Zlib.pm - a link used AUTHORS instead of AUTHOR -- spotted by Frank Martini. * Mention Archive::Zip * added memGunzip. This is largely based on code provided by Jim Leonard. * $deflate->flush can now take an optional parameter. Valid values are Z_NO_FLUSH, Z_PARTIAL_FLUSH, Z_SYNC_FLUSH, Z_FULL_FLUSH and Z_FINISH. The default is Z_FINISH. 1.08 - 6 Jan 2000 * uncompress was clobbering its input parameter. Now it doesn't. This bug was spotted by Deven T. Corzine. * If a variable that only ever contained a number was given to compress or deflate, it would not be compressed properly. Now it will be coerced to a string and then compressed. This bug was spotted by Deven T. Corzine. 1.07 - 27 Nov 1999 * ANSI-ified the static functions in Zlib.xs * Added the ability to build zlib along with the module. This feature is 90% based on a Makefile provided by Gurusamy Sarathy. 1.06 - 20 Sep 1999 * Fixed a nasty problem where inflate could truncate the data returned. Thanks to Douglas Thomson for both spotting the problem and fixing the bug. * Added a note about the undocumented features in zlib that are required when accessing zip files. * gzclose will now get called automatically when the gzip object is destroyed. 1.05 - 3 June 1999 * Previous release used newSVpvn, which doesn't exist in 5.004_04 or earlier. Changed to use newSVpv instead. * The module needs Perl 5.004 or better, so updated the version checking in Zlib.pm and Makefile.PL 1.04 - 27 May 1999 * Bug 19990527.001: compress(undef) core dumps -- Fixed. 1.03 - 17 Mar 1999 * Updated to use the new PL_ symbols. Means the module can be built with Perl 5.005_5* 1.02 - 31 Jan 1999 * The return codes for gzread, gzreadline and gzwrite were documented incorrectly as returning a status code. * The test harness was missing a "gzclose". This caused problem showed up on an amiga. Thanks to Erik van Roode for reporting this one. * Patched zlib.t for OS/2. Thanks to Ilya Zakharevich for the patch. 1.01 - 23 Nov 1997 * A number of fixes to the test suite and the example scripts to allow them to work under win32. All courtesy of Gurusamy Sarathy. 1.00 - 14 Nov 1997 * Fixed crc32 & adler32. They were very broken. * The following functions can now take a scalar reference in place of a scalar for their buffer parameters: compress uncompress deflate inflate crc32 adler32 This should mean applications that make use of the module don't have to copy large buffers around. * Normally the inflate method consumes I of the input buffer before returning. The exception to this is when inflate detects the end of the stream (Z_STREAM_END). In this case the input buffer need not be completely consumed. To allow processing of file formats that embed a deflation stream (e.g. zip, gzip), the inflate method now sets the buffer parameter to be what remains after inflation. When the return status is Z_STREAM_END, it will be what remains of the buffer (if any) after deflation. When the status is Z_OK it will be an empty string. This change means that the buffer parameter must be a lvalue. * Fixed crc32 and adler32. They were both very broken. * Added the Compress::Zlib::memGzip function. 0.5 - Confirmed that no changes were necessary for zlib 1.0.3, or 1.0.4. The optional parameters for deflateInit and inflateInit can now be specified as an associative array in addition to a reference to an associative array. They can also accept the -Name syntax. gzopen can now optionally take a reference to an open filehandle in place of a filename. In this case it will call gzdopen. Added gzstream example script. 0.4 - Upgrade to support zlib 0.99 Added dictionary interface. Fixed bug in gzreadline - previously it would keep returning the same buffer. This bug was reported by Helmut Jarausch Removed dependency to zutil.h and so dropped support for DEF_MEM_LEVEL (use MAX_MEM_LEVEL instead) DEF_WBITS (use MAX_WBITS instead) 0.3 - Added prototype specification. 0.2 - Fixed a minor allocation problem in Zlib.xs 0.1 - first alpha release. 2nd October 1995 libio-compress-perl-2.093/MANIFEST000066400000000000000000000074271357305601700165700ustar00rootroot00000000000000Changes bin/zipdetails perl bin/streamzip perl examples/io/anycat perl examples/io/bzip2/bzcat perl examples/io/bzip2/bzgrep perl examples/io/bzip2/bzstream perl examples/io/gzip/gzappend perl examples/io/gzip/gzcat perl examples/io/gzip/gzgrep perl examples/io/gzip/gzstream perl examples/compress-zlib/filtinf perl examples/compress-zlib/filtdef perl examples/compress-zlib/gzcat perl examples/compress-zlib/gzgrep perl examples/compress-zlib/gzstream perl lib/Compress/Zlib.pm lib/File/GlobMapper.pm lib/IO/Compress/FAQ.pod lib/IO/Compress/Adapter/Bzip2.pm lib/IO/Compress/Adapter/Deflate.pm lib/IO/Compress/Adapter/Identity.pm lib/IO/Compress/Base/Common.pm lib/IO/Compress/Base.pm lib/IO/Compress/Bzip2.pm lib/IO/Compress/Deflate.pm lib/IO/Compress/Gzip/Constants.pm lib/IO/Compress/Gzip.pm lib/IO/Compress/RawDeflate.pm lib/IO/Compress/Zip/Constants.pm lib/IO/Compress/Zip.pm lib/IO/Compress/Zlib/Constants.pm lib/IO/Compress/Zlib/Extra.pm lib/IO/Uncompress/Adapter/Bunzip2.pm lib/IO/Uncompress/Adapter/Identity.pm lib/IO/Uncompress/Adapter/Inflate.pm lib/IO/Uncompress/AnyInflate.pm lib/IO/Uncompress/AnyUncompress.pm lib/IO/Uncompress/Base.pm lib/IO/Uncompress/Bunzip2.pm lib/IO/Uncompress/Gunzip.pm lib/IO/Uncompress/Inflate.pm lib/IO/Uncompress/RawInflate.pm lib/IO/Uncompress/Unzip.pm Makefile.PL MANIFEST private/MakeUtil.pm README t/000prereq.t t/001bzip2.t t/001zlib-generic-deflate.t t/001zlib-generic-gzip.t t/001zlib-generic-rawdeflate.t t/001zlib-generic-zip.t t/002any-deflate.t t/002any-gzip.t t/002any-rawdeflate.t t/002any-transparent.t t/002any-zip.t t/004gziphdr.t t/005defhdr.t t/006zip.t t/010examples-bzip2.t t/010examples-zlib.t t/011-streamzip.t t/01misc.t t/020isize.t t/050interop-gzip.t t/100generic-bzip2.t t/100generic-deflate.t t/100generic-gzip.t t/100generic-rawdeflate.t t/100generic-zip.t t/101truncate-bzip2.t t/101truncate-deflate.t t/101truncate-gzip.t t/101truncate-rawdeflate.t t/101truncate-zip.t t/102tied-bzip2.t t/102tied-deflate.t t/102tied-gzip.t t/102tied-rawdeflate.t t/102tied-zip.t t/103newtied-bzip2.t t/103newtied-deflate.t t/103newtied-gzip.t t/103newtied-rawdeflate.t t/103newtied-zip.t t/104destroy-bzip2.t t/104destroy-deflate.t t/104destroy-gzip.t t/104destroy-rawdeflate.t t/104destroy-zip.t t/105oneshot-bzip2.t t/105oneshot-deflate.t t/105oneshot-gzip-only.t t/105oneshot-gzip.t t/105oneshot-rawdeflate.t t/105oneshot-zip-bzip2-only.t t/105oneshot-zip-only.t t/105oneshot-zip-store-only.t t/105oneshot-zip.t t/106prime-bzip2.t t/106prime-deflate.t t/106prime-gzip.t t/106prime-rawdeflate.t t/106prime-zip.t t/107multi-bzip2.t t/107multi-deflate.t t/107multi-gzip.t t/107multi-rawdeflate.t t/107multi-zip.t t/107multi-zip-only.t t/108anyunc-bzip2.t t/108anyunc-deflate.t t/108anyunc-gzip.t t/108anyunc-rawdeflate.t t/108anyunc-transparent.t t/108anyunc-zip.t t/109merge-deflate.t t/109merge-gzip.t t/109merge-rawdeflate.t t/109merge-zip.t t/110encode-bzip2.t t/110encode-deflate.t t/110encode-gzip.t t/110encode-rawdeflate.t t/110encode-zip.t t/111const-deflate.t t/112utf8-zip.t t/999meta-json.t t/999meta-yml.t t/999pod.t t/cz-01version.t t/cz-03zlib-v1.t t/cz-05examples.t t/cz-06gzsetp.t t/cz-08encoding.t t/cz-14gzopen.t t/compress/any.pl t/compress/anyunc.pl t/compress/CompTestUtils.pm t/compress/destroy.pl t/compress/encode.pl t/compress/generic.pl t/compress/merge.pl t/compress/multi.pl t/compress/newtied.pl t/compress/oneshot.pl t/compress/prime.pl t/compress/tied.pl t/compress/truncate.pl t/compress/zlib-generic.pl t/files/bad-efs.zip t/files/meta.xml t/files/test.ods t/files/encrypt-aes.zip t/files/encrypt-standard.zip t/files/jar.zip t/globmapper.t t/Test/Builder.pm t/Test/More.pm META.yml Module meta-data (added by MakeMaker) t/Test/Simple.pm META.json Module JSON meta-data (added by MakeMaker) libio-compress-perl-2.093/META.json000066400000000000000000000026161357305601700170530ustar00rootroot00000000000000{ "abstract" : "IO Interface to compressed data files/buffers", "author" : [ "Paul Marquess " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "IO-Compress", "no_index" : { "directory" : [ "t", "inc", "t", "private" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Compress::Raw::Bzip2" : "2.093", "Compress::Raw::Zlib" : "2.093", "Scalar::Util" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/pmqs/IO-Compress/issues" }, "homepage" : "https://github.com/pmqs/IO-Compress", "repository" : { "type" : "git", "url" : "git://github.com/pmqs/IO-Compress.git", "web" : "https://github.com/pmqs/IO-Compress" } }, "version" : "2.093", "x_serialization_backend" : "JSON::PP version 2.27300" } libio-compress-perl-2.093/META.yml000066400000000000000000000014711357305601700167010ustar00rootroot00000000000000--- abstract: 'IO Interface to compressed data files/buffers' author: - 'Paul Marquess ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: IO-Compress no_index: directory: - t - inc - t - private requires: Compress::Raw::Bzip2: '2.093' Compress::Raw::Zlib: '2.093' Scalar::Util: '0' resources: bugtracker: https://github.com/pmqs/IO-Compress/issues homepage: https://github.com/pmqs/IO-Compress repository: git://github.com/pmqs/IO-Compress.git version: '2.093' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' libio-compress-perl-2.093/Makefile.PL000066400000000000000000000044111357305601700173770ustar00rootroot00000000000000#! perl -w use strict ; require 5.006 ; $::VERSION = '2.093' ; use lib '.'; use private::MakeUtil; use ExtUtils::MakeMaker 5.16 ; UpDowngrade(getPerlFiles('MANIFEST')) unless $ENV{PERL_CORE}; WriteMakefile( NAME => 'IO::Compress', VERSION_FROM => 'lib/IO/Compress/Base.pm', 'dist' => { COMPRESS => 'gzip', TARFLAGS => '-chvf', SUFFIX => 'gz', DIST_DEFAULT => 'MyTrebleCheck tardist', }, ( $ENV{SKIP_FOR_CORE} ? () : (PREREQ_PM => { 'Compress::Raw::Bzip2' => $::VERSION, 'Compress::Raw::Zlib' => $::VERSION, 'Scalar::Util' => 0, $] >= 5.005 && $] < 5.006 ? ('File::BSDGlob' => 0) : () } ) ), ( $] >= 5.005 ? (ABSTRACT => 'IO Interface to compressed data files/buffers', AUTHOR => 'Paul Marquess ') : () ), INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'), EXE_FILES => ['bin/zipdetails', 'bin/streamzip'], ( $] >= 5.009 && $] <= 5.011001 && ! $ENV{PERL_CORE} ? (INSTALLPRIVLIB => '$(INSTALLARCHLIB)') : () ), ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => { "meta-spec" => { version => 2 }, no_index => { directory => [ 't', 'private' ], }, resources => { bugtracker => { web => 'https://github.com/pmqs/IO-Compress/issues' }, homepage => 'https://github.com/pmqs/IO-Compress', repository => { type => 'git', url => 'git://github.com/pmqs/IO-Compress.git', web => 'https://github.com/pmqs/IO-Compress', }, }, } ) : () ), ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? ('LICENSE' => 'perl') : ()), ) ; # end of file Makefile.PL libio-compress-perl-2.093/README000066400000000000000000000061211357305601700163050ustar00rootroot00000000000000 IO-Compress Version 2.093 7 December 2019 Copyright (c) 1995-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. DESCRIPTION ----------- This distribution provides a Perl interface to allow reading and writing of compressed data created with the zlib and bzip2. IO-Compress supports reading and writing of the following compressed data formats * bzip2 * RFC 1950 * RFC 1951 * RFC 1952 (i.e. gzip) * zip There are a number of companion modules for IO-Compress that extend the suite of compression formats available. * IO-Compress-Lzma Adds support for lzma, xz and lzip. * IO-Compress-Lzf Adds support for lzf. * IO-Compress-Lzop Adds support for lzop. Note that the following modules used to be distributed separately, but are now included with the IO-Compress distribution. Compress-Zlib IO-Compress-Zlib IO-Compress-Bzip2 IO-Compress-Base PREREQUISITES ------------- Before you can build IO-Compress you need to have the following installed on your system: * Perl 5.006 or better. * Compress::Raw::Zlib * Compress::Raw::Bzip2 BUILDING THE MODULE ------------------- Assuming you have met all the prerequisites, the module can now be built using this sequence of commands: perl Makefile.PL make make test INSTALLATION ------------ To install IO-Compress, run the command below: make install TROUBLESHOOTING --------------- SUPPORT ------- General feedback/questions/bug reports should be sent to https://github.com/pmqs/IO-Compress/issues (preferred) or https://rt.cpan.org/Public/Dist/Display.html?Name=IO-Compress. FEEDBACK -------- How to report a problem with IO-Compress. To help me help you, I need all of the following information: 1. The Versions of everything relevant. This includes: a. The *complete* output from running this perl -V Do not edit the output in any way. Note, I want you to run "perl -V" and NOT "perl -v". If your perl does not understand the "-V" option it is too old. This module needs Perl version 5.004 or better. b. The version of IO-Compress you have. If you have successfully installed IO-Compress, this one-liner will tell you: perl -MIO::Compress::Gzip -e 'print qq[ver $IO::Compress::Gzip::VERSION\n]' If you are running windows use this perl -MIO::Compress::Gzip -e "print qq[ver $IO::Compress::Gzip::VERSION\n]" If you haven't installed IO-Compress then search IO::Compress::Gzip.pm for a line like this: $VERSION = "2.093" ; 2. If you are having problems building IO-Compress, send me a complete log of what happened. Start by unpacking the IO-Compress module into a fresh directory and keep a log of all the steps [edit config.in, if necessary] perl Makefile.PL make make test TEST_VERBOSE=1 Paul Marquess libio-compress-perl-2.093/bin/000077500000000000000000000000001357305601700161755ustar00rootroot00000000000000libio-compress-perl-2.093/bin/streamzip000077500000000000000000000124641357305601700201500ustar00rootroot00000000000000#!/usr/bin/perl # Streaming zip use strict; use warnings; use IO::Compress::Zip qw(zip ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ); use Getopt::Long; my $VERSION = '1.0'; my $compression_method = ZIP_CM_DEFLATE; my $stream = 0; my $zipfile = '-'; my $memberName = '-' ; my $zip64 = 0 ; GetOptions("zip64" => \$zip64, "method=s" => \&lookupMethod, "stream" => \$stream, "zipfile=s" => \$zipfile, "member-name=s" => \$memberName, 'version' => sub { print "$VERSION\n"; exit 0 }, 'help' => \&Usage, ) or Usage(); Usage() if @ARGV; zip '-' => $zipfile, Name => $memberName, Zip64 => $zip64, Method => $compression_method, Stream => $stream or die "Error creating zip file '$zipfile': $\n" ; exit 0; sub lookupMethod { my $name = shift; my $value = shift ; my %valid = ( store => ZIP_CM_STORE, deflate => ZIP_CM_DEFLATE, bzip2 => ZIP_CM_BZIP2, lzma => ZIP_CM_LZMA, ); my $method = $valid{ lc $value }; Usage("Unknown method '$value'") if ! defined $method; # If LZMA was rquested, check that it is available if ($method == ZIP_CM_LZMA) { eval ' use IO::Compress::Adapter::Lzma'; die "Method =. LZMA needs IO::Compress::Adapter::Lzma\n" if ! defined $IO::Compress::Lzma::VERSION; } $compression_method = $method; } sub Usage { die < zip file to stdout. No temporary files are created. The zip container written to stdout is, by necessity, written in streaming format. Most programs that read Zip files can cope with a streamed zip file, but if interoperability is important, and your workflow allows you to write the zip file directly to disk you can create a non-streamed zip file using the C option. =head2 OPTIONS =over 5 =item -zip64 Create a Zip64-compliant zip container. Use this option if the input is greater than 4Gig. Default is disabled. =item -zipfile=F Write zip container to the filename F. Use the C option to enable the creation of a streamed zip file. =item -member-name=M This option is used to name the "file" in the zip container. Default is '-'. =item -stream Ignored when writing to stdout. If the C option is specified, including this option will trigger the creation of a streamed zip file. Default: Always enabled when writing to stdout, otherwise disabled. =item -method=M Compress using method "M". Valid method names are * store Store without compression * deflate Use Deflate compression [Deflault] * bzip2 Use Bzip2 compression * lzma Use LZMA compression Note that Lzma compress needs IO::Compress::Lzma to be installed. Default is deflate. =item -version Display version number [$VERSION] =item -help Display help =back =head2 When to use a Streamed Zip File A Zip file created with streaming mode enabled allows you to create a zip file in situations where you cannot seek backwards/forwards in the file. A good examples is when you are serving dynamic content from a Web Server straight into a socket without needing to create a temporary zip file in the filesystsm. Similarly if your workfow uses a Linux pipelined commands. =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 AUTHOR Paul Marquess F. =head1 COPYRIGHT Copyright (c) 2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/bin/zipdetails000077500000000000000000001437121357305601700203030ustar00rootroot00000000000000#!/usr/bin/perl # zipdetails # # Display info on the contents of a Zip file # BEGIN { pop @INC if $INC[-1] eq '.' } use strict; use warnings ; use IO::File; use Encode; # Compression types use constant ZIP_CM_STORE => 0 ; use constant ZIP_CM_IMPLODE => 6 ; use constant ZIP_CM_DEFLATE => 8 ; use constant ZIP_CM_BZIP2 => 12 ; use constant ZIP_CM_LZMA => 14 ; use constant ZIP_CM_PPMD => 98 ; # General Purpose Flag use constant ZIP_GP_FLAG_ENCRYPTED_MASK => (1 << 0) ; use constant ZIP_GP_FLAG_STREAMING_MASK => (1 << 3) ; use constant ZIP_GP_FLAG_PATCHED_MASK => (1 << 5) ; use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ; use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT => (1 << 1) ; use constant ZIP_GP_FLAG_LANGUAGE_ENCODING => (1 << 11) ; # Internal File Attributes use constant ZIP_IFA_TEXT_MASK => 1; # Signatures for each of the headers use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; use constant ZIP_DATA_HDR_SIG => 0x08074b50; use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50; use constant ZIP64_END_CENTRAL_LOC_HDR_SIG => 0x07064b50; use constant ZIP64_ARCHIVE_EXTRA_SIG => 0x08064b50; use constant ZIP64_DIGITAL_SIGNATURE_SIG => 0x05054b50; use constant ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG => 0x08064b50; # Extra sizes use constant ZIP_EXTRA_HEADER_SIZE => 2 ; use constant ZIP_EXTRA_MAX_SIZE => 0xFFFF ; use constant ZIP_EXTRA_SUBFIELD_ID_SIZE => 2 ; use constant ZIP_EXTRA_SUBFIELD_LEN_SIZE => 2 ; use constant ZIP_EXTRA_SUBFIELD_HEADER_SIZE => ZIP_EXTRA_SUBFIELD_ID_SIZE + ZIP_EXTRA_SUBFIELD_LEN_SIZE; use constant ZIP_EXTRA_SUBFIELD_MAX_SIZE => ZIP_EXTRA_MAX_SIZE - ZIP_EXTRA_SUBFIELD_HEADER_SIZE; my %ZIP_CompressionMethods = ( 0 => 'Stored', 1 => 'Shrunk', 2 => 'Reduced compression factor 1', 3 => 'Reduced compression factor 2', 4 => 'Reduced compression factor 3', 5 => 'Reduced compression factor 4', 6 => 'Imploded', 7 => 'Reserved for Tokenizing compression algorithm', 8 => 'Deflated', 9 => 'Enhanced Deflating using Deflate64(tm)', 10 => 'PKWARE Data Compression Library Imploding', 11 => 'Reserved by PKWARE', 12 => 'BZIP2 ', 13 => 'Reserved by PKWARE', 14 => 'LZMA', 15 => 'Reserved by PKWARE', 16 => 'Reserved by PKWARE', 17 => 'Reserved by PKWARE', 18 => 'File is compressed using IBM TERSE (new)', 19 => 'IBM LZ77 z Architecture (PFS)', 95 => 'XZ', 96 => 'WinZip JPEG Compression', 97 => 'WavPack compressed data', 98 => 'PPMd version I, Rev 1', 99 => 'AES Encryption', ); my %OS_Lookup = ( 0 => "MS-DOS", 1 => "Amiga", 2 => "OpenVMS", 3 => "Unix", 4 => "VM/CMS", 5 => "Atari ST", 6 => "HPFS (OS/2, NT 3.x)", 7 => "Macintosh", 8 => "Z-System", 9 => "CP/M", 10 => "Windoxs NTFS or TOPS-20", 11 => "MVS or NTFS", 12 => "VSE or SMS/QDOS", 13 => "Acorn RISC OS", 14 => "VFAT", 15 => "alternate MVS", 16 => "BeOS", 17 => "Tandem", 18 => "OS/400", 19 => "OS/X (Darwin)", 30 => "AtheOS/Syllable", ); my %Lookup = ( ZIP_LOCAL_HDR_SIG, \&LocalHeader, ZIP_DATA_HDR_SIG, \&DataHeader, ZIP_CENTRAL_HDR_SIG, \&CentralHeader, ZIP_END_CENTRAL_HDR_SIG, \&EndCentralHeader, ZIP64_END_CENTRAL_REC_HDR_SIG, \&Zip64EndCentralHeader, ZIP64_END_CENTRAL_LOC_HDR_SIG, \&Zip64EndCentralLocator, # TODO - Archive Encryption Headers #ZIP_ARCHIVE_EXTRA_DATA_RECORD_SIG ); my %Extras = ( 0x0001, ['ZIP64', \&decode_Zip64], 0x0007, ['AV Info', undef], 0x0008, ['Extended Language Encoding', undef], 0x0009, ['OS/2 extended attributes', undef], 0x000a, ['NTFS FileTimes', \&decode_NTFS_Filetimes], 0x000c, ['OpenVMS', undef], 0x000d, ['Unix', undef], 0x000e, ['Stream & Fork Descriptors', undef], 0x000f, ['Patch Descriptor', undef], 0x0014, ['PKCS#7 Store for X.509 Certificates', undef], 0x0015, ['X.509 Certificate ID and Signature for individual file', undef], 0x0016, ['X.509 Certificate ID for Central Directory', undef], 0x0017, ['Strong Encryption Header', undef], 0x0018, ['Record Management Controls', undef], 0x0019, ['PKCS#7 Encryption Recipient Certificate List', undef], # The Header ID mappings defined by Info-ZIP and third parties are: 0x0065, ['IBM S/390 attributes - uncompressed', \&decodeMVS], 0x0066, ['IBM S/390 attributes - compressed', undef], 0x07c8, ['Info-ZIP Macintosh (old, J. Lee)', undef], 0x2605, ['ZipIt Macintosh (first version)', undef], 0x2705, ['ZipIt Macintosh v 1.3.5 and newer (w/o full filename)', undef], 0x2805, ['ZipIt Macintosh v 1.3.5 and newer ', undef], 0x334d, ["Info-ZIP Macintosh (new, D. Haase's 'Mac3' field)", undef], 0x4154, ['Tandem NSK', undef], 0x4341, ['Acorn/SparkFS (David Pilling)', undef], 0x4453, ['Windows NT security descriptor', \&decode_NT_security], 0x4690, ['POSZIP 4690', undef], 0x4704, ['VM/CMS', undef], 0x470f, ['MVS', undef], 0x4854, ['Theos, old inofficial port', undef], 0x4b46, ['FWKCS MD5 (see below)', undef], 0x4c41, ['OS/2 access control list (text ACL)', undef], 0x4d49, ['Info-ZIP OpenVMS (obsolete)', undef], 0x4d63, ['Macintosh SmartZIP, by Macro Bambini', undef], 0x4f4c, ['Xceed original location extra field', undef], 0x5356, ['AOS/VS (binary ACL)', undef], 0x5455, ['Extended Timestamp', \&decode_UT], 0x554e, ['Xceed unicode extra field', \&decode_Xceed_unicode], 0x5855, ['Info-ZIP Unix (original; also OS/2, NT, etc.)', \&decode_UX], 0x5a4c, ['ZipArchive Unicode Filename', undef], 0x5a4d, ['ZipArchive Offsets Array', undef], 0x6375, ['Info-ZIP Unicode Comment', \&decode_up ], 0x6542, ['BeOS (BeBox, PowerMac, etc.)', undef], 0x6854, ['Theos', undef], 0x7075, ['Info-ZIP Unicode Path', \&decode_up ], 0x756e, ['ASi Unix', undef], 0x7441, ['AtheOS (AtheOS/Syllable attributes)', undef], 0x7855, ['Unix Extra type 2', \&decode_Ux], 0x7875, ['Unix Extra Type 3', \&decode_ux], 0x9901, ['AES Encryption', \&decode_AES], 0xa11e, ['Data Stream Alignment', undef], 0xA220, ['Open Packaging Growth Hint', undef ], 0xCAFE, ['Java Executable', \&decode_Java_exe], 0xfb4a, ['SMS/QDOS', undef], ); my $VERSION = "1.11" ; my $FH; my $ZIP64 = 0 ; my $NIBBLES = 8; my $LocalHeaderCount = 0; my $CentralHeaderCount = 0; my $START; my $OFFSET = new U64 0; my $TRAILING = 0 ; my $PAYLOADLIMIT = 256; #new U64 256; my $ZERO = new U64 0 ; sub prOff { my $offset = shift; my $s = offset($OFFSET); $OFFSET->add($offset); return $s; } sub offset { my $v = shift ; if (ref $v eq 'U64') { my $hi = $v->getHigh(); my $lo = $v->getLow(); if ($hi) { my $hiNib = $NIBBLES - 8 ; sprintf("%0${hiNib}X", $hi) . sprintf("%08X", $lo); } else { sprintf("%0${NIBBLES}X", $lo); } } else { sprintf("%0${NIBBLES}X", $v); } } my ($OFF, $LENGTH, $CONTENT, $TEXT, $VALUE) ; my $FMT1 ; my $FMT2 ; sub setupFormat { my $wantVerbose = shift ; my $nibbles = shift; my $width = '@' . ('>' x ($nibbles -1)); my $space = " " x length($width); my $fmt ; if ($wantVerbose) { $FMT1 = " format STDOUT = $width $width ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< \$OFF, \$LENGTH, \$CONTENT, \$TEXT, \$VALUE $space $space ^<<<<<<<<<<<^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ \$CONTENT, \$TEXT, \$VALUE . "; $FMT2 = " format STDOUT = $width $width ^<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< \$OFF, \$LENGTH, \$CONTENT, \$TEXT, \$VALUE $space $space ^<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ \$CONTENT, \$TEXT, \$VALUE . " ; } else { $FMT1 = " format STDOUT = $width ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< \$OFF, \$TEXT, \$VALUE $space ^<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ \$TEXT, \$VALUE . "; $FMT2 = " format STDOUT = $width ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< \$OFF, \$TEXT, \$VALUE $space ^<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ \$TEXT, \$VALUE . " ; } eval "$FMT1"; $| = 1; } sub mySpr { my $format = shift ; return "" if ! defined $format; return $format unless @_ ; return sprintf $format, @_ ; } sub out0 { my $size = shift; my $text = shift; my $format = shift; $OFF = prOff($size); $LENGTH = offset($size) ; $CONTENT = '...'; $TEXT = $text; $VALUE = mySpr $format, @_; write; skip($FH, $size); } sub xDump { my $input = shift; $input =~ tr/\0-\37\177-\377/./; return $input; } sub hexDump { my $input = shift; my $out = unpack('H*', $input) ; $out =~ s#(..)# $1#g ; $out =~ s/^ //; $out = uc $out; return $out; } sub out { my $data = shift; my $text = shift; my $format = shift; my $size = length($data) ; $OFF = prOff($size); $LENGTH = offset($size) ; $CONTENT = hexDump($data); $TEXT = $text; $VALUE = mySpr $format, @_; no warnings; write; } sub out1 { my $text = shift; my $format = shift; $OFF = ''; $LENGTH = '' ; $CONTENT = ''; $TEXT = $text; $VALUE = mySpr $format, @_; write; } sub out2 { my $data = shift ; my $text = shift ; my $format = shift; my $size = length($data) ; $OFF = prOff($size); $LENGTH = offset($size); $CONTENT = hexDump($data); $TEXT = $text; $VALUE = mySpr $format, @_; no warnings; eval "$FMT2"; write ; eval "$FMT1"; } sub Value { my $letter = shift; my @value = @_; if ($letter eq 'C') { return Value_C(@value) } elsif ($letter eq 'v') { return Value_v(@value) } elsif ($letter eq 'V') { return Value_V(@value) } elsif ($letter eq 'VV') { return Value_VV(@value) } } sub outer { my $name = shift ; my $unpack = shift ; my $size = shift ; my $cb1 = shift ; my $cb2 = shift ; myRead(my $buff, $size); my (@value) = unpack $unpack, $buff; my $hex = Value($unpack, @value); if (defined $cb1) { my $v ; if (ref $cb1 eq 'CODE') { $v = $cb1->(@value) ; } else { $v = $cb1 ; } $v = "'" . $v unless $v =~ /^'/; $v .= "'" unless $v =~ /'$/; $hex .= " $v" ; } out $buff, $name, $hex ; $cb2->(@value) if defined $cb2 ; return $value[0]; } sub out_C { my $name = shift ; my $cb1 = shift ; my $cb2 = shift ; outer($name, 'C', 1, $cb1, $cb2); } sub out_v { my $name = shift ; my $cb1 = shift ; my $cb2 = shift ; outer($name, 'v', 2, $cb1, $cb2); } sub out_V { my $name = shift ; my $cb1 = shift ; my $cb2 = shift ; outer($name, 'V', 4, $cb1, $cb2); } sub out_VV { my $name = shift ; my $cb1 = shift ; my $cb2 = shift ; outer($name, 'VV', 8, $cb1, $cb2); } # sub outSomeData # { # my $size = shift; # my $message = shift; # my $size64 = U64::mkU64($size); # if ($size64->gt($ZERO)) { # my $size32 = $size64->getLow(); # if ($size64->gt($PAYLOADLIMIT) ) { # out0 $size32, $message; # } else { # myRead(my $buffer, $size32 ); # out $buffer, $message, xDump $buffer ; # } # } # } sub outSomeData { my $size = shift; my $message = shift; if ($size > 0) { if ($size > $PAYLOADLIMIT) { my $before = $FH->tell(); out0 $size, $message; # printf "outSomeData %X %X $size %X\n", $before, $FH->tell(), $size; } else { myRead(my $buffer, $size ); out $buffer, $message, xDump $buffer ; } } } sub unpackValue_C { Value_v(unpack "C", $_[0]); } sub Value_C { sprintf "%02X", $_[0]; } sub unpackValue_v { Value_v(unpack "v", $_[0]); } sub Value_v { sprintf "%04X", $_[0]; } sub unpackValue_V { Value_V(unpack "V", $_[0]); } sub Value_V { my $v = defined $_[0] ? $_[0] : 0; sprintf "%08X", $v; } sub unpackValue_VV { my ($lo, $hi) = unpack ("V V", $_[0]); Value_VV($lo, $hi); } sub Value_U64 { my $u64 = shift ; Value_VV($u64->getLow(), $u64->getHigh()); } sub Value_VV { my $lo = defined $_[0] ? $_[0] : 0; my $hi = defined $_[1] ? $_[1] : 0; if ($hi == 0) { sprintf "%016X", $lo; } else { sprintf("%08X", $hi) . sprintf "%08X", $lo; } } sub Value_VV64 { my $buffer = shift; # This needs perl 5.10 # return unpack "Q<", $buffer; my ($lo, $hi) = unpack ("V V" , $buffer); no warnings 'uninitialized'; return $hi * (0xFFFFFFFF+1) + $lo; } sub read_U64 { my $b ; myRead($b, 8); my ($lo, $hi) = unpack ("V V" , $b); no warnings 'uninitialized'; return ($b, new U64 $hi, $lo); } sub read_VV { my $b ; myRead($b, 8); my ($lo, $hi) = unpack ("V V" , $b); no warnings 'uninitialized'; return ($b, $hi * (0xFFFFFFFF+1) + $lo); } sub read_V { my $b ; myRead($b, 4); return ($b, unpack ("V", $b)); } sub read_v { my $b ; myRead($b, 2); return ($b, unpack "v", $b); } sub read_C { my $b ; myRead($b, 1); return ($b, unpack "C", $b); } my $opt_verbose = 0; while (@ARGV && $ARGV[0] =~ /^-/) { my $opt = shift; if ($opt =~ /^-h/i) { Usage(); exit; } elsif ($opt =~ /^-v/i) { $opt_verbose = 1; } else { Usage(); } } Usage() unless @ARGV == 1; my $filename = shift @ARGV; die "$filename does not exist\n" unless -e $filename ; die "$filename not a standard file\n" unless -f $filename ; $FH = new IO::File "<$filename" or die "Cannot open $filename: $!\n"; my $FILELEN = -s $filename ; $TRAILING = -s $filename ; $NIBBLES = U64::nibbles(-s $filename) ; #$NIBBLES = int ($NIBBLES / 4) + ( ($NIBBLES % 4) ? 1 : 0 ); #$NIBBLES = 4 * $NIBBLES; # Minimum of 4 nibbles $NIBBLES = 4 if $NIBBLES < 4 ; die "$filename too short to be a zip file\n" if $FILELEN < 22 ; setupFormat($opt_verbose, $NIBBLES); if(0) { # Sanity check that this is a Zip file my ($buffer, $signature) = read_V(); warn "$filename doesn't look like a zip file\n" if $signature != ZIP_LOCAL_HDR_SIG ; $FH->seek(0, SEEK_SET) ; } our ($CdExists, @CentralDirectory) = scanCentralDirectory($FH); die "No Central Directory records found\n" if ! $CdExists ; $OFFSET->reset(); $FH->seek(0, SEEK_SET) ; outSomeData($START, "PREFIX DATA") if defined $START && $START > 0 ; while (1) { last if $FH->eof(); my $here = $FH->tell(); if ($here >= $TRAILING) { print "\n" ; outSomeData($FILELEN - $TRAILING, "TRAILING DATA"); last; } my ($buffer, $signature) = read_V(); my $handler = $Lookup{$signature}; if (!defined $handler) { if (@CentralDirectory) { # Should be at offset that central directory says my $locOffset = $CentralDirectory[0][0]; my $delta = $locOffset - $here ; if ($here < $locOffset ) { for (0 .. 3) { $FH->ungetc(ord(substr($buffer, $_, 1))) } outSomeData($delta, "UNEXPECTED PADDING"); next; } } printf "\n\nUnexpecded END at offset %08X, value %s\n", $here, Value_V($signature); last; } $ZIP64 = 0 if $signature != ZIP_DATA_HDR_SIG ; $handler->($signature, $buffer); } print "Done\n"; exit ; sub compressionMethod { my $id = shift ; Value_v($id) . " '" . ($ZIP_CompressionMethods{$id} || "Unknown Method") . "'" ; } sub LocalHeader { my $signature = shift ; my $data = shift ; print "\n"; ++ $LocalHeaderCount; out $data, "LOCAL HEADER #" . sprintf("%X", $LocalHeaderCount) , Value_V($signature); my $buffer; my ($loc, $CDcompressedLength) = @{ shift @CentralDirectory }; # print "LocalHeader loc $loc CDL $CDcompressedLength\n"; # TODO - add test to check that the loc from central header matches out_C "Extract Zip Spec", \&decodeZipVer; out_C "Extract OS", \&decodeOS; my ($bgp, $gpFlag) = read_v(); my ($bcm, $compressedMethod) = read_v(); out $bgp, "General Purpose Flag", Value_v($gpFlag) ; GeneralPurposeBits($compressedMethod, $gpFlag); out $bcm, "Compression Method", compressionMethod($compressedMethod) ; out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) }; my $crc = out_V "CRC"; my $compressedLength = out_V "Compressed Length"; my $uncompressedLength = out_V "Uncompressed Length"; my $filenameLength = out_v "Filename Length"; my $extraLength = out_v "Extra Length"; my $filename ; myRead($filename, $filenameLength); out $filename, "Filename", "'". $filename . "'"; my $cl64 = new U64 $compressedLength ; my %ExtraContext = (); if ($extraLength) { my @z64 = ($uncompressedLength, $compressedLength, 1, 1); $ExtraContext{Zip64} = \@z64 ; $ExtraContext{InCentralDir} = 0; walkExtra($extraLength, \%ExtraContext); } my $size = 0; $size = printAes(\%ExtraContext) if $compressedMethod == 99 ; $size += printLzmaProperties() if $compressedMethod == ZIP_CM_LZMA ; # $CDcompressedLength->subtract($size) # if $size ; $CDcompressedLength -= $size; # if ($CDcompressedLength->getHigh() || $CDcompressedLength->getLow()) { if ($CDcompressedLength) { outSomeData($CDcompressedLength, "PAYLOAD") ; } if ($compressedMethod == 99) { my $auth ; myRead($auth, 10); out $auth, "AES Auth", hexDump($auth); } } sub CentralHeader { my $signature = shift ; my $data = shift ; ++ $CentralHeaderCount; print "\n"; out $data, "CENTRAL HEADER #" . sprintf("%X", $CentralHeaderCount) . "", Value_V($signature); my $buffer; out_C "Created Zip Spec", \&decodeZipVer; out_C "Created OS", \&decodeOS; out_C "Extract Zip Spec", \&decodeZipVer; out_C "Extract OS", \&decodeOS; my ($bgp, $gpFlag) = read_v(); my ($bcm, $compressedMethod) = read_v(); out $bgp, "General Purpose Flag", Value_v($gpFlag) ; GeneralPurposeBits($compressedMethod, $gpFlag); out $bcm, "Compression Method", compressionMethod($compressedMethod) ; out_V "Last Mod Time", sub { scalar getTime(_dosToUnixTime($_[0])) }; my $crc = out_V "CRC"; my $compressedLength = out_V "Compressed Length"; my $uncompressedLength = out_V "Uncompressed Length"; my $filenameLength = out_v "Filename Length"; my $extraLength = out_v "Extra Length"; my $comment_length = out_v "Comment Length"; my $disk_start = out_v "Disk Start"; my $int_file_attrib = out_v "Int File Attributes"; out1 "[Bit 0]", $int_file_attrib & 1 ? "1 Text Data" : "0 'Binary Data'"; my $ext_file_attrib = out_V "Ext File Attributes"; out1 "[Bit 0]", "Read-Only" if $ext_file_attrib & 0x01 ; out1 "[Bit 1]", "Hidden" if $ext_file_attrib & 0x02 ; out1 "[Bit 2]", "System" if $ext_file_attrib & 0x04 ; out1 "[Bit 3]", "Label" if $ext_file_attrib & 0x08 ; out1 "[Bit 4]", "Directory" if $ext_file_attrib & 0x10 ; out1 "[Bit 5]", "Archive" if $ext_file_attrib & 0x20 ; my $lcl_hdr_offset = out_V "Local Header Offset"; my $filename ; myRead($filename, $filenameLength); out $filename, "Filename", "'". $filename . "'"; my %ExtraContext = (); if ($extraLength) { my @z64 = ($uncompressedLength, $compressedLength, $lcl_hdr_offset, $disk_start); $ExtraContext{Zip64} = \@z64 ; $ExtraContext{InCentralDir} = 1; walkExtra($extraLength, \%ExtraContext); } if ($comment_length) { my $comment ; myRead($comment, $comment_length); out $comment, "Comment", "'". $comment . "'"; } } sub decodeZipVer { my $ver = shift ; my $sHi = int($ver /10) ; my $sLo = $ver % 10 ; #out1 "Zip Spec", "$sHi.$sLo"; "$sHi.$sLo"; } sub decodeOS { my $ver = shift ; $OS_Lookup{$ver} || "Unknown" ; } sub Zip64EndCentralHeader { my $signature = shift ; my $data = shift ; print "\n"; out $data, "ZIP64 END CENTRAL DIR RECORD", Value_V($signature); my $buff; myRead($buff, 8); out $buff, "Size of record", unpackValue_VV($buff); my $size = Value_VV64($buff); out_C "Created Zip Spec", \&decodeZipVer; out_C "Created OS", \&decodeOS; out_C "Extract Zip Spec", \&decodeZipVer; out_C "Extract OS", \&decodeOS; out_V "Number of this disk"; out_V "Central Dir Disk no"; out_VV "Entries in this disk"; out_VV "Total Entries"; out_VV "Size of Central Dir"; out_VV "Offset to Central dir"; # TODO - die "Unsupported Size ($size) in Zip64EndCentralHeader\n" if $size != 44; } sub Zip64EndCentralLocator { my $signature = shift ; my $data = shift ; print "\n"; out $data, "ZIP64 END CENTRAL DIR LOCATOR", Value_V($signature); out_V "Central Dir Disk no"; out_VV "Offset to Central dir"; out_V "Total no of Disks"; } sub EndCentralHeader { my $signature = shift ; my $data = shift ; print "\n"; out $data, "END CENTRAL HEADER", Value_V($signature); out_v "Number of this disk"; out_v "Central Dir Disk no"; out_v "Entries in this disk"; out_v "Total Entries"; out_V "Size of Central Dir"; out_V "Offset to Central Dir"; my $comment_length = out_v "Comment Length"; if ($comment_length) { my $comment ; myRead($comment, $comment_length); out $comment, "Comment", "'$comment'"; } } sub DataHeader { my $signature = shift ; my $data = shift ; print "\n"; out $data, "STREAMING DATA HEADER", Value_V($signature); out_V "CRC"; if ($ZIP64) { out_VV "Compressed Length" ; out_VV "Uncompressed Length" ; } else { out_V "Compressed Length" ; out_V "Uncompressed Length" ; } } sub GeneralPurposeBits { my $method = shift; my $gp = shift; out1 "[Bit 0]", "1 'Encryption'" if $gp & ZIP_GP_FLAG_ENCRYPTED_MASK; my %lookup = ( 0 => "Normal Compression", 1 => "Maximum Compression", 2 => "Fast Compression", 3 => "Super Fast Compression"); if ($method == ZIP_CM_DEFLATE) { my $mid = $gp & 0x03; out1 "[Bits 1-2]", "$mid '$lookup{$mid}'"; } if ($method == ZIP_CM_LZMA) { if ($gp & ZIP_GP_FLAG_LZMA_EOS_PRESENT) { out1 "[Bit 1]", "1 'LZMA EOS Marker Present'" ; } else { out1 "[Bit 1]", "0 'LZMA EOS Marker Not Present'" ; } } if ($method == ZIP_CM_IMPLODE) # Imploding { out1 "[Bit 1]", ($gp & 1 ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ; out1 "[Bit 2]", ($gp & 2 ? "1 '3" : "0 '2" ) . " Shannon-Fano Trees'" ; } out1 "[Bit 3]", "1 'Streamed'" if $gp & ZIP_GP_FLAG_STREAMING_MASK; out1 "[Bit 4]", "1 'Enhanced Deflating'" if $gp & 1 << 4; out1 "[Bit 5]", "1 'Compressed Patched'" if $gp & 1 << 5 ; out1 "[Bit 6]", "1 'Strong Encryption'" if $gp & ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK; out1 "[Bit 11]", "1 'Language Encoding'" if $gp & ZIP_GP_FLAG_LANGUAGE_ENCODING; out1 "[Bit 12]", "1 'Pkware Enhanced Compression'" if $gp & 1 <<12 ; out1 "[Bit 13]", "1 'Encrypted Central Dir'" if $gp & 1 <<13 ; return (); } sub seekSet { my $fh = $_[0] ; my $size = $_[1]; use Fcntl qw(SEEK_SET); if (ref $size eq 'U64') { seek($fh, $size->get64bit(), SEEK_SET); } else { seek($fh, $size, SEEK_SET); } } sub skip { my $fh = $_[0] ; my $size = $_[1]; use Fcntl qw(SEEK_CUR); if (ref $size eq 'U64') { seek($fh, $size->get64bit(), SEEK_CUR); } else { seek($fh, $size, SEEK_CUR); } } sub myRead { my $got = \$_[0] ; my $size = $_[1]; my $wantSize = $size; $$got = ''; if ($size == 0) { return ; } if ($size > 0) { my $buff ; my $status = $FH->read($buff, $size); return $status if $status < 0; $$got .= $buff ; } my $len = length $$got; die "Truncated file (got $len, wanted $wantSize): $!\n" if length $$got != $wantSize; } sub walkExtra { my $XLEN = shift; my $context = shift; my $buff ; my $offset = 0 ; my $id; my $subLen; my $payload ; my $count = 0 ; if ($XLEN < ZIP_EXTRA_SUBFIELD_ID_SIZE + ZIP_EXTRA_SUBFIELD_LEN_SIZE) { # Android zipalign is prime candidate for this non-standard extra field. myRead($payload, $XLEN); my $data = hexDump($payload); out $payload, "Malformed Extra Data", $data; return undef; } while ($offset < $XLEN) { ++ $count; return undef if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; myRead($id, ZIP_EXTRA_SUBFIELD_ID_SIZE); $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE; my $lookID = unpack "v", $id ; my ($who, $decoder) = @{ defined $Extras{$lookID} ? $Extras{$lookID} : ['', undef] }; #my ($who, $decoder) = @{ $Extras{unpack "v", $id} || ['', undef] }; $who = "$id: $who" if $id =~ /\w\w/ ; $who = "'$who'"; out $id, "Extra ID #" . Value_v($count), unpackValue_v($id) . " $who" ; myRead($buff, ZIP_EXTRA_SUBFIELD_LEN_SIZE); $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE; $subLen = unpack("v", $buff); out2 $buff, "Length", Value_v($subLen) ; return undef if $offset + $subLen > $XLEN ; if (! defined $decoder) { myRead($payload, $subLen); my $data = hexDump($payload); out2 $payload, "Extra Payload", $data; } else { $decoder->($subLen, $context) ; } $offset += $subLen ; } return undef ; } sub full32 { return $_[0] == 0xFFFFFFFF ; } sub decode_Zip64 { my $len = shift; my $context = shift; my $z64Data = $context->{Zip64}; $ZIP64 = 1; if (full32 $z64Data->[0] ) { out_VV " Uncompressed Size"; } if (full32 $z64Data->[1] ) { out_VV " Compressed Size"; } if (full32 $z64Data->[2] ) { out_VV " Offset to Local Dir"; } if ($z64Data->[3] == 0xFFFF ) { out_V " Disk Number"; } } sub Ntfs2Unix { my $v = shift; my $u64 = shift; # NTFS offset is 19DB1DED53E8000 my $hex = Value_U64($u64) ; my $NTFS_OFFSET = new U64 0x19DB1DE, 0xD53E8000 ; $u64->subtract($NTFS_OFFSET); my $elapse = $u64->get64bit(); my $ns = ($elapse % 10000000) * 100; $elapse = int ($elapse/10000000); return "$hex '" . localtime($elapse) . " " . sprintf("%0dns'", $ns); } sub decode_NTFS_Filetimes { my $len = shift; my $context = shift; out_V " Reserved"; out_v " Tag1"; out_v " Size1" ; my ($m, $s1) = read_U64; out $m, " Mtime", Ntfs2Unix($m, $s1); my ($c, $s2) = read_U64; out $c, " Ctime", Ntfs2Unix($m, $s2); my ($a, $s3) = read_U64; out $m, " Atime", Ntfs2Unix($m, $s3); } sub getTime { my $time = shift ; return "'" . localtime($time) . "'" ; } sub decode_UT { my $len = shift; my $context = shift; my ($data, $flags) = read_C(); my $f = Value_C $flags; $f .= " mod" if $flags & 1; $f .= " access" if $flags & 2; $f .= " change" if $flags & 4; out $data, " Flags", "'$f'"; -- $len; if ($flags & 1) { my ($data, $time) = read_V(); out2 $data, "Mod Time", Value_V($time) . " " . getTime($time) ; $len -= 4 ; } if ($flags & 2 && $len > 0 ) { my ($data, $time) = read_V(); out2 $data, "Access Time", Value_V($time) . " " . getTime($time) ; $len -= 4 ; } if ($flags & 4 && $len > 0) { my ($data, $time) = read_V(); out2 $data, "Change Time", Value_V($time) . " " . getTime($time) ; } } sub decode_AES { my $len = shift; my $context = shift; return if $len == 0 ; my %lookup = ( 1 => "AE-1", 2 => "AE-2"); out_v " Vendor Version", sub { $lookup{$_[0]} || "Unknown" } ; my $id ; myRead($id, 2); out $id, " Vendor ID", unpackValue_v($id) . " '$id'"; my %strengths = (1 => "128-bit encryption key", 2 => "192-bit encryption key", 3 => "256-bit encryption key", ); my $strength = out_C " Encryption Strength", sub {$strengths{$_[0]} || "Unknown" } ; my ($bmethod, $method) = read_v(); out $bmethod, " Compression Method", compressionMethod($method) ; $context->{AesStrength} = $strength ; } sub decode_UX { my $len = shift; my $context = shift; my $inCentralHdr = $context->{InCentralDir} ; return if $len == 0 ; my ($data, $time) = read_V(); out2 $data, "Access Time", Value_V($time) . " " . getTime($time) ; ($data, $time) = read_V(); out2 $data, "Mod Time", Value_V($time) . " " . getTime($time) ; if (! $inCentralHdr ) { out_v " UID" ; out_v " GID"; } } sub decode_Ux { my $len = shift; my $context = shift; return if $len == 0 ; out_v " UID" ; out_v " GID"; } sub decodeLitteEndian { my $value = shift ; if (length $value == 4) { return Value_V unpack ("V", $value) } else { # TODO - fix this die "unsupported\n"; } my $got = 0 ; my $shift = 0; #hexDump #reverse #my @a =unpack "C*", $value; #@a = reverse @a; #hexDump(@a); for (reverse unpack "C*", $value) { $got = ($got << 8) + $_ ; } return $got ; } sub decode_ux { my $len = shift; my $context = shift; return if $len == 0 ; out_C " Version" ; my $uidSize = out_C " UID Size"; myRead(my $data, $uidSize); out2 $data, "UID", decodeLitteEndian($data); my $gidSize = out_C " GID Size"; myRead($data, $gidSize); out2 $data, "GID", decodeLitteEndian($data); } sub decode_Java_exe { my $len = shift; my $context = shift; } sub decode_up { my $len = shift; my $context = shift; out_C " Version"; out_V " NameCRC32"; myRead(my $data, $len - 5); out $data, " UnicodeName", $data; } sub decode_Xceed_unicode { my $len = shift; my $context = shift; my $data ; # guess the fields used for this one myRead($data, 4); out $data, " ID", $data; out_v " Length"; out_v " Null"; myRead($data, $len - 8); out $data, " UTF16LE Name", decode("UTF16LE", $data); } sub decode_NT_security { my $len = shift; my $context = shift; my $inCentralHdr = $context->{InCentralDir} ; out_V " Uncompressed Size" ; if (! $inCentralHdr) { out_C " Version" ; out_v " Type"; out_V " NameCRC32" ; my $plen = $len - 4 - 1 - 2 - 4; myRead(my $payload, $plen); out $plen, " Extra Payload", hexDump($payload); } } sub decodeMVS { my $len = shift; my $context = shift; # data in Big-Endian myRead(my $data, $len); my $ID = unpack("N", $data); if ($ID == 0xE9F3F9F0) { out($data, " ID", "'Z390'"); substr($data, 0, 4) = ''; } out($data, " Extra Payload", hexDump($data)); } sub printAes { my $context = shift ; my %saltSize = ( 1 => 8, 2 => 12, 3 => 16, ); myRead(my $salt, $saltSize{$context->{AesStrength} }); out $salt, "AES Salt", hexDump($salt); myRead(my $pwv, 2); out $pwv, "AES Pwd Ver", hexDump($pwv); return $saltSize{$context->{AesStrength}} + 2 + 10; } sub printLzmaProperties { my $len = 0; my $b1; my $b2; my $buffer; myRead($b1, 2); my ($verHi, $verLow) = unpack ("CC", $b1); out $b1, "LZMA Version", sprintf("%02X%02X", $verHi, $verLow) . " '$verHi.$verLow'"; my $LzmaPropertiesSize = out_v "LZMA Properties Size"; $len += 4; my $LzmaInfo = out_C "LZMA Info", sub { $_[0] == 93 ? "(Default)" : ""}; my $PosStateBits = 0; my $LiteralPosStateBits = 0; my $LiteralContextBits = 0; $PosStateBits = int($LzmaInfo / (9 * 5)); $LzmaInfo -= $PosStateBits * 9 * 5; $LiteralPosStateBits = int($LzmaInfo / 9); $LiteralContextBits = $LzmaInfo - $LiteralPosStateBits * 9; out1 " PosStateBits", $PosStateBits; out1 " LiteralPosStateBits", $LiteralPosStateBits; out1 " LiteralContextBits", $LiteralContextBits; out_V "LZMA Dictionary Size"; # TODO - assumption that this is 5 $len += $LzmaPropertiesSize; skip($FH, $LzmaPropertiesSize - 5) if $LzmaPropertiesSize != 5 ; return $len; } sub scanCentralDirectory { my $fh = shift; my $here = $fh->tell(); # Use cases # 1 32-bit CD # 2 64-bit CD my @CD = (); my $offset = findCentralDirectoryOffset($fh); return () if ! defined $offset; $fh->seek($offset, SEEK_SET) ; # Now walk the Central Directory Records my $buffer ; while ($fh->read($buffer, 46) == 46 && unpack("V", $buffer) == ZIP_CENTRAL_HDR_SIG) { my $compressedLength = unpack("V", substr($buffer, 20, 4)); my $uncompressedLength = unpack("V", substr($buffer, 24, 4)); my $filename_length = unpack("v", substr($buffer, 28, 2)); my $extra_length = unpack("v", substr($buffer, 30, 2)); my $comment_length = unpack("v", substr($buffer, 32, 2)); my $locHeaderOffset = unpack("V", substr($buffer, 42, 4)); $START = $locHeaderOffset if ! defined $START; skip($fh, $filename_length ) ; if ($extra_length) { $fh->read(my $extraField, $extra_length) ; # $self->smartReadExact(\$extraField, $extra_length); # Check for Zip64 # my $zip64Extended = findID("\x01\x00", $extraField); my $zip64Extended = findID(0x0001, $extraField); if ($zip64Extended) { if ($uncompressedLength == 0xFFFFFFFF) { $uncompressedLength = Value_VV64 substr($zip64Extended, 0, 8, ""); # $uncompressedLength = unpack "Q<", substr($zip64Extended, 0, 8, ""); } if ($compressedLength == 0xFFFFFFFF) { $compressedLength = Value_VV64 substr($zip64Extended, 0, 8, ""); # $compressedLength = unpack "Q<", substr($zip64Extended, 0, 8, ""); } if ($locHeaderOffset == 0xFFFFFFFF) { $locHeaderOffset = Value_VV64 substr($zip64Extended, 0, 8, ""); # $locHeaderOffset = unpack "Q<", substr($zip64Extended, 0, 8, ""); } } } my $got = [$locHeaderOffset, $compressedLength] ; # my $v64 = new U64 $compressedLength ; # my $loc64 = new U64 $locHeaderOffset ; # my $got = [$loc64, $v64] ; # if (full32 $compressedLength || full32 $locHeaderOffset) { # $fh->read($buffer, $extra_length) ; # # TODO - fix this # die "xxx $offset $comment_length $filename_length $extra_length" . length($buffer) # if length($buffer) != $extra_length; # $got = get64Extra($buffer, full32($uncompressedLength), # $v64, # $loc64); # # If not Zip64 extra field, assume size is 0xFFFFFFFF # #$v64 = $got if defined $got; # } # else { # skip($fh, $extra_length) ; # } skip($fh, $comment_length ) ; push @CD, $got ; } $fh->seek($here, SEEK_SET) ; # @CD = sort { $a->[0]->cmp($b->[0]) } @CD ; @CD = sort { $a->[0] <=> $b->[0] } @CD ; return (1, @CD); } sub offsetFromZip64 { my $fh = shift ; my $here = shift; $fh->seek($here - 20, SEEK_SET) # TODO - fix this or die "xx $!" ; my $buffer; my $got = 0; ($got = $fh->read($buffer, 20)) == 20 # TODO - fix this or die "xxx $here $got $!" ; if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_LOC_HDR_SIG ) { my $cd64 = Value_VV64 substr($buffer, 8, 8); $fh->seek($cd64, SEEK_SET) ; $fh->read($buffer, 4) == 4 # TODO - fix this or die "xxx" ; if ( unpack("V", $buffer) == ZIP64_END_CENTRAL_REC_HDR_SIG ) { $fh->read($buffer, 8) == 8 # TODO - fix this or die "xxx" ; my $size = Value_VV64($buffer); $fh->read($buffer, $size) == $size # TODO - fix this or die "xxx" ; my $cd64 = Value_VV64 substr($buffer, 36, 8); return $cd64 ; } # TODO - fix this die "zzz"; } # TODO - fix this die "zzz"; } use constant Pack_ZIP_END_CENTRAL_HDR_SIG => pack("V", ZIP_END_CENTRAL_HDR_SIG); sub findCentralDirectoryOffset { my $fh = shift ; # Most common use-case is where there is no comment, so # know exactly where the end of central directory record # should be. $fh->seek(-22, SEEK_END) ; my $here = $fh->tell(); my $buffer; $fh->read($buffer, 22) == 22 # TODO - fix this or die "xxx" ; my $zip64 = 0; my $centralDirOffset ; if ( unpack("V", $buffer) == ZIP_END_CENTRAL_HDR_SIG ) { $centralDirOffset = unpack("V", substr($buffer, 16, 4)); } else { $fh->seek(0, SEEK_END) ; my $fileLen = $fh->tell(); my $want = 0 ; while(1) { $want += 1024 * 32; my $seekTo = $fileLen - $want; if ($seekTo < 0 ) { $seekTo = 0; $want = $fileLen ; } $fh->seek( $seekTo, SEEK_SET) # TODO - fix this or die "xxx $!" ; my $got; ($got = $fh->read($buffer, $want)) == $want # TODO - fix this or die "xxx $got $!" ; my $pos = rindex( $buffer, Pack_ZIP_END_CENTRAL_HDR_SIG); if ($pos >= 0 && $want - $pos > 22) { $here = $seekTo + $pos ; $centralDirOffset = unpack("V", substr($buffer, $pos + 16, 4)); my $commentLength = unpack("V", substr($buffer, $pos + 20, 2)); $commentLength = 0 if ! defined $commentLength ; my $expectedEof = $fileLen - $want + $pos + 22 + $commentLength ; # check for trailing data after end of zip if ($expectedEof < $fileLen ) { $TRAILING = $expectedEof ; } last ; } return undef if $want == $fileLen; } } $centralDirOffset = offsetFromZip64($fh, $here) if full32 $centralDirOffset ; return $centralDirOffset ; } sub findID { my $id_want = shift ; my $data = shift; my $XLEN = length $data ; my $offset = 0 ; while ($offset < $XLEN) { return undef if $offset + ZIP_EXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; my $id = substr($data, $offset, ZIP_EXTRA_SUBFIELD_ID_SIZE); $id = unpack("v", $id); $offset += ZIP_EXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, ZIP_EXTRA_SUBFIELD_LEN_SIZE)); $offset += ZIP_EXTRA_SUBFIELD_LEN_SIZE ; return undef if $offset + $subLen > $XLEN ; return substr($data, $offset, $subLen) if $id eq $id_want ; $offset += $subLen ; } return undef ; } sub _dosToUnixTime { my $dt = shift; my $year = ( ( $dt >> 25 ) & 0x7f ) + 80; my $mon = ( ( $dt >> 21 ) & 0x0f ) - 1; my $mday = ( ( $dt >> 16 ) & 0x1f ); my $hour = ( ( $dt >> 11 ) & 0x1f ); my $min = ( ( $dt >> 5 ) & 0x3f ); my $sec = ( ( $dt << 1 ) & 0x3e ); use POSIX 'mktime'; my $time_t = mktime( $sec, $min, $hour, $mday, $mon, $year, 0, 0, -1 ); return 0 if ! defined $time_t; return $time_t; } { package U64; use constant MAX32 => 0xFFFFFFFF ; use constant HI_1 => MAX32 + 1 ; use constant LOW => 0 ; use constant HIGH => 1; sub new { my $class = shift ; my $high = 0 ; my $low = 0 ; if (@_ == 2) { $high = shift ; $low = shift ; } elsif (@_ == 1) { $low = shift ; } bless [$low, $high], $class; } sub newUnpack_V64 { my $string = shift; my ($low, $hi) = unpack "V V", $string ; bless [ $low, $hi ], "U64"; } sub newUnpack_V32 { my $string = shift; my $low = unpack "V", $string ; bless [ $low, 0 ], "U64"; } sub reset { my $self = shift; $self->[HIGH] = $self->[LOW] = 0; } sub clone { my $self = shift; bless [ @$self ], ref $self ; } sub mkU64 { my $value = shift; return $value if ref $value eq 'U64'; bless [ $value, 0 ], "U64" ; } sub getHigh { my $self = shift; return $self->[HIGH]; } sub getLow { my $self = shift; return $self->[LOW]; } sub get32bit { my $self = shift; return $self->[LOW]; } sub get64bit { my $self = shift; # Not using << here because the result will still be # a 32-bit value on systems where int size is 32-bits return $self->[HIGH] * HI_1 + $self->[LOW]; } sub add { my $self = shift; my $value = shift; if (ref $value eq 'U64') { $self->[HIGH] += $value->[HIGH] ; $value = $value->[LOW]; } my $available = MAX32 - $self->[LOW] ; if ($value > $available) { ++ $self->[HIGH] ; $self->[LOW] = $value - $available - 1; } else { $self->[LOW] += $value ; } } sub subtract { my $self = shift; my $value = shift; if (ref $value eq 'U64') { if ($value->[HIGH]) { die "unsupport subtract option" if $self->[HIGH] == 0 || $value->[HIGH] > $self->[HIGH] ; $self->[HIGH] -= $value->[HIGH] ; } $value = $value->[LOW] ; } if ($value > $self->[LOW]) { -- $self->[HIGH] ; $self->[LOW] = MAX32 - $value + $self->[LOW] + 1; } else { $self->[LOW] -= $value; } } sub rshift { my $self = shift; my $count = shift; for (1 .. $count) { $self->[LOW] >>= 1; $self->[LOW] |= 0x80000000 if $self->[HIGH] & 1 ; $self->[HIGH] >>= 1; } } sub is64bit { my $self = shift; return $self->[HIGH] > 0 ; } sub getPacked_V64 { my $self = shift; return pack "V V", @$self ; } sub getPacked_V32 { my $self = shift; return pack "V", $self->[LOW] ; } sub pack_V64 { my $low = shift; return pack "V V", $low, 0; } sub max32 { my $self = shift; return $self->[HIGH] == 0 && $self->[LOW] == MAX32; } sub stringify { my $self = shift; return "High [$self->[HIGH]], Low [$self->[LOW]]"; } sub equal { my $self = shift; my $other = shift; return $self->[LOW] == $other->[LOW] && $self->[HIGH] == $other->[HIGH] ; } sub gt { my $self = shift; my $other = shift; return $self->cmp($other) > 0 ; } sub cmp { my $self = shift; my $other = shift ; if ($self->[LOW] == $other->[LOW]) { return $self->[HIGH] - $other->[HIGH] ; } else { return $self->[LOW] - $other->[LOW] ; } } sub nibbles { my @nibbles = ( [ 16 => HI_1 * 0x10000000 ], [ 15 => HI_1 * 0x1000000 ], [ 14 => HI_1 * 0x100000 ], [ 13 => HI_1 * 0x10000 ], [ 12 => HI_1 * 0x1000 ], [ 11 => HI_1 * 0x100 ], [ 10 => HI_1 * 0x10 ], [ 9 => HI_1 * 0x1 ], [ 8 => 0x10000000 ], [ 7 => 0x1000000 ], [ 6 => 0x100000 ], [ 5 => 0x10000 ], [ 4 => 0x1000 ], [ 3 => 0x100 ], [ 2 => 0x10 ], [ 1 => 0x1 ], ); my $value = shift ; for my $pair (@nibbles) { my ($count, $limit) = @{ $pair }; return $count if $value >= $limit ; } } } sub Usage { die < for details). =head2 OPTIONS =over 5 =item -v Enable Verbose mode =item -h Display help =back By default zipdetails will output the details of the zip file in three columns. =over 5 =item Column 1 This contains the offset from the start of the file in hex. =item Column 2 This contains a textual description of the field. =item Column 3 If the field contains a numeric value it will be displayed in hex. Zip stored most numbers in little-endian format - the value displayed will have the little-endian encoding removed. Next, is an optional description of what the value means. =back If the C<-v> option is present, column 1 is expanded to include =over 5 =item * The offset from the start of the file in hex. =item * The length of the filed in hex. =item * A hex dump of the bytes in field in the order they are stored in the zip file. =back =head1 TODO Error handling is still a work in progress. If the program encounters a problem reading a zip file it is likely to terminate with an unhelpful error message. =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO The primary reference for Zip files is the "appnote" document available at L. An alternative reference is the Info-Zip appnote. This is available from L The C program that comes with the info-zip distribution (L) can also display details of the structure of a zip file. See also L, L, L. =head1 AUTHOR Paul Marquess F. =head1 COPYRIGHT Copyright (c) 2011-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/examples/000077500000000000000000000000001357305601700172435ustar00rootroot00000000000000libio-compress-perl-2.093/examples/compress-zlib/000077500000000000000000000000001357305601700220345ustar00rootroot00000000000000libio-compress-perl-2.093/examples/compress-zlib/filtdef000077500000000000000000000006731357305601700234050ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use Compress::Zlib ; binmode STDIN; binmode STDOUT; my $x = deflateInit() or die "Cannot create a deflation stream\n" ; my ($output, $status) ; while (<>) { ($output, $status) = $x->deflate($_) ; $status == Z_OK or die "deflation failed\n" ; print $output ; } ($output, $status) = $x->flush() ; $status == Z_OK or die "deflation failed\n" ; print $output ; libio-compress-perl-2.093/examples/compress-zlib/filtinf000077500000000000000000000007341357305601700234210ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use Compress::Zlib ; my $x = inflateInit() or die "Cannot create a inflation stream\n" ; my $input = '' ; binmode STDIN; binmode STDOUT; my ($output, $status) ; while (read(STDIN, $input, 4096)) { ($output, $status) = $x->inflate(\$input) ; print $output if $status == Z_OK or $status == Z_STREAM_END ; last if $status != Z_OK ; } die "inflation failed\n" unless $status == Z_STREAM_END ; libio-compress-perl-2.093/examples/compress-zlib/gzcat000077500000000000000000000007651357305601700231020ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use Compress::Zlib ; #die "Usage: gzcat file...\n" # unless @ARGV ; my $filename ; @ARGV = '-' unless @ARGV ; foreach my $filename (@ARGV) { my $buffer ; my $gz = gzopen($filename, "rb") or die "Cannot open $filename: $gzerrno\n" ; print $buffer while $gz->gzread($buffer) > 0 ; die "Error reading from $filename: $gzerrno" . ($gzerrno+0) . "\n" if $gzerrno != Z_STREAM_END ; $gz->gzclose() ; } libio-compress-perl-2.093/examples/compress-zlib/gzgrep000077500000000000000000000007251357305601700232640ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use Compress::Zlib ; die "Usage: gzgrep pattern file...\n" unless @ARGV >= 2; my $pattern = shift ; my $file ; foreach $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; while ($gz->gzreadline($_) > 0) { print if /$pattern/ ; } die "Error reading from $file: $gzerrno\n" if $gzerrno != Z_STREAM_END ; $gz->gzclose() ; } libio-compress-perl-2.093/examples/compress-zlib/gzstream000077500000000000000000000005001357305601700236110ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use Compress::Zlib ; binmode STDOUT; # gzopen only sets it on the fd #my $gz = gzopen(\*STDOUT, "wb") my $gz = gzopen('-', "wb") or die "Cannot open stdout: $gzerrno\n" ; while (<>) { $gz->gzwrite($_) or die "error writing: $gzerrno\n" ; } $gz->gzclose ; libio-compress-perl-2.093/examples/io/000077500000000000000000000000001357305601700176525ustar00rootroot00000000000000libio-compress-perl-2.093/examples/io/anycat000077500000000000000000000005501357305601700210570ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use IO::Uncompress::AnyUncompress qw( anyuncompress $AnyUncompressError ); @ARGV = '-' unless @ARGV ; foreach my $file (@ARGV) { anyuncompress $file => '-', Transparent => 1, Strict => 0, or die "Cannot uncompress '$file': $AnyUncompressError\n" ; } libio-compress-perl-2.093/examples/io/bzip2/000077500000000000000000000000001357305601700207005ustar00rootroot00000000000000libio-compress-perl-2.093/examples/io/bzip2/bzcat000077500000000000000000000007751357305601700217420ustar00rootroot00000000000000#!/usr/local/bin/perl use IO::Uncompress::Bunzip2 qw( $Bunzip2Error ); use strict ; use warnings ; #die "Usage: gzcat file...\n" # unless @ARGV ; my $file ; my $buffer ; my $s; @ARGV = '-' unless @ARGV ; foreach $file (@ARGV) { my $gz = new IO::Uncompress::Bunzip2 $file or die "Cannot open $file: $Bunzip2Error\n" ; print $buffer while ($s = $gz->read($buffer)) > 0 ; die "Error reading from $file: $Bunzip2Error\n" if $s < 0 ; $gz->close() ; } libio-compress-perl-2.093/examples/io/bzip2/bzgrep000077500000000000000000000007571357305601700221300ustar00rootroot00000000000000#!/usr/bin/perl use strict ; use warnings ; use IO::Uncompress::Bunzip2 qw($Bunzip2Error); die "Usage: gzgrep pattern [file...]\n" unless @ARGV >= 1; my $pattern = shift ; my $file ; @ARGV = '-' unless @ARGV ; foreach $file (@ARGV) { my $gz = new IO::Uncompress::Bunzip2 $file or die "Cannot uncompress $file: $Bunzip2Error\n" ; while (<$gz>) { print if /$pattern/ ; } die "Error reading from $file: $Bunzip2Error\n" if $Bunzip2Error ; } libio-compress-perl-2.093/examples/io/bzip2/bzstream000077500000000000000000000002151357305601700224530ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use IO::Compress::Bzip2 qw(:all); bzip2 '-' => '-' or die "bzstream: $Bzip2Error\n" ; libio-compress-perl-2.093/examples/io/gzip/000077500000000000000000000000001357305601700206235ustar00rootroot00000000000000libio-compress-perl-2.093/examples/io/gzip/gzappend000066400000000000000000000006251357305601700223610ustar00rootroot00000000000000#!/usr/local/bin/perl use IO::Compress::Gzip qw( $GzipError ); use strict ; use warnings ; die "Usage: gzappend gz-file file...\n" unless @ARGV ; my $output = shift @ARGV ; @ARGV = '-' unless @ARGV ; my $gz = new IO::Compress::Gzip $output, Merge => 1 or die "Cannot open $output: $GzipError\n" ; $gz->write( [@ARGV] ) or die "Cannot open $output: $GzipError\n" ; $gz->close; libio-compress-perl-2.093/examples/io/gzip/gzcat000077500000000000000000000007701357305601700216650ustar00rootroot00000000000000#!/usr/local/bin/perl use IO::Uncompress::Gunzip qw( $GunzipError ); use strict ; use warnings ; #die "Usage: gzcat file...\n" # unless @ARGV ; my $file ; my $buffer ; my $s; @ARGV = '-' unless @ARGV ; foreach $file (@ARGV) { my $gz = new IO::Uncompress::Gunzip $file or die "Cannot open $file: $GunzipError\n" ; print $buffer while ($s = $gz->read($buffer)) > 0 ; die "Error reading from $file: $GunzipError\n" if $s < 0 ; $gz->close() ; } libio-compress-perl-2.093/examples/io/gzip/gzgrep000077500000000000000000000014341357305601700220510ustar00rootroot00000000000000#!/usr/bin/perl use strict ; use warnings ; use IO::Uncompress::Gunzip qw($GunzipError); die "Usage: gzgrep pattern [file...]\n" unless @ARGV >= 1; my $pattern = shift ; my $file ; @ARGV = '-' unless @ARGV ; foreach $file (@ARGV) { my $gz = new IO::Uncompress::Gunzip $file or die "Cannot uncompress $file: $GunzipError\n" ; while (<$gz>) { print if /$pattern/ ; } die "Error reading from $file: $GunzipError\n" if $GunzipError ; } __END__ foreach $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; while ($gz->gzreadline($_) > 0) { print if /$pattern/ ; } die "Error reading from $file: $gzerrno\n" if $gzerrno != Z_STREAM_END ; $gz->gzclose() ; } libio-compress-perl-2.093/examples/io/gzip/gzstream000077500000000000000000000010111357305601700223760ustar00rootroot00000000000000#!/usr/local/bin/perl use strict ; use warnings ; use IO::Compress::Gzip qw(gzip $GzipError); gzip '-' => '-', Minimal => 1 or die "gzstream: $GzipError\n" ; #exit 0; __END__ #my $gz = new IO::Compress::Gzip *STDOUT my $gz = new IO::Compress::Gzip '-' or die "gzstream: Cannot open stdout as gzip stream: $GzipError\n" ; while (<>) { $gz->write($_) or die "gzstream: Error writing gzip output stream: $GzipError\n" ; } $gz->close or die "gzstream: Error closing gzip output stream: $GzipError\n" ; libio-compress-perl-2.093/lib/000077500000000000000000000000001357305601700161735ustar00rootroot00000000000000libio-compress-perl-2.093/lib/Compress/000077500000000000000000000000001357305601700177665ustar00rootroot00000000000000libio-compress-perl-2.093/lib/Compress/Zlib.pm000066400000000000000000001262731357305601700212370ustar00rootroot00000000000000 package Compress::Zlib; require 5.006 ; require Exporter; use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); use IO::Compress::Base::Common 2.093 ; use Compress::Raw::Zlib 2.093 ; use IO::Compress::Gzip 2.093 ; use IO::Uncompress::Gunzip 2.093 ; use strict ; use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = '2.093'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( deflateInit inflateInit compress uncompress gzopen $gzerrno ); push @EXPORT, @Compress::Raw::Zlib::EXPORT ; @EXPORT_OK = qw(memGunzip memGzip zlib_version); %EXPORT_TAGS = ( ALL => \@EXPORT ); BEGIN { *zlib_version = \&Compress::Raw::Zlib::zlib_version; } use constant FLAG_APPEND => 1 ; use constant FLAG_CRC => 2 ; use constant FLAG_ADLER => 4 ; use constant FLAG_CONSUME_INPUT => 8 ; our (@my_z_errmsg); @my_z_errmsg = ( "need dictionary", # Z_NEED_DICT 2 "stream end", # Z_STREAM_END 1 "", # Z_OK 0 "file error", # Z_ERRNO (-1) "stream error", # Z_STREAM_ERROR (-2) "data error", # Z_DATA_ERROR (-3) "insufficient memory", # Z_MEM_ERROR (-4) "buffer error", # Z_BUF_ERROR (-5) "incompatible version",# Z_VERSION_ERROR(-6) ); sub _set_gzerr { my $value = shift ; if ($value == 0) { $Compress::Zlib::gzerrno = 0 ; } elsif ($value == Z_ERRNO() || $value > 2) { $Compress::Zlib::gzerrno = $! ; } else { $Compress::Zlib::gzerrno = dualvar($value+0, $my_z_errmsg[2 - $value]); } return $value ; } sub _set_gzerr_undef { _set_gzerr(@_); return undef; } sub _save_gzerr { my $gz = shift ; my $test_eof = shift ; my $value = $gz->errorNo() || 0 ; my $eof = $gz->eof() ; if ($test_eof) { # gzread uses Z_STREAM_END to denote a successful end $value = Z_STREAM_END() if $gz->eof() && $value == 0 ; } _set_gzerr($value) ; } sub gzopen($$) { my ($file, $mode) = @_ ; my $gz ; my %defOpts = (Level => Z_DEFAULT_COMPRESSION(), Strategy => Z_DEFAULT_STRATEGY(), ); my $writing ; $writing = ! ($mode =~ /r/i) ; $writing = ($mode =~ /[wa]/i) ; $defOpts{Level} = $1 if $mode =~ /(\d)/; $defOpts{Strategy} = Z_FILTERED() if $mode =~ /f/i; $defOpts{Strategy} = Z_HUFFMAN_ONLY() if $mode =~ /h/i; $defOpts{Append} = 1 if $mode =~ /a/i; my $infDef = $writing ? 'deflate' : 'inflate'; my @params = () ; croak "gzopen: file parameter is not a filehandle or filename" unless isaFilehandle $file || isaFilename $file || (ref $file && ref $file eq 'SCALAR'); return undef unless $mode =~ /[rwa]/i ; _set_gzerr(0) ; if ($writing) { $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, %defOpts) or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; } else { $gz = new IO::Uncompress::Gunzip($file, Transparent => 1, Append => 0, AutoClose => 1, MultiStream => 1, Strict => 0) or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; } return undef if ! defined $gz ; bless [$gz, $infDef], 'Compress::Zlib::gzFile'; } sub Compress::Zlib::gzFile::gzread { my $self = shift ; return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'inflate'; my $len = defined $_[1] ? $_[1] : 4096 ; my $gz = $self->[0] ; if ($self->gzeof() || $len == 0) { # Zap the output buffer to match ver 1 behaviour. $_[0] = "" ; _save_gzerr($gz, 1); return 0 ; } my $status = $gz->read($_[0], $len) ; _save_gzerr($gz, 1); return $status ; } sub Compress::Zlib::gzFile::gzreadline { my $self = shift ; my $gz = $self->[0] ; { # Maintain backward compatibility with 1.x behaviour # It didn't support $/, so this can't either. local $/ = "\n" ; $_[0] = $gz->getline() ; } _save_gzerr($gz, 1); return defined $_[0] ? length $_[0] : 0 ; } sub Compress::Zlib::gzFile::gzwrite { my $self = shift ; my $gz = $self->[0] ; return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; $] >= 5.008 and (utf8::downgrade($_[0], 1) or croak "Wide character in gzwrite"); my $status = $gz->write($_[0]) ; _save_gzerr($gz); return $status ; } sub Compress::Zlib::gzFile::gztell { my $self = shift ; my $gz = $self->[0] ; my $status = $gz->tell() ; _save_gzerr($gz); return $status ; } sub Compress::Zlib::gzFile::gzseek { my $self = shift ; my $offset = shift ; my $whence = shift ; my $gz = $self->[0] ; my $status ; eval { local $SIG{__DIE__}; $status = $gz->seek($offset, $whence) ; }; if ($@) { my $error = $@; $error =~ s/^.*: /gzseek: /; $error =~ s/ at .* line \d+\s*$//; croak $error; } _save_gzerr($gz); return $status ; } sub Compress::Zlib::gzFile::gzflush { my $self = shift ; my $f = shift ; my $gz = $self->[0] ; my $status = $gz->flush($f) ; my $err = _save_gzerr($gz); return $status ? 0 : $err; } sub Compress::Zlib::gzFile::gzclose { my $self = shift ; my $gz = $self->[0] ; my $status = $gz->close() ; my $err = _save_gzerr($gz); return $status ? 0 : $err; } sub Compress::Zlib::gzFile::gzeof { my $self = shift ; my $gz = $self->[0] ; return 0 if $self->[1] ne 'inflate'; my $status = $gz->eof() ; _save_gzerr($gz); return $status ; } sub Compress::Zlib::gzFile::gzsetparams { my $self = shift ; croak "Usage: Compress::Zlib::gzFile::gzsetparams(file, level, strategy)" unless @_ eq 2 ; my $gz = $self->[0] ; my $level = shift ; my $strategy = shift; return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; my $status = *$gz->{Compress}->deflateParams(-Level => $level, -Strategy => $strategy); _save_gzerr($gz); return $status ; } sub Compress::Zlib::gzFile::gzerror { my $self = shift ; my $gz = $self->[0] ; return $Compress::Zlib::gzerrno ; } sub compress($;$) { my ($x, $output, $err, $in) =('', '', '', '') ; if (ref $_[0] ) { $in = $_[0] ; croak "not a scalar reference" unless ref $in eq 'SCALAR' ; } else { $in = \$_[0] ; } $] >= 5.008 and (utf8::downgrade($$in, 1) or croak "Wide character in compress"); my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND, $level, Z_DEFLATED, MAX_WBITS, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, '') or return undef ; $err = $x->deflate($in, $output) ; return undef unless $err == Z_OK() ; $err = $x->flush($output) ; return undef unless $err == Z_OK() ; return $output ; } sub uncompress($) { my ($output, $in) =('', '') ; if (ref $_[0] ) { $in = $_[0] ; croak "not a scalar reference" unless ref $in eq 'SCALAR' ; } else { $in = \$_[0] ; } $] >= 5.008 and (utf8::downgrade($$in, 1) or croak "Wide character in uncompress"); my ($obj, $status) = Compress::Raw::Zlib::_inflateInit(0, MAX_WBITS, 4096, "") ; $status == Z_OK or return undef; $obj->inflate($in, $output) == Z_STREAM_END or return undef; return $output; } sub deflateInit(@) { my ($got) = ParseParameters(0, { 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION()], 'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED()], 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], 'memlevel' => [IO::Compress::Base::Common::Parse_unsigned, MAX_MEM_LEVEL()], 'strategy' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFAULT_STRATEGY()], 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_ ) ; croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $obj ; my $status = 0 ; ($obj, $status) = Compress::Raw::Zlib::_deflateInit(0, $got->getValue('level'), $got->getValue('method'), $got->getValue('windowbits'), $got->getValue('memlevel'), $got->getValue('strategy'), $got->getValue('bufsize'), $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; return wantarray ? ($x, $status) : $x ; } sub inflateInit(@) { my ($got) = ParseParameters(0, { 'bufsize' => [IO::Compress::Base::Common::Parse_unsigned, 4096], 'windowbits' => [IO::Compress::Base::Common::Parse_signed, MAX_WBITS()], 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_) ; croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $status = 0 ; my $obj ; ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, $got->getValue('windowbits'), $got->getValue('bufsize'), $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; wantarray ? ($x, $status) : $x ; } package Zlib::OldDeflate ; our (@ISA); @ISA = qw(Compress::Raw::Zlib::deflateStream); sub deflate { my $self = shift ; my $output ; my $status = $self->SUPER::deflate($_[0], $output) ; wantarray ? ($output, $status) : $output ; } sub flush { my $self = shift ; my $output ; my $flag = shift || Compress::Zlib::Z_FINISH(); my $status = $self->SUPER::flush($output, $flag) ; wantarray ? ($output, $status) : $output ; } package Zlib::OldInflate ; our (@ISA); @ISA = qw(Compress::Raw::Zlib::inflateStream); sub inflate { my $self = shift ; my $output ; my $status = $self->SUPER::inflate($_[0], $output) ; wantarray ? ($output, $status) : $output ; } package Compress::Zlib ; use IO::Compress::Gzip::Constants 2.093 ; sub memGzip($) { _set_gzerr(0); my $x = Compress::Raw::Zlib::_deflateInit(FLAG_APPEND|FLAG_CRC, Z_BEST_COMPRESSION, Z_DEFLATED, -MAX_WBITS(), MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, '') or return undef ; # if the deflation buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]) ; $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGzip"); my $out; my $status ; $x->deflate($string, $out) == Z_OK or return undef ; $x->flush($out) == Z_OK or return undef ; return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . $out . pack("V V", $x->crc32(), $x->total_in()); } sub _removeGzipHeader($) { my $string = shift ; return Z_DATA_ERROR() if length($$string) < GZIP_MIN_HEADER_SIZE ; my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = unpack ('CCCCVCC', $$string); return Z_DATA_ERROR() unless $magic1 == GZIP_ID1 and $magic2 == GZIP_ID2 and $method == Z_DEFLATED() and !($flags & GZIP_FLG_RESERVED) ; substr($$string, 0, GZIP_MIN_HEADER_SIZE) = '' ; # skip extra field if ($flags & GZIP_FLG_FEXTRA) { return Z_DATA_ERROR() if length($$string) < GZIP_FEXTRA_HEADER_SIZE ; my ($extra_len) = unpack ('v', $$string); $extra_len += GZIP_FEXTRA_HEADER_SIZE; return Z_DATA_ERROR() if length($$string) < $extra_len ; substr($$string, 0, $extra_len) = ''; } # skip orig name if ($flags & GZIP_FLG_FNAME) { my $name_end = index ($$string, GZIP_NULL_BYTE); return Z_DATA_ERROR() if $name_end == -1 ; substr($$string, 0, $name_end + 1) = ''; } # skip comment if ($flags & GZIP_FLG_FCOMMENT) { my $comment_end = index ($$string, GZIP_NULL_BYTE); return Z_DATA_ERROR() if $comment_end == -1 ; substr($$string, 0, $comment_end + 1) = ''; } # skip header crc if ($flags & GZIP_FLG_FHCRC) { return Z_DATA_ERROR() if length ($$string) < GZIP_FHCRC_SIZE ; substr($$string, 0, GZIP_FHCRC_SIZE) = ''; } return Z_OK(); } sub _ret_gun_error { $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; return undef; } sub memGunzip($) { # if the buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]); $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGunzip"); _set_gzerr(0); my $status = _removeGzipHeader($string) ; $status == Z_OK() or return _set_gzerr_undef($status); my $bufsize = length $$string > 4096 ? length $$string : 4096 ; my $x = Compress::Raw::Zlib::_inflateInit(FLAG_CRC | FLAG_CONSUME_INPUT, -MAX_WBITS(), $bufsize, '') or return _ret_gun_error(); my $output = '' ; $status = $x->inflate($string, $output); if ( $status == Z_OK() ) { _set_gzerr(Z_DATA_ERROR()); return undef; } return _ret_gun_error() if ($status != Z_STREAM_END()); if (length $$string >= 8) { my ($crc, $len) = unpack ("VV", substr($$string, 0, 8)); substr($$string, 0, 8) = ''; return _set_gzerr_undef(Z_DATA_ERROR()) unless $len == length($output) and $crc == Compress::Raw::Zlib::crc32($output); } else { $$string = ''; } return $output; } # Autoload methods go after __END__, and are processed by the autosplit program. 1; __END__ =head1 NAME Compress::Zlib - Interface to zlib compression library =head1 SYNOPSIS use Compress::Zlib ; ($d, $status) = deflateInit( [OPT] ) ; $status = $d->deflate($input, $output) ; $status = $d->flush([$flush_type]) ; $d->deflateParams(OPTS) ; $d->deflateTune(OPTS) ; $d->dict_adler() ; $d->crc32() ; $d->adler32() ; $d->total_in() ; $d->total_out() ; $d->msg() ; $d->get_Strategy(); $d->get_Level(); $d->get_BufSize(); ($i, $status) = inflateInit( [OPT] ) ; $status = $i->inflate($input, $output [, $eof]) ; $status = $i->inflateSync($input) ; $i->dict_adler() ; $d->crc32() ; $d->adler32() ; $i->total_in() ; $i->total_out() ; $i->msg() ; $d->get_BufSize(); $dest = compress($source) ; $dest = uncompress($source) ; $gz = gzopen($filename or filehandle, $mode) ; $bytesread = $gz->gzread($buffer [,$size]) ; $bytesread = $gz->gzreadline($line) ; $byteswritten = $gz->gzwrite($buffer) ; $status = $gz->gzflush($flush) ; $offset = $gz->gztell() ; $status = $gz->gzseek($offset, $whence) ; $status = $gz->gzclose() ; $status = $gz->gzeof() ; $status = $gz->gzsetparams($level, $strategy) ; $errstring = $gz->gzerror() ; $gzerrno $dest = Compress::Zlib::memGzip($buffer) ; $dest = Compress::Zlib::memGunzip($buffer) ; $crc = adler32($buffer [,$crc]) ; $crc = crc32($buffer [,$crc]) ; $crc = crc32_combine($crc1, $crc2, $len2); $adler = adler32_combine($adler1, $adler2, $len2); my $version = Compress::Raw::Zlib::zlib_version(); =head1 DESCRIPTION The I module provides a Perl interface to the I compression library (see L for details about where to get I). The C module can be split into two general areas of functionality, namely a simple read/write interface to I files and a low-level in-memory compression/decompression interface. Each of these areas will be discussed in the following sections. =head2 Notes for users of Compress::Zlib version 1 The main change in C version 2.x is that it does not now interface directly to the zlib library. Instead it uses the C and C modules for reading/writing gzip files, and the C module for some low-level zlib access. The interface provided by version 2 of this module should be 100% backward compatible with version 1. If you find a difference in the expected behaviour please contact the author (See L). See L With the creation of the C and C modules no new features are planned for C - the new modules do everything that C does and then some. Development on C will be limited to bug fixes only. If you are writing new code, your first port of call should be one of the new C or C modules. =head1 GZIP INTERFACE A number of functions are supplied in I for reading and writing I files that conform to RFC 1952. This module provides an interface to most of them. If you have previously used C 1.x, the following enhancements/changes have been made to the C interface: =over 5 =item 1 If you want to open either STDIN or STDOUT with C, you can now optionally use the special filename "C<->" as a synonym for C<\*STDIN> and C<\*STDOUT>. =item 2 In C version 1.x, C used the zlib library to open the underlying file. This made things especially tricky when a Perl filehandle was passed to C. Behind the scenes the numeric C file descriptor had to be extracted from the Perl filehandle and this passed to the zlib library. Apart from being non-portable to some operating systems, this made it difficult to use C in situations where you wanted to extract/create a gzip data stream that is embedded in a larger file, without having to resort to opening and closing the file multiple times. It also made it impossible to pass a perl filehandle that wasn't associated with a real filesystem file, like, say, an C. In C version 2.x, the C interface has been completely rewritten to use the L for writing gzip files and L for reading gzip files. None of the limitations mentioned above apply. =item 3 Addition of C to provide a restricted C interface. =item 4. Added C. =back A more complete and flexible interface for reading/writing gzip files/buffers is included with the module C. See L and L for more details. =over 5 =item B<$gz = gzopen($filename, $mode)> =item B<$gz = gzopen($filehandle, $mode)> This function opens either the I file C<$filename> for reading or writing or attaches to the opened filehandle, C<$filehandle>. It returns an object on success and C on failure. When writing a gzip file this interface will I create the smallest possible gzip header (exactly 10 bytes). If you want greater control over what gets stored in the gzip header (like the original filename or a comment) use L instead. Similarly if you want to read the contents of the gzip header use L. The second parameter, C<$mode>, is used to specify whether the file is opened for reading or writing and to optionally specify a compression level and compression strategy when writing. The format of the C<$mode> parameter is similar to the mode parameter to the 'C' function C, so "rb" is used to open for reading, "wb" for writing and "ab" for appending (writing at the end of the file). To specify a compression level when writing, append a digit between 0 and 9 to the mode string -- 0 means no compression and 9 means maximum compression. If no compression level is specified Z_DEFAULT_COMPRESSION is used. To specify the compression strategy when writing, append 'f' for filtered data, 'h' for Huffman only compression, or 'R' for run-length encoding. If no strategy is specified Z_DEFAULT_STRATEGY is used. So, for example, "wb9" means open for writing with the maximum compression using the default strategy and "wb4R" means open for writing with compression level 4 and run-length encoding. Refer to the I documentation for the exact format of the C<$mode> parameter. =item B<$bytesread = $gz-Egzread($buffer [, $size]) ;> Reads C<$size> bytes from the compressed file into C<$buffer>. If C<$size> is not specified, it will default to 4096. If the scalar C<$buffer> is not large enough, it will be extended automatically. Returns the number of bytes actually read. On EOF it returns 0 and in the case of an error, -1. =item B<$bytesread = $gz-Egzreadline($line) ;> Reads the next line from the compressed file into C<$line>. Returns the number of bytes actually read. On EOF it returns 0 and in the case of an error, -1. It is legal to intermix calls to C and C. To maintain backward compatibility with version 1.x of this module C ignores the C<$/> variable - it I uses the string C<"\n"> as the line delimiter. If you want to read a gzip file a line at a time and have it respect the C<$/> variable (or C<$INPUT_RECORD_SEPARATOR>, or C<$RS> when C is in use) see L. =item B<$byteswritten = $gz-Egzwrite($buffer) ;> Writes the contents of C<$buffer> to the compressed file. Returns the number of bytes actually written, or 0 on error. =item B<$status = $gz-Egzflush($flush_type) ;> Flushes all pending output into the compressed file. This method takes an optional parameter, C<$flush_type>, that controls how the flushing will be carried out. By default the C<$flush_type> used is C. Other valid values for C<$flush_type> are C, C, C and C. It is strongly recommended that you only set the C parameter if you fully understand the implications of what it does - overuse of C can seriously degrade the level of compression achieved. See the C documentation for details. Returns 0 on success. =item B<$offset = $gz-Egztell() ;> Returns the uncompressed file offset. =item B<$status = $gz-Egzseek($offset, $whence) ;> Provides a sub-set of the C functionality, with the restriction that it is only legal to seek forward in the compressed file. It is a fatal error to attempt to seek backward. When opened for writing, empty parts of the file will have NULL (0x00) bytes written to them. The C<$whence> parameter should be one of SEEK_SET, SEEK_CUR or SEEK_END. Returns 1 on success, 0 on failure. =item B<$gz-Egzclose> Closes the compressed file. Any pending data is flushed to the file before it is closed. Returns 0 on success. =item B<$gz-Egzsetparams($level, $strategy> Change settings for the deflate stream C<$gz>. The list of the valid options is shown below. Options not specified will remain unchanged. Note: This method is only available if you are running zlib 1.0.6 or better. =over 5 =item B<$level> Defines the compression level. Valid values are 0 through 9, C, C, C, and C. =item B<$strategy> Defines the strategy used to tune the compression. The valid values are C, C and C. =back =item B<$gz-Egzerror> Returns the I error message or number for the last operation associated with C<$gz>. The return value will be the I error number when used in a numeric context and the I error message when used in a string context. The I error number constants, shown below, are available for use. Z_OK Z_STREAM_END Z_ERRNO Z_STREAM_ERROR Z_DATA_ERROR Z_MEM_ERROR Z_BUF_ERROR =item B<$gzerrno> The C<$gzerrno> scalar holds the error code associated with the most recent I routine. Note that unlike C, the error is I associated with a particular file. As with C it returns an error number in numeric context and an error message in string context. Unlike C though, the error message will correspond to the I message when the error is associated with I itself, or the UNIX error message when it is not (i.e. I returned C). As there is an overlap between the error numbers used by I and UNIX, C<$gzerrno> should only be used to check for the presence of I error in numeric context. Use C to check for specific I errors. The I example below shows how the variable can be used safely. =back =head2 Examples Here is an example script which uses the interface. It implements a I function. use strict ; use warnings ; use Compress::Zlib ; # use stdin if no files supplied @ARGV = '-' unless @ARGV ; foreach my $file (@ARGV) { my $buffer ; my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; print $buffer while $gz->gzread($buffer) > 0 ; die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n" if $gzerrno != Z_STREAM_END ; $gz->gzclose() ; } Below is a script which makes use of C. It implements a very simple I like script. use strict ; use warnings ; use Compress::Zlib ; die "Usage: gzgrep pattern [file...]\n" unless @ARGV >= 1; my $pattern = shift ; # use stdin if no files supplied @ARGV = '-' unless @ARGV ; foreach my $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; while ($gz->gzreadline($_) > 0) { print if /$pattern/ ; } die "Error reading from $file: $gzerrno\n" if $gzerrno != Z_STREAM_END ; $gz->gzclose() ; } This script, I, does the opposite of the I script above. It reads from standard input and writes a gzip data stream to standard output. use strict ; use warnings ; use Compress::Zlib ; binmode STDOUT; # gzopen only sets it on the fd my $gz = gzopen(\*STDOUT, "wb") or die "Cannot open stdout: $gzerrno\n" ; while (<>) { $gz->gzwrite($_) or die "error writing: $gzerrno\n" ; } $gz->gzclose ; =head2 Compress::Zlib::memGzip This function is used to create an in-memory gzip file with the minimum possible gzip header (exactly 10 bytes). $dest = Compress::Zlib::memGzip($buffer) or die "Cannot compress: $gzerrno\n"; If successful, it returns the in-memory gzip file. Otherwise it returns C and the C<$gzerrno> variable will store the zlib error code. The C<$buffer> parameter can either be a scalar or a scalar reference. See L for an alternative way to carry out in-memory gzip compression. =head2 Compress::Zlib::memGunzip This function is used to uncompress an in-memory gzip file. $dest = Compress::Zlib::memGunzip($buffer) or die "Cannot uncompress: $gzerrno\n"; If successful, it returns the uncompressed gzip file. Otherwise it returns C and the C<$gzerrno> variable will store the zlib error code. The C<$buffer> parameter can either be a scalar or a scalar reference. The contents of the C<$buffer> parameter are destroyed after calling this function. If C<$buffer> consists of multiple concatenated gzip data streams only the first will be uncompressed. Use C with the C option in the C module if you need to deal with concatenated data streams. See L for an alternative way to carry out in-memory gzip uncompression. =head1 COMPRESS/UNCOMPRESS Two functions are provided to perform in-memory compression/uncompression of RFC 1950 data streams. They are called C and C. =over 5 =item B<$dest = compress($source [, $level] ) ;> Compresses C<$source>. If successful it returns the compressed data. Otherwise it returns I. The source buffer, C<$source>, can either be a scalar or a scalar reference. The C<$level> parameter defines the compression level. Valid values are 0 through 9, C, C, C, and C. If C<$level> is not specified C will be used. =item B<$dest = uncompress($source) ;> Uncompresses C<$source>. If successful it returns the uncompressed data. Otherwise it returns I. The source buffer can either be a scalar or a scalar reference. =back Please note: the two functions defined above are I compatible with the Unix commands of the same name. See L and L included with this distribution for an alternative interface for reading/writing RFC 1950 files/buffers. =head1 Deflate Interface This section defines an interface that allows in-memory compression using the I interface provided by zlib. Here is a definition of the interface available: =head2 B<($d, $status) = deflateInit( [OPT] )> Initialises a deflation stream. It combines the features of the I functions C, C and C. If successful, it will return the initialised deflation stream, C<$d> and C<$status> of C in a list context. In scalar context it returns the deflation stream, C<$d>, only. If not successful, the returned deflation stream (C<$d>) will be I and C<$status> will hold the exact I error code. The function optionally takes a number of named options specified as C<< -Name=>value >> pairs. This allows individual options to be tailored without having to specify them all in the parameter list. For backward compatibility, it is also possible to pass the parameters as a reference to a hash containing the name=>value pairs. The function takes one optional parameter, a reference to a hash. The contents of the hash allow the deflation interface to be tailored. Here is a list of the valid options: =over 5 =item B<-Level> Defines the compression level. Valid values are 0 through 9, C, C, C, and C. The default is Z_DEFAULT_COMPRESSION. =item B<-Method> Defines the compression method. The only valid value at present (and the default) is Z_DEFLATED. =item B<-WindowBits> To create an RFC 1950 data stream, set C to a positive number. To create an RFC 1951 data stream, set C to C<-MAX_WBITS>. For a full definition of the meaning and valid values for C refer to the I documentation for I. Defaults to MAX_WBITS. =item B<-MemLevel> For a definition of the meaning and valid values for C refer to the I documentation for I. Defaults to MAX_MEM_LEVEL. =item B<-Strategy> Defines the strategy used to tune the compression. The valid values are C, C and C. The default is Z_DEFAULT_STRATEGY. =item B<-Dictionary> When a dictionary is specified I will automatically call C directly after calling C. The Adler32 value for the dictionary can be obtained by calling the method C<< $d->dict_adler() >>. The default is no dictionary. =item B<-Bufsize> Sets the initial size for the deflation buffer. If the buffer has to be reallocated to increase the size, it will grow in increments of C. The default is 4096. =back Here is an example of using the C optional parameter list to override the default buffer size and compression level. All other options will take their default values. deflateInit( -Bufsize => 300, -Level => Z_BEST_SPEED ) ; =head2 B<($out, $status) = $d-Edeflate($buffer)> Deflates the contents of C<$buffer>. The buffer can either be a scalar or a scalar reference. When finished, C<$buffer> will be completely processed (assuming there were no errors). If the deflation was successful it returns the deflated output, C<$out>, and a status value, C<$status>, of C. On error, C<$out> will be I and C<$status> will contain the I error code. In a scalar context C will return C<$out> only. As with the I function in I, it is not necessarily the case that any output will be produced by this method. So don't rely on the fact that C<$out> is empty for an error test. =head2 B<($out, $status) = $d-Eflush()> =head2 B<($out, $status) = $d-Eflush($flush_type)> Typically used to finish the deflation. Any pending output will be returned via C<$out>. C<$status> will have a value C if successful. In a scalar context C will return C<$out> only. Note that flushing can seriously degrade the compression ratio, so it should only be used to terminate a decompression (using C) or when you want to create a I (using C). By default the C used is C. Other valid values for C are C, C, C and C. It is strongly recommended that you only set the C parameter if you fully understand the implications of what it does. See the C documentation for details. =head2 B<$status = $d-EdeflateParams([OPT])> Change settings for the deflate stream C<$d>. The list of the valid options is shown below. Options not specified will remain unchanged. =over 5 =item B<-Level> Defines the compression level. Valid values are 0 through 9, C, C, C, and C. =item B<-Strategy> Defines the strategy used to tune the compression. The valid values are C, C and C. =back =head2 B<$d-Edict_adler()> Returns the adler32 value for the dictionary. =head2 B<$d-Emsg()> Returns the last error message generated by zlib. =head2 B<$d-Etotal_in()> Returns the total number of bytes uncompressed bytes input to deflate. =head2 B<$d-Etotal_out()> Returns the total number of compressed bytes output from deflate. =head2 Example Here is a trivial example of using C. It simply reads standard input, deflates it and writes it to standard output. use strict ; use warnings ; use Compress::Zlib ; binmode STDIN; binmode STDOUT; my $x = deflateInit() or die "Cannot create a deflation stream\n" ; my ($output, $status) ; while (<>) { ($output, $status) = $x->deflate($_) ; $status == Z_OK or die "deflation failed\n" ; print $output ; } ($output, $status) = $x->flush() ; $status == Z_OK or die "deflation failed\n" ; print $output ; =head1 Inflate Interface This section defines the interface available that allows in-memory uncompression using the I interface provided by zlib. Here is a definition of the interface: =head2 B<($i, $status) = inflateInit()> Initialises an inflation stream. In a list context it returns the inflation stream, C<$i>, and the I status code in C<$status>. In a scalar context it returns the inflation stream only. If successful, C<$i> will hold the inflation stream and C<$status> will be C. If not successful, C<$i> will be I and C<$status> will hold the I error code. The function optionally takes a number of named options specified as C<< -Name=>value >> pairs. This allows individual options to be tailored without having to specify them all in the parameter list. For backward compatibility, it is also possible to pass the parameters as a reference to a hash containing the name=>value pairs. The function takes one optional parameter, a reference to a hash. The contents of the hash allow the deflation interface to be tailored. Here is a list of the valid options: =over 5 =item B<-WindowBits> To uncompress an RFC 1950 data stream, set C to a positive number. To uncompress an RFC 1951 data stream, set C to C<-MAX_WBITS>. For a full definition of the meaning and valid values for C refer to the I documentation for I. Defaults to MAX_WBITS. =item B<-Bufsize> Sets the initial size for the inflation buffer. If the buffer has to be reallocated to increase the size, it will grow in increments of C. Default is 4096. =item B<-Dictionary> The default is no dictionary. =back Here is an example of using the C optional parameter to override the default buffer size. inflateInit( -Bufsize => 300 ) ; =head2 B<($out, $status) = $i-Einflate($buffer)> Inflates the complete contents of C<$buffer>. The buffer can either be a scalar or a scalar reference. Returns C if successful and C if the end of the compressed data has been successfully reached. If not successful, C<$out> will be I and C<$status> will hold the I error code. The C<$buffer> parameter is modified by C. On completion it will contain what remains of the input buffer after inflation. This means that C<$buffer> will be an empty string when the return status is C. When the return status is C the C<$buffer> parameter will contains what (if anything) was stored in the input buffer after the deflated data stream. This feature is useful when processing a file format that encapsulates a compressed data stream (e.g. gzip, zip). =head2 B<$status = $i-EinflateSync($buffer)> Scans C<$buffer> until it reaches either a I or the end of the buffer. If a I is found, C is returned and C<$buffer> will be have all data up to the flush point removed. This can then be passed to the C method. Any other return code means that a flush point was not found. If more data is available, C can be called repeatedly with more compressed data until the flush point is found. =head2 B<$i-Edict_adler()> Returns the adler32 value for the dictionary. =head2 B<$i-Emsg()> Returns the last error message generated by zlib. =head2 B<$i-Etotal_in()> Returns the total number of bytes compressed bytes input to inflate. =head2 B<$i-Etotal_out()> Returns the total number of uncompressed bytes output from inflate. =head2 Example Here is an example of using C. use strict ; use warnings ; use Compress::Zlib ; my $x = inflateInit() or die "Cannot create a inflation stream\n" ; my $input = '' ; binmode STDIN; binmode STDOUT; my ($output, $status) ; while (read(STDIN, $input, 4096)) { ($output, $status) = $x->inflate(\$input) ; print $output if $status == Z_OK or $status == Z_STREAM_END ; last if $status != Z_OK ; } die "inflation failed\n" unless $status == Z_STREAM_END ; =head1 CHECKSUM FUNCTIONS Two functions are provided by I to calculate checksums. For the Perl interface, the order of the two parameters in both functions has been reversed. This allows both running checksums and one off calculations to be done. $crc = adler32($buffer [,$crc]) ; $crc = crc32($buffer [,$crc]) ; The buffer parameters can either be a scalar or a scalar reference. If the $crc parameters is C, the crc value will be reset. If you have built this module with zlib 1.2.3 or better, two more CRC-related functions are available. $crc = crc32_combine($crc1, $crc2, $len2); $adler = adler32_combine($adler1, $adler2, $len2); These functions allow checksums to be merged. Refer to the I documentation for more details. =head1 Misc =head2 my $version = Compress::Zlib::zlib_version(); Returns the version of the zlib library. =head1 CONSTANTS All the I constants are automatically imported when you make use of I. =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L L, L, L, L For RFC 1950, 1951 and 1952 see L, L and L The I compression library was written by Jean-loup Gailly C and Mark Adler C. The primary site for the I compression library is L. The primary site for gzip is L. =head1 AUTHOR This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY See the Changes file. =head1 COPYRIGHT AND LICENSE Copyright (c) 1995-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/File/000077500000000000000000000000001357305601700170525ustar00rootroot00000000000000libio-compress-perl-2.093/lib/File/GlobMapper.pm000066400000000000000000000364761357305601700214600ustar00rootroot00000000000000package File::GlobMapper; use strict; use warnings; use Carp; our ($CSH_GLOB); BEGIN { if ($] < 5.006) { require File::BSDGlob; import File::BSDGlob qw(:glob) ; $CSH_GLOB = File::BSDGlob::GLOB_CSH() ; *globber = \&File::BSDGlob::csh_glob; } else { require File::Glob; import File::Glob qw(:glob) ; $CSH_GLOB = File::Glob::GLOB_CSH() ; #*globber = \&File::Glob::bsd_glob; *globber = \&File::Glob::csh_glob; } } our ($Error); our ($VERSION, @EXPORT_OK); $VERSION = '1.001'; @EXPORT_OK = qw( globmap ); our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); $noPreBS = '(? '([^/]*)', '?' => '([^/])', '.' => '\.', '[' => '([', '(' => '(', ')' => ')', ); %wildCount = map { $_ => 1 } qw/ * ? . { ( [ /; sub globmap ($$;) { my $inputGlob = shift ; my $outputGlob = shift ; my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_) or croak "globmap: $Error" ; return $obj->getFileMap(); } sub new { my $class = shift ; my $inputGlob = shift ; my $outputGlob = shift ; # TODO -- flags needs to default to whatever File::Glob does my $flags = shift || $CSH_GLOB ; #my $flags = shift ; $inputGlob =~ s/^\s*\<\s*//; $inputGlob =~ s/\s*\>\s*$//; $outputGlob =~ s/^\s*\<\s*//; $outputGlob =~ s/\s*\>\s*$//; my %object = ( InputGlob => $inputGlob, OutputGlob => $outputGlob, GlobFlags => $flags, Braces => 0, WildCount => 0, Pairs => [], Sigil => '#', ); my $self = bless \%object, ref($class) || $class ; $self->_parseInputGlob() or return undef ; $self->_parseOutputGlob() or return undef ; my @inputFiles = globber($self->{InputGlob}, $flags) ; if (GLOB_ERROR) { $Error = $!; return undef ; } #if (whatever) { my $missing = grep { ! -e $_ } @inputFiles ; if ($missing) { $Error = "$missing input files do not exist"; return undef ; } } $self->{InputFiles} = \@inputFiles ; $self->_getFiles() or return undef ; return $self; } sub _retError { my $string = shift ; $Error = "$string in input fileglob" ; return undef ; } sub _unmatched { my $delimeter = shift ; _retError("Unmatched $delimeter"); return undef ; } sub _parseBit { my $self = shift ; my $string = shift ; my $out = ''; my $depth = 0 ; while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//) { $out .= quotemeta($1) ; $out .= $mapping{$2} if defined $mapping{$2}; ++ $self->{WildCount} if $wildCount{$2} ; if ($2 eq ',') { return _unmatched("(") if $depth ; $out .= '|'; } elsif ($2 eq '(') { ++ $depth ; } elsif ($2 eq ')') { return _unmatched(")") if ! $depth ; -- $depth ; } elsif ($2 eq '[') { # TODO -- quotemeta & check no '/' # TODO -- check for \] & other \ within the [] $string =~ s#(.*?\])## or return _unmatched("["); $out .= "$1)" ; } elsif ($2 eq ']') { return _unmatched("]"); } elsif ($2 eq '{' || $2 eq '}') { return _retError("Nested {} not allowed"); } } $out .= quotemeta $string; return _unmatched("(") if $depth ; return $out ; } sub _parseInputGlob { my $self = shift ; my $string = $self->{InputGlob} ; my $inGlob = ''; # Multiple concatenated *'s don't make sense #$string =~ s#\*\*+#*# ; # TODO -- Allow space to delimit patterns? #my @strings = split /\s+/, $string ; #for my $str (@strings) my $out = ''; my $depth = 0 ; while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//) { $out .= quotemeta($1) ; $out .= $mapping{$2} if defined $mapping{$2}; ++ $self->{WildCount} if $wildCount{$2} ; if ($2 eq '(') { ++ $depth ; } elsif ($2 eq ')') { return _unmatched(")") if ! $depth ; -- $depth ; } elsif ($2 eq '[') { # TODO -- quotemeta & check no '/' or '(' or ')' # TODO -- check for \] & other \ within the [] $string =~ s#(.*?\])## or return _unmatched("["); $out .= "$1)" ; } elsif ($2 eq ']') { return _unmatched("]"); } elsif ($2 eq '}') { return _unmatched("}"); } elsif ($2 eq '{') { # TODO -- check no '/' within the {} # TODO -- check for \} & other \ within the {} my $tmp ; unless ( $string =~ s/(.*?)$noPreBS\}//) { return _unmatched("{"); } #$string =~ s#(.*?)\}##; #my $alt = join '|', # map { quotemeta $_ } # split "$noPreBS,", $1 ; my $alt = $self->_parseBit($1); defined $alt or return 0 ; $out .= "($alt)" ; ++ $self->{Braces} ; } } return _unmatched("(") if $depth ; $out .= quotemeta $string ; $self->{InputGlob} =~ s/$noPreBS[\(\)]//g; $self->{InputPattern} = $out ; #print "# INPUT '$self->{InputGlob}' => '$out'\n"; return 1 ; } sub _parseOutputGlob { my $self = shift ; my $string = $self->{OutputGlob} ; my $maxwild = $self->{WildCount}; if ($self->{GlobFlags} & GLOB_TILDE) #if (1) { $string =~ s{ ^ ~ # find a leading tilde ( # save this in $1 [^/] # a non-slash character * # repeated 0 or more times (0 means me) ) }{ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} ) }ex; } # max #1 must be == to max no of '*' in input while ( $string =~ m/#(\d)/g ) { croak "Max wild is #$maxwild, you tried #$1" if $1 > $maxwild ; } my $noPreBS = '(?{OutputGlob}' => '$string'\n"; $self->{OutputPattern} = $string ; return 1 ; } sub _getFiles { my $self = shift ; my %outInMapping = (); my %inFiles = () ; foreach my $inFile (@{ $self->{InputFiles} }) { next if $inFiles{$inFile} ++ ; my $outFile = $inFile ; if ( $inFile =~ m/$self->{InputPattern}/ ) { no warnings 'uninitialized'; eval "\$outFile = $self->{OutputPattern};" ; if (defined $outInMapping{$outFile}) { $Error = "multiple input files map to one output file"; return undef ; } $outInMapping{$outFile} = $inFile; push @{ $self->{Pairs} }, [$inFile, $outFile]; } } return 1 ; } sub getFileMap { my $self = shift ; return $self->{Pairs} ; } sub getHash { my $self = shift ; return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ; } 1; __END__ =head1 NAME File::GlobMapper - Extend File Glob to Allow Input and Output Files =head1 SYNOPSIS use File::GlobMapper qw( globmap ); my $aref = globmap $input => $output or die $File::GlobMapper::Error ; my $gm = new File::GlobMapper $input => $output or die $File::GlobMapper::Error ; =head1 DESCRIPTION This module needs Perl5.005 or better. This module takes the existing C module as a starting point and extends it to allow new filenames to be derived from the files matched by C. This can be useful when carrying out batch operations on multiple files that have both an input filename and output filename and the output file can be derived from the input filename. Examples of operations where this can be useful include, file renaming, file copying and file compression. =head2 Behind The Scenes To help explain what C does, consider what code you would write if you wanted to rename all files in the current directory that ended in C<.tar.gz> to C<.tgz>. So say these files are in the current directory alpha.tar.gz beta.tar.gz gamma.tar.gz and they need renamed to this alpha.tgz beta.tgz gamma.tgz Below is a possible implementation of a script to carry out the rename (error cases have been omitted) foreach my $old ( glob "*.tar.gz" ) { my $new = $old; $new =~ s#(.*)\.tar\.gz$#$1.tgz# ; rename $old => $new or die "Cannot rename '$old' to '$new': $!\n; } Notice that a file glob pattern C<*.tar.gz> was used to match the C<.tar.gz> files, then a fairly similar regular expression was used in the substitute to allow the new filename to be created. Given that the file glob is just a cut-down regular expression and that it has already done a lot of the hard work in pattern matching the filenames, wouldn't it be handy to be able to use the patterns in the fileglob to drive the new filename? Well, that's I what C does. Here is same snippet of code rewritten using C for my $pair (globmap '<*.tar.gz>' => '<#1.tgz>' ) { my ($from, $to) = @$pair; rename $from => $to or die "Cannot rename '$old' to '$new': $!\n; } So how does it work? Behind the scenes the C function does a combination of a file glob to match existing filenames followed by a substitute to create the new filenames. Notice how both parameters to C are strings that are delimited by <>. This is done to make them look more like file globs - it is just syntactic sugar, but it can be handy when you want the strings to be visually distinctive. The enclosing <> are optional, so you don't have to use them - in fact the first thing globmap will do is remove these delimiters if they are present. The first parameter to C, C<*.tar.gz>, is an I. Once the enclosing "< ... >" is removed, this is passed (more or less) unchanged to C to carry out a file match. Next the fileglob C<*.tar.gz> is transformed behind the scenes into a full Perl regular expression, with the additional step of wrapping each transformed wildcard metacharacter sequence in parenthesis. In this case the input fileglob C<*.tar.gz> will be transformed into this Perl regular expression ([^/]*)\.tar\.gz Wrapping with parenthesis allows the wildcard parts of the Input File Glob to be referenced by the second parameter to C, C<#1.tgz>, the I. This parameter operates just like the replacement part of a substitute command. The difference is that the C<#1> syntax is used to reference sub-patterns matched in the input fileglob, rather than the C<$1> syntax that is used with perl regular expressions. In this case C<#1> is used to refer to the text matched by the C<*> in the Input File Glob. This makes it easier to use this module where the parameters to C are typed at the command line. The final step involves passing each filename matched by the C<*.tar.gz> file glob through the derived Perl regular expression in turn and expanding the output fileglob using it. The end result of all this is a list of pairs of filenames. By default that is what is returned by C. In this example the data structure returned will look like this ( ['alpha.tar.gz' => 'alpha.tgz'], ['beta.tar.gz' => 'beta.tgz' ], ['gamma.tar.gz' => 'gamma.tgz'] ) Each pair is an array reference with two elements - namely the I filename, that C has matched, and a I filename that is derived from the I filename. =head2 Limitations C has been kept simple deliberately, so it isn't intended to solve all filename mapping operations. Under the hood C (or for older versions of Perl, C) is used to match the files, so you will never have the flexibility of full Perl regular expression. =head2 Input File Glob The syntax for an Input FileGlob is identical to C, except for the following =over 5 =item 1. No nested {} =item 2. Whitespace does not delimit fileglobs. =item 3. The use of parenthesis can be used to capture parts of the input filename. =item 4. If an Input glob matches the same file more than once, only the first will be used. =back The syntax =over 5 =item B<~> =item B<~user> =item B<.> Matches a literal '.'. Equivalent to the Perl regular expression \. =item B<*> Matches zero or more characters, except '/'. Equivalent to the Perl regular expression [^/]* =item B Matches zero or one character, except '/'. Equivalent to the Perl regular expression [^/]? =item B<\> Backslash is used, as usual, to escape the next character. =item B<[]> Character class. =item B<{,}> Alternation =item B<()> Capturing parenthesis that work just like perl =back Any other character it taken literally. =head2 Output File Glob The Output File Glob is a normal string, with 2 glob-like features. The first is the '*' metacharacter. This will be replaced by the complete filename matched by the input file glob. So *.c *.Z The second is Output FileGlobs take the =over 5 =item "*" The "*" character will be replaced with the complete input filename. =item #1 Patterns of the form /#\d/ will be replaced with the =back =head2 Returned Data =head1 EXAMPLES =head2 A Rename script Below is a simple "rename" script that uses C to determine the source and destination filenames. use File::GlobMapper qw(globmap) ; use File::Copy; die "rename: Usage rename 'from' 'to'\n" unless @ARGV == 2 ; my $fromGlob = shift @ARGV; my $toGlob = shift @ARGV; my $pairs = globmap($fromGlob, $toGlob) or die $File::GlobMapper::Error; for my $pair (@$pairs) { my ($from, $to) = @$pair; move $from => $to ; } Here is an example that renames all c files to cpp. $ rename '*.c' '#1.cpp' =head2 A few example globmaps Below are a few examples of globmaps To copy all your .c file to a backup directory '' '' If you want to compress all '' '<*.gz>' To uncompress '' '' =head1 SEE ALSO L =head1 AUTHOR The I module was written by Paul Marquess, F. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/IO/000077500000000000000000000000001357305601700165025ustar00rootroot00000000000000libio-compress-perl-2.093/lib/IO/Compress/000077500000000000000000000000001357305601700202755ustar00rootroot00000000000000libio-compress-perl-2.093/lib/IO/Compress/Adapter/000077500000000000000000000000001357305601700216555ustar00rootroot00000000000000libio-compress-perl-2.093/lib/IO/Compress/Adapter/Bzip2.pm000066400000000000000000000050441357305601700232040ustar00rootroot00000000000000package IO::Compress::Adapter::Bzip2 ; use strict; use warnings; use bytes; use IO::Compress::Base::Common 2.093 qw(:Status); use Compress::Raw::Bzip2 2.093 ; our ($VERSION); $VERSION = '2.093'; sub mkCompObject { my $BlockSize100K = shift ; my $WorkFactor = shift ; my $Verbosity = shift ; $BlockSize100K = 1 if ! defined $BlockSize100K ; $WorkFactor = 0 if ! defined $WorkFactor ; $Verbosity = 0 if ! defined $Verbosity ; my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, $WorkFactor, $Verbosity); return (undef, "Could not create Deflate object: $status", $status) if $status != BZ_OK ; return bless {'Def' => $def, 'Error' => '', 'ErrorNo' => 0, } ; } sub compr { my $self = shift ; my $def = $self->{Def}; my $status = $def->bzdeflate($_[0], $_[1]) ; $self->{ErrorNo} = $status; if ($status != BZ_RUN_OK) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub flush { my $self = shift ; my $def = $self->{Def}; my $status = $def->bzflush($_[0]); $self->{ErrorNo} = $status; if ($status != BZ_RUN_OK) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub close { my $self = shift ; my $def = $self->{Def}; my $status = $def->bzclose($_[0]); $self->{ErrorNo} = $status; if ($status != BZ_STREAM_END) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub reset { my $self = shift ; my $outer = $self->{Outer}; my ($def, $status) = new Compress::Raw::Bzip2(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { $self->{Error} = "Cannot create Deflate object: $status"; return STATUS_ERROR; } $self->{Def} = $def; return STATUS_OK; } sub compressedBytes { my $self = shift ; $self->{Def}->compressedBytes(); } sub uncompressedBytes { my $self = shift ; $self->{Def}->uncompressedBytes(); } #sub total_out #{ # my $self = shift ; # 0; #} # #sub total_in #{ # my $self = shift ; # $self->{Def}->total_in(); #} # #sub crc32 #{ # my $self = shift ; # $self->{Def}->crc32(); #} # #sub adler32 #{ # my $self = shift ; # $self->{Def}->adler32(); #} 1; __END__ libio-compress-perl-2.093/lib/IO/Compress/Adapter/Deflate.pm000066400000000000000000000061101357305601700235550ustar00rootroot00000000000000package IO::Compress::Adapter::Deflate ; use strict; use warnings; use bytes; use IO::Compress::Base::Common 2.093 qw(:Status); use Compress::Raw::Zlib 2.093 qw( !crc32 !adler32 ) ; require Exporter; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); $VERSION = '2.093'; @ISA = qw(Exporter); @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; @EXPORT = @EXPORT_OK; %DEFLATE_CONSTANTS = %EXPORT_TAGS ; sub mkCompObject { my $crc32 = shift ; my $adler32 = shift ; my $level = shift ; my $strategy = shift ; my ($def, $status) = new Compress::Raw::Zlib::Deflate -AppendOutput => 1, -CRC32 => $crc32, -ADLER32 => $adler32, -Level => $level, -Strategy => $strategy, -WindowBits => - MAX_WBITS; return (undef, "Cannot create Deflate object: $status", $status) if $status != Z_OK; return bless {'Def' => $def, 'Error' => '', } ; } sub compr { my $self = shift ; my $def = $self->{Def}; my $status = $def->deflate($_[0], $_[1]) ; $self->{ErrorNo} = $status; if ($status != Z_OK) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub flush { my $self = shift ; my $def = $self->{Def}; my $opt = $_[1] || Z_FINISH; my $status = $def->flush($_[0], $opt); $self->{ErrorNo} = $status; if ($status != Z_OK) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub close { my $self = shift ; my $def = $self->{Def}; $def->flush($_[0], Z_FINISH) if defined $def ; } sub reset { my $self = shift ; my $def = $self->{Def}; my $status = $def->deflateReset() ; $self->{ErrorNo} = $status; if ($status != Z_OK) { $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } return STATUS_OK; } sub deflateParams { my $self = shift ; my $def = $self->{Def}; my $status = $def->deflateParams(@_); $self->{ErrorNo} = $status; if ($status != Z_OK) { $self->{Error} = "deflateParams Error: $status"; return STATUS_ERROR; } return STATUS_OK; } #sub total_out #{ # my $self = shift ; # $self->{Def}->total_out(); #} # #sub total_in #{ # my $self = shift ; # $self->{Def}->total_in(); #} sub compressedBytes { my $self = shift ; $self->{Def}->compressedBytes(); } sub uncompressedBytes { my $self = shift ; $self->{Def}->uncompressedBytes(); } sub crc32 { my $self = shift ; $self->{Def}->crc32(); } sub adler32 { my $self = shift ; $self->{Def}->adler32(); } 1; __END__ libio-compress-perl-2.093/lib/IO/Compress/Adapter/Identity.pm000066400000000000000000000026361357305601700240130ustar00rootroot00000000000000package IO::Compress::Adapter::Identity ; use strict; use warnings; use bytes; use IO::Compress::Base::Common 2.093 qw(:Status); our ($VERSION); $VERSION = '2.093'; sub mkCompObject { my $level = shift ; my $strategy = shift ; return bless { 'CompSize' => 0, 'UnCompSize' => 0, 'Error' => '', 'ErrorNo' => 0, } ; } sub compr { my $self = shift ; if (defined ${ $_[0] } && length ${ $_[0] }) { $self->{CompSize} += length ${ $_[0] } ; $self->{UnCompSize} = $self->{CompSize} ; if ( ref $_[1] ) { ${ $_[1] } .= ${ $_[0] } } else { $_[1] .= ${ $_[0] } } } return STATUS_OK ; } sub flush { my $self = shift ; return STATUS_OK; } sub close { my $self = shift ; return STATUS_OK; } sub reset { my $self = shift ; $self->{CompSize} = 0; $self->{UnCompSize} = 0; return STATUS_OK; } sub deflateParams { my $self = shift ; return STATUS_OK; } #sub total_out #{ # my $self = shift ; # return $self->{UnCompSize} ; #} # #sub total_in #{ # my $self = shift ; # return $self->{UnCompSize} ; #} sub compressedBytes { my $self = shift ; return $self->{UnCompSize} ; } sub uncompressedBytes { my $self = shift ; return $self->{UnCompSize} ; } 1; __END__ libio-compress-perl-2.093/lib/IO/Compress/Base.pm000066400000000000000000000565641357305601700215250ustar00rootroot00000000000000 package IO::Compress::Base ; require 5.006 ; use strict ; use warnings; use IO::Compress::Base::Common 2.093 ; use IO::File (); ; use Scalar::Util (); #use File::Glob; #require Exporter ; use Carp() ; use Symbol(); #use bytes; our (@ISA, $VERSION); @ISA = qw(IO::File Exporter); $VERSION = '2.093'; #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. sub saveStatus { my $self = shift ; ${ *$self->{ErrorNo} } = shift() + 0 ; ${ *$self->{Error} } = '' ; return ${ *$self->{ErrorNo} } ; } sub saveErrorString { my $self = shift ; my $retval = shift ; ${ *$self->{Error} } = shift ; ${ *$self->{ErrorNo} } = shift() + 0 if @_ ; return $retval; } sub croakError { my $self = shift ; $self->saveErrorString(0, $_[0]); Carp::croak $_[0]; } sub closeError { my $self = shift ; my $retval = shift ; my $errno = *$self->{ErrorNo}; my $error = ${ *$self->{Error} }; $self->close(); *$self->{ErrorNo} = $errno ; ${ *$self->{Error} } = $error ; return $retval; } sub error { my $self = shift ; return ${ *$self->{Error} } ; } sub errorNo { my $self = shift ; return ${ *$self->{ErrorNo} } ; } sub writeAt { my $self = shift ; my $offset = shift; my $data = shift; if (defined *$self->{FH}) { my $here = tell(*$self->{FH}); return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) if $here < 0 ; seek(*$self->{FH}, $offset, IO::Handle::SEEK_SET) or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; defined *$self->{FH}->write($data, length $data) or return $self->saveErrorString(undef, $!, $!) ; seek(*$self->{FH}, $here, IO::Handle::SEEK_SET) or return $self->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; } else { substr(${ *$self->{Buffer} }, $offset, length($data)) = $data ; } return 1; } sub outputPayload { my $self = shift ; return $self->output(@_); } sub output { my $self = shift ; my $data = shift ; my $last = shift ; return 1 if length $data == 0 && ! $last ; if ( *$self->{FilterContainer} ) { *_ = \$data; &{ *$self->{FilterContainer} }(); } if (length $data) { if ( defined *$self->{FH} ) { defined *$self->{FH}->write( $data, length $data ) or return $self->saveErrorString(0, $!, $!); } else { ${ *$self->{Buffer} } .= $data ; } } return 1; } sub getOneShotParams { return ( 'multistream' => [IO::Compress::Base::Common::Parse_boolean, 1], ); } our %PARAMS = ( # Generic Parameters 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], 'encode' => [IO::Compress::Base::Common::Parse_any, undef], 'strict' => [IO::Compress::Base::Common::Parse_boolean, 1], 'append' => [IO::Compress::Base::Common::Parse_boolean, 0], 'binmodein' => [IO::Compress::Base::Common::Parse_boolean, 0], 'filtercontainer' => [IO::Compress::Base::Common::Parse_code, undef], ); sub checkParams { my $self = shift ; my $class = shift ; my $got = shift || IO::Compress::Base::Parameters::new(); $got->parse( { %PARAMS, $self->getExtraParams(), *$self->{OneShot} ? $self->getOneShotParams() : (), }, @_) or $self->croakError("${class}: " . $got->getError()) ; return $got ; } sub _create { my $obj = shift; my $got = shift; *$obj->{Closed} = 1 ; my $class = ref $obj; $obj->croakError("$class: Missing Output parameter") if ! @_ && ! $got ; my $outValue = shift ; my $oneShot = 1 ; if (! $got) { $oneShot = 0 ; $got = $obj->checkParams($class, undef, @_) or return undef ; } my $lax = ! $got->getValue('strict') ; my $outType = IO::Compress::Base::Common::whatIsOutput($outValue); $obj->ckOutputParam($class, $outValue) or return undef ; if ($outType eq 'buffer') { *$obj->{Buffer} = $outValue; } else { my $buff = "" ; *$obj->{Buffer} = \$buff ; } # Merge implies Append my $merge = $got->getValue('merge') ; my $appendOutput = $got->getValue('append') || $merge ; *$obj->{Append} = $appendOutput; *$obj->{FilterContainer} = $got->getValue('filtercontainer') ; if ($merge) { # Switch off Merge mode if output file/buffer is empty/doesn't exist if (($outType eq 'buffer' && length $$outValue == 0 ) || ($outType ne 'buffer' && (! -e $outValue || (-w _ && -z _))) ) { $merge = 0 } } # If output is a file, check that it is writable #no warnings; #if ($outType eq 'filename' && -e $outValue && ! -w _) # { return $obj->saveErrorString(undef, "Output file '$outValue' is not writable" ) } $obj->ckParams($got) or $obj->croakError("${class}: " . $obj->error()); if ($got->getValue('encode')) { my $want_encoding = $got->getValue('encode'); *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding); my $x = *$obj->{Encoding}; } else { *$obj->{Encoding} = undef; } $obj->saveStatus(STATUS_OK) ; my $status ; if (! $merge) { *$obj->{Compress} = $obj->mkComp($got) or return undef; *$obj->{UnCompSize} = new U64 ; *$obj->{CompSize} = new U64 ; if ( $outType eq 'buffer') { ${ *$obj->{Buffer} } = '' unless $appendOutput ; } else { if ($outType eq 'handle') { *$obj->{FH} = $outValue ; setBinModeOutput(*$obj->{FH}) ; #$outValue->flush() ; *$obj->{Handle} = 1 ; if ($appendOutput) { seek(*$obj->{FH}, 0, IO::Handle::SEEK_END) or return $obj->saveErrorString(undef, "Cannot seek to end of output filehandle: $!", $!) ; } } elsif ($outType eq 'filename') { no warnings; my $mode = '>' ; $mode = '>>' if $appendOutput; *$obj->{FH} = new IO::File "$mode $outValue" or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; *$obj->{StdIO} = ($outValue eq '-'); setBinModeOutput(*$obj->{FH}) ; } } *$obj->{Header} = $obj->mkHeader($got) ; $obj->output( *$obj->{Header} ) or return undef; $obj->beforePayload(); } else { *$obj->{Compress} = $obj->createMerge($outValue, $outType) or return undef; } *$obj->{Closed} = 0 ; *$obj->{AutoClose} = $got->getValue('autoclose') ; *$obj->{Output} = $outValue; *$obj->{ClassName} = $class; *$obj->{Got} = $got; *$obj->{OneShot} = 0 ; return $obj ; } sub ckOutputParam { my $self = shift ; my $from = shift ; my $outType = IO::Compress::Base::Common::whatIsOutput($_[0]); $self->croakError("$from: output parameter not a filename, filehandle or scalar ref") if ! $outType ; #$self->croakError("$from: output filename is undef or null string") #if $outType eq 'filename' && (! defined $_[0] || $_[0] eq '') ; $self->croakError("$from: output buffer is read-only") if $outType eq 'buffer' && Scalar::Util::readonly(${ $_[0] }); return 1; } sub _def { my $obj = shift ; my $class= (caller)[0] ; my $name = (caller(1))[3] ; $obj->croakError("$name: expected at least 1 parameters\n") unless @_ >= 1 ; my $input = shift ; my $haveOut = @_ ; my $output = shift ; my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) or return undef ; push @_, $output if $haveOut && $x->{Hash}; *$obj->{OneShot} = 1 ; my $got = $obj->checkParams($name, undef, @_) or return undef ; $x->{Got} = $got ; # if ($x->{Hash}) # { # while (my($k, $v) = each %$input) # { # $v = \$input->{$k} # unless defined $v ; # # $obj->_singleTarget($x, 1, $k, $v, @_) # or return undef ; # } # # return keys %$input ; # } if ($x->{GlobMap}) { $x->{oneInput} = 1 ; foreach my $pair (@{ $x->{Pairs} }) { my ($from, $to) = @$pair ; $obj->_singleTarget($x, 1, $from, $to, @_) or return undef ; } return scalar @{ $x->{Pairs} } ; } if (! $x->{oneOutput} ) { my $inFile = ($x->{inType} eq 'filenames' || $x->{inType} eq 'filename'); $x->{inType} = $inFile ? 'filename' : 'buffer'; foreach my $in ($x->{oneInput} ? $input : @$input) { my $out ; $x->{oneInput} = 1 ; $obj->_singleTarget($x, $inFile, $in, \$out, @_) or return undef ; push @$output, \$out ; #if ($x->{outType} eq 'array') # { push @$output, \$out } #else # { $output->{$in} = \$out } } return 1 ; } # finally the 1 to 1 and n to 1 return $obj->_singleTarget($x, 1, $input, $output, @_); Carp::croak "should not be here" ; } sub _singleTarget { my $obj = shift ; my $x = shift ; my $inputIsFilename = shift; my $input = shift; if ($x->{oneInput}) { $obj->getFileInfo($x->{Got}, $input) if isaScalar($input) || (isaFilename($input) and $inputIsFilename) ; my $z = $obj->_create($x->{Got}, @_) or return undef ; defined $z->_wr2($input, $inputIsFilename) or return $z->closeError(undef) ; return $z->close() ; } else { my $afterFirst = 0 ; my $inputIsFilename = ($x->{inType} ne 'array'); my $keep = $x->{Got}->clone(); #for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) for my $element ( @$input) { my $isFilename = isaFilename($element); if ( $afterFirst ++ ) { defined addInterStream($obj, $element, $isFilename) or return $obj->closeError(undef) ; } else { $obj->getFileInfo($x->{Got}, $element) if isaScalar($element) || $isFilename; $obj->_create($x->{Got}, @_) or return undef ; } defined $obj->_wr2($element, $isFilename) or return $obj->closeError(undef) ; *$obj->{Got} = $keep->clone(); } return $obj->close() ; } } sub _wr2 { my $self = shift ; my $source = shift ; my $inputIsFilename = shift; my $input = $source ; if (! $inputIsFilename) { $input = \$source if ! ref $source; } if ( ref $input && ref $input eq 'SCALAR' ) { return $self->syswrite($input, @_) ; } if ( ! ref $input || isaFilehandle($input)) { my $isFilehandle = isaFilehandle($input) ; my $fh = $input ; if ( ! $isFilehandle ) { $fh = new IO::File "<$input" or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; } binmode $fh ; my $status ; my $buff ; my $count = 0 ; while ($status = read($fh, $buff, 16 * 1024)) { $count += length $buff; defined $self->syswrite($buff, @_) or return undef ; } return $self->saveErrorString(undef, $!, $!) if ! defined $status ; if ( (!$isFilehandle || *$self->{AutoClose}) && $input ne '-') { $fh->close() or return undef ; } return $count ; } Carp::croak "Should not be here"; return undef; } sub addInterStream { my $self = shift ; my $input = shift ; my $inputIsFilename = shift ; if (*$self->{Got}->getValue('multistream')) { $self->getFileInfo(*$self->{Got}, $input) #if isaFilename($input) and $inputIsFilename ; if isaScalar($input) || isaFilename($input) ; # TODO -- newStream needs to allow gzip/zip header to be modified return $self->newStream(); } elsif (*$self->{Got}->getValue('autoflush')) { #return $self->flush(Z_FULL_FLUSH); } return 1 ; } sub getFileInfo { } sub TIEHANDLE { return $_[0] if ref($_[0]); die "OOPS\n" ; } sub UNTIE { my $self = shift ; } sub DESTROY { my $self = shift ; local ($., $@, $!, $^E, $?); $self->close() ; # TODO - memory leak with 5.8.0 - this isn't called until # global destruction # %{ *$self } = () ; undef $self ; } sub filterUncompressed { } sub syswrite { my $self = shift ; my $buffer ; if (ref $_[0] ) { $self->croakError( *$self->{ClassName} . "::write: not a scalar reference" ) unless ref $_[0] eq 'SCALAR' ; $buffer = $_[0] ; } else { $buffer = \$_[0] ; } if (@_ > 1) { my $slen = defined $$buffer ? length($$buffer) : 0; my $len = $slen; my $offset = 0; $len = $_[1] if $_[1] < $len; if (@_ > 2) { $offset = $_[2] || 0; $self->croakError(*$self->{ClassName} . "::write: offset outside string") if $offset > $slen; if ($offset < 0) { $offset += $slen; $self->croakError( *$self->{ClassName} . "::write: offset outside string") if $offset < 0; } my $rem = $slen - $offset; $len = $rem if $rem < $len; } $buffer = \substr($$buffer, $offset, $len) ; } return 0 if (! defined $$buffer || length $$buffer == 0) && ! *$self->{FlushPending}; # *$self->{Pending} .= $$buffer ; # # return length $$buffer # if (length *$self->{Pending} < 1024 * 16 && ! *$self->{FlushPending}) ; # # $$buffer = *$self->{Pending} ; # *$self->{Pending} = ''; if (*$self->{Encoding}) { $$buffer = *$self->{Encoding}->encode($$buffer); } else { $] >= 5.008 and ( utf8::downgrade($$buffer, 1) or Carp::croak "Wide character in " . *$self->{ClassName} . "::write:"); } $self->filterUncompressed($buffer); my $buffer_length = defined $$buffer ? length($$buffer) : 0 ; *$self->{UnCompSize}->add($buffer_length) ; my $outBuffer=''; my $status = *$self->{Compress}->compr($buffer, $outBuffer) ; return $self->saveErrorString(undef, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; *$self->{CompSize}->add(length $outBuffer) ; $self->outputPayload($outBuffer) or return undef; return $buffer_length; } sub print { my $self = shift; #if (ref $self) { # $self = *$self{GLOB} ; #} if (defined $\) { if (defined $,) { defined $self->syswrite(join($,, @_) . $\); } else { defined $self->syswrite(join("", @_) . $\); } } else { if (defined $,) { defined $self->syswrite(join($,, @_)); } else { defined $self->syswrite(join("", @_)); } } } sub printf { my $self = shift; my $fmt = shift; defined $self->syswrite(sprintf($fmt, @_)); } sub _flushCompressed { my $self = shift ; my $outBuffer=''; my $status = *$self->{Compress}->flush($outBuffer, @_) ; return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; if ( defined *$self->{FH} ) { *$self->{FH}->clearerr(); } *$self->{CompSize}->add(length $outBuffer) ; $self->outputPayload($outBuffer) or return 0; return 1; } sub flush { my $self = shift ; $self->_flushCompressed(@_) or return 0; if ( defined *$self->{FH} ) { defined *$self->{FH}->flush() or return $self->saveErrorString(0, $!, $!); } return 1; } sub beforePayload { } sub _newStream { my $self = shift ; my $got = shift; my $class = ref $self; $self->_writeTrailer() or return 0 ; $self->ckParams($got) or $self->croakError("newStream: $self->{Error}"); if ($got->getValue('encode')) { my $want_encoding = $got->getValue('encode'); *$self->{Encoding} = IO::Compress::Base::Common::getEncoding($self, $class, $want_encoding); } else { *$self->{Encoding} = undef; } *$self->{Compress} = $self->mkComp($got) or return 0; *$self->{Header} = $self->mkHeader($got) ; $self->output(*$self->{Header} ) or return 0; *$self->{UnCompSize}->reset(); *$self->{CompSize}->reset(); $self->beforePayload(); return 1 ; } sub newStream { my $self = shift ; my $got = $self->checkParams('newStream', *$self->{Got}, @_) or return 0 ; $self->_newStream($got); # *$self->{Compress} = $self->mkComp($got) # or return 0; # # *$self->{Header} = $self->mkHeader($got) ; # $self->output(*$self->{Header} ) # or return 0; # # *$self->{UnCompSize}->reset(); # *$self->{CompSize}->reset(); # # $self->beforePayload(); # # return 1 ; } sub reset { my $self = shift ; return *$self->{Compress}->reset() ; } sub _writeTrailer { my $self = shift ; my $trailer = ''; my $status = *$self->{Compress}->close($trailer) ; return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; *$self->{CompSize}->add(length $trailer) ; $trailer .= $self->mkTrailer(); defined $trailer or return 0; return $self->output($trailer); } sub _writeFinalTrailer { my $self = shift ; return $self->output($self->mkFinalTrailer()); } sub close { my $self = shift ; return 1 if *$self->{Closed} || ! *$self->{Compress} ; *$self->{Closed} = 1 ; untie *$self if $] >= 5.008 ; *$self->{FlushPending} = 1 ; $self->_writeTrailer() or return 0 ; $self->_writeFinalTrailer() or return 0 ; $self->output( "", 1 ) or return 0; if (defined *$self->{FH}) { if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { $! = 0 ; *$self->{FH}->close() or return $self->saveErrorString(0, $!, $!); } delete *$self->{FH} ; # This delete can set $! in older Perls, so reset the errno $! = 0 ; } return 1; } #sub total_in #sub total_out #sub msg # #sub crc #{ # my $self = shift ; # return *$self->{Compress}->crc32() ; #} # #sub msg #{ # my $self = shift ; # return *$self->{Compress}->msg() ; #} # #sub dict_adler #{ # my $self = shift ; # return *$self->{Compress}->dict_adler() ; #} # #sub get_Level #{ # my $self = shift ; # return *$self->{Compress}->get_Level() ; #} # #sub get_Strategy #{ # my $self = shift ; # return *$self->{Compress}->get_Strategy() ; #} sub tell { my $self = shift ; return *$self->{UnCompSize}->get32bit() ; } sub eof { my $self = shift ; return *$self->{Closed} ; } sub seek { my $self = shift ; my $position = shift; my $whence = shift ; my $here = $self->tell() ; my $target = 0 ; #use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); use IO::Handle ; if ($whence == IO::Handle::SEEK_SET) { $target = $position ; } elsif ($whence == IO::Handle::SEEK_CUR || $whence == IO::Handle::SEEK_END) { $target = $here + $position ; } else { $self->croakError(*$self->{ClassName} . "::seek: unknown value, $whence, for whence parameter"); } # short circuit if seeking to current offset return 1 if $target == $here ; # Outlaw any attempt to seek backwards $self->croakError(*$self->{ClassName} . "::seek: cannot seek backwards") if $target < $here ; # Walk the file to the new offset my $offset = $target - $here ; my $buffer ; defined $self->syswrite("\x00" x $offset) or return 0; return 1 ; } sub binmode { 1; # my $self = shift ; # return defined *$self->{FH} # ? binmode *$self->{FH} # : 1 ; } sub fileno { my $self = shift ; return defined *$self->{FH} ? *$self->{FH}->fileno() : undef ; } sub opened { my $self = shift ; return ! *$self->{Closed} ; } sub autoflush { my $self = shift ; return defined *$self->{FH} ? *$self->{FH}->autoflush(@_) : undef ; } sub input_line_number { return undef ; } sub _notAvailable { my $name = shift ; 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; #*sysread = \&_notAvailable; #*syswrite = \&_write; 1; __END__ =head1 NAME IO::Compress::Base - Base Class for IO::Compress modules =head1 SYNOPSIS use IO::Compress::Base ; =head1 DESCRIPTION This module is not intended for direct use in application code. Its sole purpose is to be sub-classed by IO::Compress modules. =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L L, L, L, L =head1 AUTHOR This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY See the Changes file. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/IO/Compress/Base/000077500000000000000000000000001357305601700211475ustar00rootroot00000000000000libio-compress-perl-2.093/lib/IO/Compress/Base/Common.pm000066400000000000000000000543631357305601700227500ustar00rootroot00000000000000package IO::Compress::Base::Common; use strict ; use warnings; use bytes; use Carp; use Scalar::Util qw(blessed readonly); use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); $VERSION = '2.093'; @EXPORT = qw( isaFilehandle isaFilename isaScalar whatIsInput whatIsOutput isaFileGlobString cleanFileGlobString oneTarget setBinModeInput setBinModeOutput ckInOutParams createSelfTiedObject isGeMax32 MAX32 WANT_CODE WANT_EXT WANT_UNDEF WANT_HASH STATUS_OK STATUS_ENDSTREAM STATUS_EOF STATUS_ERROR ); %EXPORT_TAGS = ( Status => [qw( STATUS_OK STATUS_ENDSTREAM STATUS_EOF STATUS_ERROR )]); use constant STATUS_OK => 0; use constant STATUS_ENDSTREAM => 1; use constant STATUS_EOF => 2; use constant STATUS_ERROR => -1; use constant MAX16 => 0xFFFF ; use constant MAX32 => 0xFFFFFFFF ; use constant MAX32cmp => 0xFFFFFFFF + 1 - 1; # for 5.6.x on 32-bit need to force an non-IV value sub isGeMax32 { return $_[0] >= MAX32cmp ; } sub hasEncode() { if (! defined $HAS_ENCODE) { eval { require Encode; Encode->import(); }; $HAS_ENCODE = $@ ? 0 : 1 ; } return $HAS_ENCODE; } sub getEncoding($$$) { my $obj = shift; my $class = shift ; my $want_encoding = shift ; $obj->croakError("$class: Encode module needed to use -Encode") if ! hasEncode(); my $encoding = Encode::find_encoding($want_encoding); $obj->croakError("$class: Encoding '$want_encoding' is not available") if ! $encoding; return $encoding; } our ($needBinmode); $needBinmode = ($^O eq 'MSWin32' || ($] >= 5.006 && eval ' ${^UNICODE} || ${^UTF8LOCALE} ')) ? 1 : 1 ; sub setBinModeInput($) { my $handle = shift ; binmode $handle if $needBinmode; } sub setBinModeOutput($) { my $handle = shift ; binmode $handle if $needBinmode; } sub isaFilehandle($) { use utf8; # Pragma needed to keep Perl 5.6.0 happy return (defined $_[0] and (UNIVERSAL::isa($_[0],'GLOB') or UNIVERSAL::isa($_[0],'IO::Handle') or UNIVERSAL::isa(\$_[0],'GLOB')) ) } sub isaScalar { return ( defined($_[0]) and ref($_[0]) eq 'SCALAR' and defined ${ $_[0] } ) ; } sub isaFilename($) { return (defined $_[0] and ! ref $_[0] and UNIVERSAL::isa(\$_[0], 'SCALAR')); } sub isaFileGlobString { return defined $_[0] && $_[0] =~ /^<.*>$/; } sub cleanFileGlobString { my $string = shift ; $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/; return $string; } use constant WANT_CODE => 1 ; use constant WANT_EXT => 2 ; use constant WANT_UNDEF => 4 ; #use constant WANT_HASH => 8 ; use constant WANT_HASH => 0 ; sub whatIsInput($;$) { my $got = whatIs(@_); if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') { #use IO::File; $got = 'handle'; $_[0] = *STDIN; #$_[0] = new IO::File("<-"); } return $got; } sub whatIsOutput($;$) { my $got = whatIs(@_); if (defined $got && $got eq 'filename' && defined $_[0] && $_[0] eq '-') { $got = 'handle'; $_[0] = *STDOUT; #$_[0] = new IO::File(">-"); } return $got; } sub whatIs ($;$) { return 'handle' if isaFilehandle($_[0]); my $wantCode = defined $_[1] && $_[1] & WANT_CODE ; my $extended = defined $_[1] && $_[1] & WANT_EXT ; my $undef = defined $_[1] && $_[1] & WANT_UNDEF ; my $hash = defined $_[1] && $_[1] & WANT_HASH ; return 'undef' if ! defined $_[0] && $undef ; if (ref $_[0]) { return '' if blessed($_[0]); # is an object #return '' if UNIVERSAL::isa($_[0], 'UNIVERSAL'); # is an object return 'buffer' if UNIVERSAL::isa($_[0], 'SCALAR'); return 'array' if UNIVERSAL::isa($_[0], 'ARRAY') && $extended ; return 'hash' if UNIVERSAL::isa($_[0], 'HASH') && $hash ; return 'code' if UNIVERSAL::isa($_[0], 'CODE') && $wantCode ; return ''; } return 'fileglob' if $extended && isaFileGlobString($_[0]); return 'filename'; } sub oneTarget { return $_[0] =~ /^(code|handle|buffer|filename)$/; } sub IO::Compress::Base::Validator::new { my $class = shift ; my $Class = shift ; my $error_ref = shift ; my $reportClass = shift ; my %data = (Class => $Class, Error => $error_ref, reportClass => $reportClass, ) ; my $obj = bless \%data, $class ; local $Carp::CarpLevel = 1; my $inType = $data{inType} = whatIsInput($_[0], WANT_EXT|WANT_HASH); my $outType = $data{outType} = whatIsOutput($_[1], WANT_EXT|WANT_HASH); my $oneInput = $data{oneInput} = oneTarget($inType); my $oneOutput = $data{oneOutput} = oneTarget($outType); if (! $inType) { $obj->croakError("$reportClass: illegal input parameter") ; #return undef ; } # if ($inType eq 'hash') # { # $obj->{Hash} = 1 ; # $obj->{oneInput} = 1 ; # return $obj->validateHash($_[0]); # } if (! $outType) { $obj->croakError("$reportClass: illegal output parameter") ; #return undef ; } if ($inType ne 'fileglob' && $outType eq 'fileglob') { $obj->croakError("Need input fileglob for outout fileglob"); } # if ($inType ne 'fileglob' && $outType eq 'hash' && $inType ne 'filename' ) # { # $obj->croakError("input must ne filename or fileglob when output is a hash"); # } if ($inType eq 'fileglob' && $outType eq 'fileglob') { $data{GlobMap} = 1 ; $data{inType} = $data{outType} = 'filename'; my $mapper = new File::GlobMapper($_[0], $_[1]); if ( ! $mapper ) { return $obj->saveErrorString($File::GlobMapper::Error) ; } $data{Pairs} = $mapper->getFileMap(); return $obj; } $obj->croakError("$reportClass: input and output $inType are identical") if $inType eq $outType && $_[0] eq $_[1] && $_[0] ne '-' ; if ($inType eq 'fileglob') # && $outType ne 'fileglob' { my $glob = cleanFileGlobString($_[0]); my @inputs = glob($glob); if (@inputs == 0) { # TODO -- legal or die? die "globmap matched zero file -- legal or die???" ; } elsif (@inputs == 1) { $obj->validateInputFilenames($inputs[0]) or return undef; $_[0] = $inputs[0] ; $data{inType} = 'filename' ; $data{oneInput} = 1; } else { $obj->validateInputFilenames(@inputs) or return undef; $_[0] = [ @inputs ] ; $data{inType} = 'filenames' ; } } elsif ($inType eq 'filename') { $obj->validateInputFilenames($_[0]) or return undef; } elsif ($inType eq 'array') { $data{inType} = 'filenames' ; $obj->validateInputArray($_[0]) or return undef ; } return $obj->saveErrorString("$reportClass: output buffer is read-only") if $outType eq 'buffer' && readonly(${ $_[1] }); if ($outType eq 'filename' ) { $obj->croakError("$reportClass: output filename is undef or null string") if ! defined $_[1] || $_[1] eq '' ; if (-e $_[1]) { if (-d _ ) { return $obj->saveErrorString("output file '$_[1]' is a directory"); } } } return $obj ; } sub IO::Compress::Base::Validator::saveErrorString { my $self = shift ; ${ $self->{Error} } = shift ; return undef; } sub IO::Compress::Base::Validator::croakError { my $self = shift ; $self->saveErrorString($_[0]); croak $_[0]; } sub IO::Compress::Base::Validator::validateInputFilenames { my $self = shift ; foreach my $filename (@_) { $self->croakError("$self->{reportClass}: input filename is undef or null string") if ! defined $filename || $filename eq '' ; next if $filename eq '-'; if (! -e $filename ) { return $self->saveErrorString("input file '$filename' does not exist"); } if (-d _ ) { return $self->saveErrorString("input file '$filename' is a directory"); } # if (! -r _ ) # { # return $self->saveErrorString("cannot open file '$filename': $!"); # } } return 1 ; } sub IO::Compress::Base::Validator::validateInputArray { my $self = shift ; if ( @{ $_[0] } == 0 ) { return $self->saveErrorString("empty array reference") ; } foreach my $element ( @{ $_[0] } ) { my $inType = whatIsInput($element); if (! $inType) { $self->croakError("unknown input parameter") ; } elsif($inType eq 'filename') { $self->validateInputFilenames($element) or return undef ; } else { $self->croakError("not a filename") ; } } return 1 ; } #sub IO::Compress::Base::Validator::validateHash #{ # my $self = shift ; # my $href = shift ; # # while (my($k, $v) = each %$href) # { # my $ktype = whatIsInput($k); # my $vtype = whatIsOutput($v, WANT_EXT|WANT_UNDEF) ; # # if ($ktype ne 'filename') # { # return $self->saveErrorString("hash key not filename") ; # } # # my %valid = map { $_ => 1 } qw(filename buffer array undef handle) ; # if (! $valid{$vtype}) # { # return $self->saveErrorString("hash value not ok") ; # } # } # # return $self ; #} sub createSelfTiedObject { my $class = shift || (caller)[0] ; my $error_ref = shift ; my $obj = bless Symbol::gensym(), ref($class) || $class; tie *$obj, $obj if $] >= 5.005; *$obj->{Closed} = 1 ; $$error_ref = ''; *$obj->{Error} = $error_ref ; my $errno = 0 ; *$obj->{ErrorNo} = \$errno ; return $obj; } #package Parse::Parameters ; # # #require Exporter; #our ($VERSION, @ISA, @EXPORT); #$VERSION = '2.000_08'; #@ISA = qw(Exporter); $EXPORT_TAGS{Parse} = [qw( ParseParameters Parse_any Parse_unsigned Parse_signed Parse_boolean Parse_string Parse_code Parse_writable_scalar ) ]; push @EXPORT, @{ $EXPORT_TAGS{Parse} } ; use constant Parse_any => 0x01; use constant Parse_unsigned => 0x02; use constant Parse_signed => 0x04; use constant Parse_boolean => 0x08; use constant Parse_string => 0x10; use constant Parse_code => 0x20; #use constant Parse_store_ref => 0x100 ; #use constant Parse_multiple => 0x100 ; use constant Parse_writable => 0x200 ; use constant Parse_writable_scalar => 0x400 | Parse_writable ; use constant OFF_PARSED => 0 ; use constant OFF_TYPE => 1 ; use constant OFF_DEFAULT => 2 ; use constant OFF_FIXED => 3 ; #use constant OFF_FIRST_ONLY => 4 ; #use constant OFF_STICKY => 5 ; use constant IxError => 0; use constant IxGot => 1 ; sub ParseParameters { my $level = shift || 0 ; my $sub = (caller($level + 1))[3] ; local $Carp::CarpLevel = 1 ; return $_[1] if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters"); my $p = new IO::Compress::Base::Parameters() ; $p->parse(@_) or croak "$sub: $p->[IxError]" ; return $p; } use strict; use warnings; use Carp; sub Init { my $default = shift ; my %got ; my $obj = IO::Compress::Base::Parameters::new(); while (my ($key, $v) = each %$default) { croak "need 2 params [@$v]" if @$v != 2 ; my ($type, $value) = @$v ; # my ($first_only, $sticky, $type, $value) = @$v ; my $sticky = 0; my $x ; $obj->_checkType($key, \$value, $type, 0, \$x) or return undef ; $key = lc $key; # if (! $sticky) { # $x = [] # if $type & Parse_multiple; # $got{$key} = [0, $type, $value, $x, $first_only, $sticky] ; $got{$key} = [0, $type, $value, $x] ; # } # # $got{$key}[OFF_PARSED] = 0 ; } return bless \%got, "IO::Compress::Base::Parameters::Defaults" ; } sub IO::Compress::Base::Parameters::new { #my $class = shift ; my $obj; $obj->[IxError] = ''; $obj->[IxGot] = {} ; return bless $obj, 'IO::Compress::Base::Parameters' ; } sub IO::Compress::Base::Parameters::setError { my $self = shift ; my $error = shift ; my $retval = @_ ? shift : undef ; $self->[IxError] = $error ; return $retval; } sub IO::Compress::Base::Parameters::getError { my $self = shift ; return $self->[IxError] ; } sub IO::Compress::Base::Parameters::parse { my $self = shift ; my $default = shift ; my $got = $self->[IxGot] ; my $firstTime = keys %{ $got } == 0 ; my (@Bad) ; my @entered = () ; # Allow the options to be passed as a hash reference or # as the complete hash. if (@_ == 0) { @entered = () ; } elsif (@_ == 1) { my $href = $_[0] ; return $self->setError("Expected even number of parameters, got 1") if ! defined $href or ! ref $href or ref $href ne "HASH" ; foreach my $key (keys %$href) { push @entered, $key ; push @entered, \$href->{$key} ; } } else { my $count = @_; return $self->setError("Expected even number of parameters, got $count") if $count % 2 != 0 ; for my $i (0.. $count / 2 - 1) { push @entered, $_[2 * $i] ; push @entered, \$_[2 * $i + 1] ; } } foreach my $key (keys %$default) { my ($type, $value) = @{ $default->{$key} } ; if ($firstTime) { $got->{$key} = [0, $type, $value, $value] ; } else { $got->{$key}[OFF_PARSED] = 0 ; } } my %parsed = (); for my $i (0.. @entered / 2 - 1) { my $key = $entered[2* $i] ; my $value = $entered[2* $i+1] ; #print "Key [$key] Value [$value]" ; #print defined $$value ? "[$$value]\n" : "[undef]\n"; $key =~ s/^-// ; my $canonkey = lc $key; if ($got->{$canonkey}) { my $type = $got->{$canonkey}[OFF_TYPE] ; my $parsed = $parsed{$canonkey}; ++ $parsed{$canonkey}; return $self->setError("Muliple instances of '$key' found") if $parsed ; my $s ; $self->_checkType($key, $value, $type, 1, \$s) or return undef ; $value = $$value ; $got->{$canonkey} = [1, $type, $value, $s] ; } else { push (@Bad, $key) } } if (@Bad) { my ($bad) = join(", ", @Bad) ; return $self->setError("unknown key value(s) $bad") ; } return 1; } sub IO::Compress::Base::Parameters::_checkType { my $self = shift ; my $key = shift ; my $value = shift ; my $type = shift ; my $validate = shift ; my $output = shift; #local $Carp::CarpLevel = $level ; #print "PARSE $type $key $value $validate $sub\n" ; if ($type & Parse_writable_scalar) { return $self->setError("Parameter '$key' not writable") if readonly $$value ; if (ref $$value) { return $self->setError("Parameter '$key' not a scalar reference") if ref $$value ne 'SCALAR' ; $$output = $$value ; } else { return $self->setError("Parameter '$key' not a scalar") if ref $value ne 'SCALAR' ; $$output = $value ; } return 1; } $value = $$value ; if ($type & Parse_any) { $$output = $value ; return 1; } elsif ($type & Parse_unsigned) { return $self->setError("Parameter '$key' must be an unsigned int, got 'undef'") if ! defined $value ; return $self->setError("Parameter '$key' must be an unsigned int, got '$value'") if $value !~ /^\d+$/; $$output = defined $value ? $value : 0 ; return 1; } elsif ($type & Parse_signed) { return $self->setError("Parameter '$key' must be a signed int, got 'undef'") if ! defined $value ; return $self->setError("Parameter '$key' must be a signed int, got '$value'") if $value !~ /^-?\d+$/; $$output = defined $value ? $value : 0 ; return 1 ; } elsif ($type & Parse_boolean) { return $self->setError("Parameter '$key' must be an int, got '$value'") if defined $value && $value !~ /^\d*$/; $$output = defined $value && $value != 0 ? 1 : 0 ; return 1; } elsif ($type & Parse_string) { $$output = defined $value ? $value : "" ; return 1; } elsif ($type & Parse_code) { return $self->setError("Parameter '$key' must be a code reference, got '$value'") if (! defined $value || ref $value ne 'CODE') ; $$output = defined $value ? $value : "" ; return 1; } $$output = $value ; return 1; } sub IO::Compress::Base::Parameters::parsed { return $_[0]->[IxGot]{$_[1]}[OFF_PARSED] ; } sub IO::Compress::Base::Parameters::getValue { return $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ; } sub IO::Compress::Base::Parameters::setValue { $_[0]->[IxGot]{$_[1]}[OFF_PARSED] = 1; $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] = $_[2] ; $_[0]->[IxGot]{$_[1]}[OFF_FIXED] = $_[2] ; } sub IO::Compress::Base::Parameters::valueRef { return $_[0]->[IxGot]{$_[1]}[OFF_FIXED] ; } sub IO::Compress::Base::Parameters::valueOrDefault { my $self = shift ; my $name = shift ; my $default = shift ; my $value = $self->[IxGot]{$name}[OFF_DEFAULT] ; return $value if defined $value ; return $default ; } sub IO::Compress::Base::Parameters::wantValue { return defined $_[0]->[IxGot]{$_[1]}[OFF_DEFAULT] ; } sub IO::Compress::Base::Parameters::clone { my $self = shift ; my $obj = [] ; my %got ; my $hash = $self->[IxGot] ; for my $k (keys %{ $hash }) { $got{$k} = [ @{ $hash->{$k} } ]; } $obj->[IxError] = $self->[IxError]; $obj->[IxGot] = \%got ; return bless $obj, 'IO::Compress::Base::Parameters' ; } package U64; use constant MAX32 => 0xFFFFFFFF ; use constant HI_1 => MAX32 + 1 ; use constant LOW => 0 ; use constant HIGH => 1; sub new { return bless [ 0, 0 ], $_[0] if @_ == 1 ; return bless [ $_[1], 0 ], $_[0] if @_ == 2 ; return bless [ $_[2], $_[1] ], $_[0] if @_ == 3 ; } sub newUnpack_V64 { my ($low, $hi) = unpack "V V", $_[0] ; bless [ $low, $hi ], "U64"; } sub newUnpack_V32 { my $string = shift; my $low = unpack "V", $string ; bless [ $low, 0 ], "U64"; } sub reset { $_[0]->[HIGH] = $_[0]->[LOW] = 0; } sub clone { bless [ @{$_[0]} ], ref $_[0] ; } sub getHigh { return $_[0]->[HIGH]; } sub getLow { return $_[0]->[LOW]; } sub get32bit { return $_[0]->[LOW]; } sub get64bit { # Not using << here because the result will still be # a 32-bit value on systems where int size is 32-bits return $_[0]->[HIGH] * HI_1 + $_[0]->[LOW]; } sub add { # my $self = shift; my $value = $_[1]; if (ref $value eq 'U64') { $_[0]->[HIGH] += $value->[HIGH] ; $value = $value->[LOW]; } elsif ($value > MAX32) { $_[0]->[HIGH] += int($value / HI_1) ; $value = $value % HI_1; } my $available = MAX32 - $_[0]->[LOW] ; if ($value > $available) { ++ $_[0]->[HIGH] ; $_[0]->[LOW] = $value - $available - 1; } else { $_[0]->[LOW] += $value ; } } sub add32 { # my $self = shift; my $value = $_[1]; if ($value > MAX32) { $_[0]->[HIGH] += int($value / HI_1) ; $value = $value % HI_1; } my $available = MAX32 - $_[0]->[LOW] ; if ($value > $available) { ++ $_[0]->[HIGH] ; $_[0]->[LOW] = $value - $available - 1; } else { $_[0]->[LOW] += $value ; } } sub subtract { my $self = shift; my $value = shift; if (ref $value eq 'U64') { if ($value->[HIGH]) { die "bad" if $self->[HIGH] == 0 || $value->[HIGH] > $self->[HIGH] ; $self->[HIGH] -= $value->[HIGH] ; } $value = $value->[LOW] ; } if ($value > $self->[LOW]) { -- $self->[HIGH] ; $self->[LOW] = MAX32 - $value + $self->[LOW] + 1 ; } else { $self->[LOW] -= $value; } } sub equal { my $self = shift; my $other = shift; return $self->[LOW] == $other->[LOW] && $self->[HIGH] == $other->[HIGH] ; } sub isZero { my $self = shift; return $self->[LOW] == 0 && $self->[HIGH] == 0 ; } sub gt { my $self = shift; my $other = shift; return $self->cmp($other) > 0 ; } sub cmp { my $self = shift; my $other = shift ; if ($self->[LOW] == $other->[LOW]) { return $self->[HIGH] - $other->[HIGH] ; } else { return $self->[LOW] - $other->[LOW] ; } } sub is64bit { return $_[0]->[HIGH] > 0 ; } sub isAlmost64bit { return $_[0]->[HIGH] > 0 || $_[0]->[LOW] == MAX32 ; } sub getPacked_V64 { return pack "V V", @{ $_[0] } ; } sub getPacked_V32 { return pack "V", $_[0]->[LOW] ; } sub pack_V64 { return pack "V V", $_[0], 0; } sub full32 { return $_[0] == MAX32 ; } sub Value_VV64 { my $buffer = shift; my ($lo, $hi) = unpack ("V V" , $buffer); no warnings 'uninitialized'; return $hi * HI_1 + $lo; } package IO::Compress::Base::Common; 1; libio-compress-perl-2.093/lib/IO/Compress/Bzip2.pm000066400000000000000000000515071357305601700216310ustar00rootroot00000000000000package IO::Compress::Bzip2 ; use strict ; use warnings; use bytes; require Exporter ; use IO::Compress::Base 2.093 ; use IO::Compress::Base::Common 2.093 qw(); use IO::Compress::Adapter::Bzip2 2.093 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); $VERSION = '2.093'; $Bzip2Error = ''; @ISA = qw(IO::Compress::Base Exporter); @EXPORT_OK = qw( $Bzip2Error bzip2 ) ; %EXPORT_TAGS = %IO::Compress::Base::EXPORT_TAGS ; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); sub new { my $class = shift ; my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$Bzip2Error); return $obj->_create(undef, @_); } sub bzip2 { my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$Bzip2Error); $obj->_def(@_); } sub mkHeader { my $self = shift ; return ''; } sub getExtraParams { my $self = shift ; use IO::Compress::Base::Common 2.093 qw(:Parse); return ( 'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned, 1], 'workfactor' => [IO::Compress::Base::Common::Parse_unsigned, 0], 'verbosity' => [IO::Compress::Base::Common::Parse_boolean, 0], ); } sub ckParams { my $self = shift ; my $got = shift; # check that BlockSize100K is a number between 1 & 9 if ($got->parsed('blocksize100k')) { my $value = $got->getValue('blocksize100k'); return $self->saveErrorString(undef, "Parameter 'BlockSize100K' not between 1 and 9, got $value") unless defined $value && $value >= 1 && $value <= 9; } # check that WorkFactor between 0 & 250 if ($got->parsed('workfactor')) { my $value = $got->getValue('workfactor'); return $self->saveErrorString(undef, "Parameter 'WorkFactor' not between 0 and 250, got $value") unless $value >= 0 && $value <= 250; } return 1 ; } sub mkComp { my $self = shift ; my $got = shift ; my $BlockSize100K = $got->getValue('blocksize100k'); my $WorkFactor = $got->getValue('workfactor'); my $Verbosity = $got->getValue('verbosity'); my ($obj, $errstr, $errno) = IO::Compress::Adapter::Bzip2::mkCompObject( $BlockSize100K, $WorkFactor, $Verbosity); return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; return $obj; } sub mkTrailer { my $self = shift ; return ''; } sub mkFinalTrailer { return ''; } #sub newHeader #{ # my $self = shift ; # return ''; #} sub getInverseClass { return ('IO::Uncompress::Bunzip2'); } sub getFileInfo { my $self = shift ; my $params = shift; my $file = shift ; } 1; __END__ =head1 NAME IO::Compress::Bzip2 - Write bzip2 files/buffers =head1 SYNOPSIS use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; my $status = bzip2 $input => $output [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; my $z = new IO::Compress::Bzip2 $output [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; $z->print($string); $z->printf($format, $string); $z->write($string); $z->syswrite($string [, $length, $offset]); $z->flush(); $z->tell(); $z->eof(); $z->seek($position, $whence); $z->binmode(); $z->fileno(); $z->opened(); $z->autoflush(); $z->input_line_number(); $z->newStream( [OPTS] ); $z->close() ; $Bzip2Error ; # IO::File mode print $z $string; printf $z $format, $string; tell $z eof $z seek $z, $position, $whence binmode $z fileno $z close $z ; =head1 DESCRIPTION This module provides a Perl interface that allows writing bzip2 compressed data to files or buffer. For reading bzip2 files/buffers, see the companion module L. =head1 Functional Interface A top-level function, C, is provided to carry out "one-shot" compression between buffers and/or files. For finer control over the compression process, see the L section. use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; bzip2 $input_filename_or_reference => $output_filename_or_reference [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; The functional interface needs Perl5.005 or better. =head2 bzip2 $input_filename_or_reference => $output_filename_or_reference [, OPTS] C expects at least two parameters, C<$input_filename_or_reference> and C<$output_filename_or_reference> and zero or more optional parameters (see L) =head3 The C<$input_filename_or_reference> parameter The parameter, C<$input_filename_or_reference>, is used to define the source of the uncompressed data. It can take one of the following forms: =over 5 =item A filename If the C<$input_filename_or_reference> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for reading and the input data will be read from it. =item A filehandle If the C<$input_filename_or_reference> parameter is a filehandle, the input data will be read from it. The string '-' can be used as an alias for standard input. =item A scalar reference If C<$input_filename_or_reference> is a scalar reference, the input data will be read from C<$$input_filename_or_reference>. =item An array reference If C<$input_filename_or_reference> is an array reference, each element in the array must be a filename. The input data will be read from each file in turn. The complete array will be walked to ensure that it only contains valid filenames before any data is compressed. =item An Input FileGlob string If C<$input_filename_or_reference> is a string that is delimited by the characters "<" and ">" C will assume that it is an I. The input is the list of files that match the fileglob. See L for more details. =back If the C<$input_filename_or_reference> parameter is any other type, C will be returned. =head3 The C<$output_filename_or_reference> parameter The parameter C<$output_filename_or_reference> is used to control the destination of the compressed data. This parameter can take one of these forms. =over 5 =item A filename If the C<$output_filename_or_reference> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for writing and the compressed data will be written to it. =item A filehandle If the C<$output_filename_or_reference> parameter is a filehandle, the compressed data will be written to it. The string '-' can be used as an alias for standard output. =item A scalar reference If C<$output_filename_or_reference> is a scalar reference, the compressed data will be stored in C<$$output_filename_or_reference>. =item An Array Reference If C<$output_filename_or_reference> is an array reference, the compressed data will be pushed onto the array. =item An Output FileGlob If C<$output_filename_or_reference> is a string that is delimited by the characters "<" and ">" C will assume that it is an I. The output is the list of files that match the fileglob. When C<$output_filename_or_reference> is an fileglob string, C<$input_filename_or_reference> must also be a fileglob string. Anything else is an error. See L for more details. =back If the C<$output_filename_or_reference> parameter is any other type, C will be returned. =head2 Notes When C<$input_filename_or_reference> maps to multiple files/buffers and C<$output_filename_or_reference> is a single file/buffer the input files/buffers will be stored in C<$output_filename_or_reference> as a concatenated series of compressed data streams. =head2 Optional Parameters The optional parameters for the one-shot function C are (for the most part) identical to those used with the OO interface defined in the L section. The exceptions are listed below =over 5 =item C<< AutoClose => 0|1 >> This option applies to any input or output data streams to C that are filehandles. If C is specified, and the value is true, it will result in all input and/or output filehandles being closed once C has completed. This parameter defaults to 0. =item C<< BinModeIn => 0|1 >> This option is now a no-op. All files will be read in binmode. =item C<< Append => 0|1 >> The behaviour of this option is dependent on the type of output data stream. =over 5 =item * A Buffer If C is enabled, all compressed data will be append to the end of the output buffer. Otherwise the output buffer will be cleared before any compressed data is written to it. =item * A Filename If C is enabled, the file will be opened in append mode. Otherwise the contents of the file, if any, will be truncated before any compressed data is written to it. =item * A Filehandle If C is enabled, the filehandle will be positioned to the end of the file via a call to C before any compressed data is written to it. Otherwise the file pointer will not be moved. =back When C is specified, and set to true, it will I all compressed data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for appending. If the output is a buffer, all compressed data will be appended to the existing buffer. Conversely when C is not specified, or it is present and is set to false, it will operate as follows. When the output is a filename, it will truncate the contents of the file before writing any compressed data. If the output is a filehandle its position will not be changed. If the output is a buffer, it will be wiped before any compressed data is output. Defaults to 0. =back =head2 Examples Here are a few example that show the capabilities of the module. =head3 Streaming This very simple command line example demonstrates the streaming capabilities of the module. The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT. $ echo hello world | perl -MIO::Compress::Bzip2=bzip2 -e 'bzip2 \*STDIN => \*STDOUT' >output.bz2 The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>, so the above can be rewritten as $ echo hello world | perl -MIO::Compress::Bzip2=bzip2 -e 'bzip2 "-" => "-"' >output.bz2 =head3 Compressing a file from the filesystem To read the contents of the file C and write the compressed data to the file C. use strict ; use warnings ; use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; my $input = "file1.txt"; bzip2 $input => "$input.bz2" or die "bzip2 failed: $Bzip2Error\n"; =head3 Reading from a Filehandle and writing to an in-memory buffer To read from an existing Perl filehandle, C<$input>, and write the compressed data to a buffer, C<$buffer>. use strict ; use warnings ; use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; use IO::File ; my $input = new IO::File " \$buffer or die "bzip2 failed: $Bzip2Error\n"; =head3 Compressing multiple files To compress all files in the directory "/my/home" that match "*.txt" and store the compressed data in the same directory use strict ; use warnings ; use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; bzip2 '' => '<*.bz2>' or die "bzip2 failed: $Bzip2Error\n"; and if you want to compress each file one at a time, this will do the trick use strict ; use warnings ; use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; for my $input ( glob "/my/home/*.txt" ) { my $output = "$input.bz2" ; bzip2 $input => $output or die "Error compressing '$input': $Bzip2Error\n"; } =head1 OO Interface =head2 Constructor The format of the constructor for C is shown below my $z = new IO::Compress::Bzip2 $output [,OPTS] or die "IO::Compress::Bzip2 failed: $Bzip2Error\n"; It returns an C object on success and undef on failure. The variable C<$Bzip2Error> will contain an error message on failure. If you are running Perl 5.005 or better the object, C<$z>, returned from IO::Compress::Bzip2 can be used exactly like an L filehandle. This means that all normal output file operations can be carried out with C<$z>. For example, to write to a compressed file/buffer you can use either of these forms $z->print("hello world\n"); print $z "hello world\n"; The mandatory parameter C<$output> is used to control the destination of the compressed data. This parameter can take one of these forms. =over 5 =item A filename If the C<$output> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for writing and the compressed data will be written to it. =item A filehandle If the C<$output> parameter is a filehandle, the compressed data will be written to it. The string '-' can be used as an alias for standard output. =item A scalar reference If C<$output> is a scalar reference, the compressed data will be stored in C<$$output>. =back If the C<$output> parameter is any other type, C::new will return undef. =head2 Constructor Options C is any combination of zero or more the following options: =over 5 =item C<< AutoClose => 0|1 >> This option is only valid when the C<$output> parameter is a filehandle. If specified, and the value is true, it will result in the C<$output> being closed once either the C method is called or the C object is destroyed. This parameter defaults to 0. =item C<< Append => 0|1 >> Opens C<$output> in append mode. The behaviour of this option is dependent on the type of C<$output>. =over 5 =item * A Buffer If C<$output> is a buffer and C is enabled, all compressed data will be append to the end of C<$output>. Otherwise C<$output> will be cleared before any data is written to it. =item * A Filename If C<$output> is a filename and C is enabled, the file will be opened in append mode. Otherwise the contents of the file, if any, will be truncated before any compressed data is written to it. =item * A Filehandle If C<$output> is a filehandle, the file pointer will be positioned to the end of the file via a call to C before any compressed data is written to it. Otherwise the file pointer will not be moved. =back This parameter defaults to 0. =item C<< BlockSize100K => number >> Specify the number of 100K blocks bzip2 uses during compression. Valid values are from 1 to 9, where 9 is best compression. The default is 1. =item C<< WorkFactor => number >> Specifies how much effort bzip2 should take before resorting to a slower fallback compression algorithm. Valid values range from 0 to 250, where 0 means use the default value 30. The default is 0. =item C<< Strict => 0|1 >> This is a placeholder option. =back =head2 Examples TODO =head1 Methods =head2 print Usage is $z->print($data) print $z $data Compresses and outputs the contents of the C<$data> parameter. This has the same behaviour as the C built-in. Returns true if successful. =head2 printf Usage is $z->printf($format, $data) printf $z $format, $data Compresses and outputs the contents of the C<$data> parameter. Returns true if successful. =head2 syswrite Usage is $z->syswrite $data $z->syswrite $data, $length $z->syswrite $data, $length, $offset Compresses and outputs the contents of the C<$data> parameter. Returns the number of uncompressed bytes written, or C if unsuccessful. =head2 write Usage is $z->write $data $z->write $data, $length $z->write $data, $length, $offset Compresses and outputs the contents of the C<$data> parameter. Returns the number of uncompressed bytes written, or C if unsuccessful. =head2 flush Usage is $z->flush; Flushes any pending compressed data to the output file/buffer. TODO Returns true on success. =head2 tell Usage is $z->tell() tell $z Returns the uncompressed file offset. =head2 eof Usage is $z->eof(); eof($z); Returns true if the C method has been called. =head2 seek $z->seek($position, $whence); seek($z, $position, $whence); Provides a sub-set of the C functionality, with the restriction that it is only legal to seek forward in the output file/buffer. It is a fatal error to attempt to seek backward. Empty parts of the file/buffer will have NULL (0x00) bytes written to them. The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. Returns 1 on success, 0 on failure. =head2 binmode Usage is $z->binmode binmode $z ; This is a noop provided for completeness. =head2 opened $z->opened() Returns true if the object currently refers to a opened file/buffer. =head2 autoflush my $prev = $z->autoflush() my $prev = $z->autoflush(EXPR) If the C<$z> object is associated with a file or a filehandle, this method returns the current autoflush setting for the underlying filehandle. If C is present, and is non-zero, it will enable flushing after every write/print operation. If C<$z> is associated with a buffer, this method has no effect and always returns C. B that the special variable C<$|> B be used to set or retrieve the autoflush setting. =head2 input_line_number $z->input_line_number() $z->input_line_number(EXPR) This method always returns C when compressing. =head2 fileno $z->fileno() fileno($z) If the C<$z> object is associated with a file or a filehandle, C will return the underlying file descriptor. Once the C method is called C will return C. If the C<$z> object is associated with a buffer, this method will return C. =head2 close $z->close() ; close $z ; Flushes any pending compressed data and then closes the output file/buffer. For most versions of Perl this method will be automatically invoked if the IO::Compress::Bzip2 object is destroyed (either explicitly or by the variable with the reference to the object going out of scope). The exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In these cases, the C method will be called automatically, but not until global destruction of all live objects when the program is terminating. Therefore, if you want your scripts to be able to run on all versions of Perl, you should call C explicitly and not rely on automatic closing. Returns true on success, otherwise 0. If the C option has been enabled when the IO::Compress::Bzip2 object was created, and the object is associated with a file, the underlying file will also be closed. =head2 newStream([OPTS]) Usage is $z->newStream( [OPTS] ) Closes the current compressed data stream and starts a new one. OPTS consists of any of the options that are available when creating the C<$z> object. See the L section for more details. =head1 Importing No symbolic constants are required by this IO::Compress::Bzip2 at present. =over 5 =item :all Imports C and C<$Bzip2Error>. Same as doing this use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; =back =head1 EXAMPLES =head2 Apache::GZip Revisited See L =head2 Working with Net::FTP See L =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L L, L, L, L The primary site for the bzip2 program is L. See the module L =head1 AUTHOR This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY See the Changes file. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/IO/Compress/Deflate.pm000066400000000000000000000602131357305601700222010ustar00rootroot00000000000000package IO::Compress::Deflate ; require 5.006 ; use strict ; use warnings; use bytes; require Exporter ; use IO::Compress::RawDeflate 2.093 (); use IO::Compress::Adapter::Deflate 2.093 ; use IO::Compress::Zlib::Constants 2.093 ; use IO::Compress::Base::Common 2.093 qw(); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); $VERSION = '2.093'; $DeflateError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @EXPORT_OK = qw( $DeflateError deflate ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); sub new { my $class = shift ; my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$DeflateError); return $obj->_create(undef, @_); } sub deflate { my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$DeflateError); return $obj->_def(@_); } sub bitmask($$$$) { my $into = shift ; my $value = shift ; my $offset = shift ; my $mask = shift ; return $into | (($value & $mask) << $offset ) ; } sub mkDeflateHdr($$$;$) { my $method = shift ; my $cinfo = shift; my $level = shift; my $fdict_adler = shift ; my $cmf = 0; my $flg = 0; my $fdict = 0; $fdict = 1 if defined $fdict_adler; $cmf = bitmask($cmf, $method, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS); $cmf = bitmask($cmf, $cinfo, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS); $flg = bitmask($flg, $fdict, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS); $flg = bitmask($flg, $level, ZLIB_FLG_LEVEL_OFFSET, ZLIB_FLG_LEVEL_BITS); my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ; $flg = bitmask($flg, $fcheck, ZLIB_FLG_FCHECK_OFFSET, ZLIB_FLG_FCHECK_BITS); my $hdr = pack("CC", $cmf, $flg) ; $hdr .= pack("N", $fdict_adler) if $fdict ; return $hdr; } sub mkHeader { my $self = shift ; my $param = shift ; my $level = $param->getValue('level'); my $strategy = $param->getValue('strategy'); my $lflag ; $level = 6 if $level == Z_DEFAULT_COMPRESSION ; if (ZLIB_VERNUM >= 0x1210) { if ($strategy >= Z_HUFFMAN_ONLY || $level < 2) { $lflag = ZLIB_FLG_LEVEL_FASTEST } elsif ($level < 6) { $lflag = ZLIB_FLG_LEVEL_FAST } elsif ($level == 6) { $lflag = ZLIB_FLG_LEVEL_DEFAULT } else { $lflag = ZLIB_FLG_LEVEL_SLOWEST } } else { $lflag = ($level - 1) >> 1 ; $lflag = 3 if $lflag > 3 ; } #my $wbits = (MAX_WBITS - 8) << 4 ; my $wbits = 7; mkDeflateHdr(ZLIB_CMF_CM_DEFLATED, $wbits, $lflag); } sub ckParams { my $self = shift ; my $got = shift; $got->setValue('adler32' => 1); return 1 ; } sub mkTrailer { my $self = shift ; return pack("N", *$self->{Compress}->adler32()) ; } sub mkFinalTrailer { return ''; } #sub newHeader #{ # my $self = shift ; # return *$self->{Header}; #} sub getExtraParams { my $self = shift ; return $self->getZlibParams(), } sub getInverseClass { return ('IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError); } sub getFileInfo { my $self = shift ; my $params = shift; my $file = shift ; } 1; __END__ =head1 NAME IO::Compress::Deflate - Write RFC 1950 files/buffers =head1 SYNOPSIS use IO::Compress::Deflate qw(deflate $DeflateError) ; my $status = deflate $input => $output [,OPTS] or die "deflate failed: $DeflateError\n"; my $z = new IO::Compress::Deflate $output [,OPTS] or die "deflate failed: $DeflateError\n"; $z->print($string); $z->printf($format, $string); $z->write($string); $z->syswrite($string [, $length, $offset]); $z->flush(); $z->tell(); $z->eof(); $z->seek($position, $whence); $z->binmode(); $z->fileno(); $z->opened(); $z->autoflush(); $z->input_line_number(); $z->newStream( [OPTS] ); $z->deflateParams(); $z->close() ; $DeflateError ; # IO::File mode print $z $string; printf $z $format, $string; tell $z eof $z seek $z, $position, $whence binmode $z fileno $z close $z ; =head1 DESCRIPTION This module provides a Perl interface that allows writing compressed data to files or buffer as defined in RFC 1950. For reading RFC 1950 files/buffers, see the companion module L. =head1 Functional Interface A top-level function, C, is provided to carry out "one-shot" compression between buffers and/or files. For finer control over the compression process, see the L section. use IO::Compress::Deflate qw(deflate $DeflateError) ; deflate $input_filename_or_reference => $output_filename_or_reference [,OPTS] or die "deflate failed: $DeflateError\n"; The functional interface needs Perl5.005 or better. =head2 deflate $input_filename_or_reference => $output_filename_or_reference [, OPTS] C expects at least two parameters, C<$input_filename_or_reference> and C<$output_filename_or_reference> and zero or more optional parameters (see L) =head3 The C<$input_filename_or_reference> parameter The parameter, C<$input_filename_or_reference>, is used to define the source of the uncompressed data. It can take one of the following forms: =over 5 =item A filename If the C<$input_filename_or_reference> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for reading and the input data will be read from it. =item A filehandle If the C<$input_filename_or_reference> parameter is a filehandle, the input data will be read from it. The string '-' can be used as an alias for standard input. =item A scalar reference If C<$input_filename_or_reference> is a scalar reference, the input data will be read from C<$$input_filename_or_reference>. =item An array reference If C<$input_filename_or_reference> is an array reference, each element in the array must be a filename. The input data will be read from each file in turn. The complete array will be walked to ensure that it only contains valid filenames before any data is compressed. =item An Input FileGlob string If C<$input_filename_or_reference> is a string that is delimited by the characters "<" and ">" C will assume that it is an I. The input is the list of files that match the fileglob. See L for more details. =back If the C<$input_filename_or_reference> parameter is any other type, C will be returned. =head3 The C<$output_filename_or_reference> parameter The parameter C<$output_filename_or_reference> is used to control the destination of the compressed data. This parameter can take one of these forms. =over 5 =item A filename If the C<$output_filename_or_reference> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for writing and the compressed data will be written to it. =item A filehandle If the C<$output_filename_or_reference> parameter is a filehandle, the compressed data will be written to it. The string '-' can be used as an alias for standard output. =item A scalar reference If C<$output_filename_or_reference> is a scalar reference, the compressed data will be stored in C<$$output_filename_or_reference>. =item An Array Reference If C<$output_filename_or_reference> is an array reference, the compressed data will be pushed onto the array. =item An Output FileGlob If C<$output_filename_or_reference> is a string that is delimited by the characters "<" and ">" C will assume that it is an I. The output is the list of files that match the fileglob. When C<$output_filename_or_reference> is an fileglob string, C<$input_filename_or_reference> must also be a fileglob string. Anything else is an error. See L for more details. =back If the C<$output_filename_or_reference> parameter is any other type, C will be returned. =head2 Notes When C<$input_filename_or_reference> maps to multiple files/buffers and C<$output_filename_or_reference> is a single file/buffer the input files/buffers will be stored in C<$output_filename_or_reference> as a concatenated series of compressed data streams. =head2 Optional Parameters The optional parameters for the one-shot function C are (for the most part) identical to those used with the OO interface defined in the L section. The exceptions are listed below =over 5 =item C<< AutoClose => 0|1 >> This option applies to any input or output data streams to C that are filehandles. If C is specified, and the value is true, it will result in all input and/or output filehandles being closed once C has completed. This parameter defaults to 0. =item C<< BinModeIn => 0|1 >> This option is now a no-op. All files will be read in binmode. =item C<< Append => 0|1 >> The behaviour of this option is dependent on the type of output data stream. =over 5 =item * A Buffer If C is enabled, all compressed data will be append to the end of the output buffer. Otherwise the output buffer will be cleared before any compressed data is written to it. =item * A Filename If C is enabled, the file will be opened in append mode. Otherwise the contents of the file, if any, will be truncated before any compressed data is written to it. =item * A Filehandle If C is enabled, the filehandle will be positioned to the end of the file via a call to C before any compressed data is written to it. Otherwise the file pointer will not be moved. =back When C is specified, and set to true, it will I all compressed data to the output data stream. So when the output is a filehandle it will carry out a seek to the eof before writing any compressed data. If the output is a filename, it will be opened for appending. If the output is a buffer, all compressed data will be appended to the existing buffer. Conversely when C is not specified, or it is present and is set to false, it will operate as follows. When the output is a filename, it will truncate the contents of the file before writing any compressed data. If the output is a filehandle its position will not be changed. If the output is a buffer, it will be wiped before any compressed data is output. Defaults to 0. =back =head2 Examples Here are a few example that show the capabilities of the module. =head3 Streaming This very simple command line example demonstrates the streaming capabilities of the module. The code reads data from STDIN, compresses it, and writes the compressed data to STDOUT. $ echo hello world | perl -MIO::Compress::Deflate=deflate -e 'deflate \*STDIN => \*STDOUT' >output.1950 The special filename "-" can be used as a standin for both C<\*STDIN> and C<\*STDOUT>, so the above can be rewritten as $ echo hello world | perl -MIO::Compress::Deflate=deflate -e 'deflate "-" => "-"' >output.1950 =head3 Compressing a file from the filesystem To read the contents of the file C and write the compressed data to the file C. use strict ; use warnings ; use IO::Compress::Deflate qw(deflate $DeflateError) ; my $input = "file1.txt"; deflate $input => "$input.1950" or die "deflate failed: $DeflateError\n"; =head3 Reading from a Filehandle and writing to an in-memory buffer To read from an existing Perl filehandle, C<$input>, and write the compressed data to a buffer, C<$buffer>. use strict ; use warnings ; use IO::Compress::Deflate qw(deflate $DeflateError) ; use IO::File ; my $input = new IO::File " \$buffer or die "deflate failed: $DeflateError\n"; =head3 Compressing multiple files To compress all files in the directory "/my/home" that match "*.txt" and store the compressed data in the same directory use strict ; use warnings ; use IO::Compress::Deflate qw(deflate $DeflateError) ; deflate '' => '<*.1950>' or die "deflate failed: $DeflateError\n"; and if you want to compress each file one at a time, this will do the trick use strict ; use warnings ; use IO::Compress::Deflate qw(deflate $DeflateError) ; for my $input ( glob "/my/home/*.txt" ) { my $output = "$input.1950" ; deflate $input => $output or die "Error compressing '$input': $DeflateError\n"; } =head1 OO Interface =head2 Constructor The format of the constructor for C is shown below my $z = new IO::Compress::Deflate $output [,OPTS] or die "IO::Compress::Deflate failed: $DeflateError\n"; It returns an C object on success and undef on failure. The variable C<$DeflateError> will contain an error message on failure. If you are running Perl 5.005 or better the object, C<$z>, returned from IO::Compress::Deflate can be used exactly like an L filehandle. This means that all normal output file operations can be carried out with C<$z>. For example, to write to a compressed file/buffer you can use either of these forms $z->print("hello world\n"); print $z "hello world\n"; The mandatory parameter C<$output> is used to control the destination of the compressed data. This parameter can take one of these forms. =over 5 =item A filename If the C<$output> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for writing and the compressed data will be written to it. =item A filehandle If the C<$output> parameter is a filehandle, the compressed data will be written to it. The string '-' can be used as an alias for standard output. =item A scalar reference If C<$output> is a scalar reference, the compressed data will be stored in C<$$output>. =back If the C<$output> parameter is any other type, C::new will return undef. =head2 Constructor Options C is any combination of zero or more the following options: =over 5 =item C<< AutoClose => 0|1 >> This option is only valid when the C<$output> parameter is a filehandle. If specified, and the value is true, it will result in the C<$output> being closed once either the C method is called or the C object is destroyed. This parameter defaults to 0. =item C<< Append => 0|1 >> Opens C<$output> in append mode. The behaviour of this option is dependent on the type of C<$output>. =over 5 =item * A Buffer If C<$output> is a buffer and C is enabled, all compressed data will be append to the end of C<$output>. Otherwise C<$output> will be cleared before any data is written to it. =item * A Filename If C<$output> is a filename and C is enabled, the file will be opened in append mode. Otherwise the contents of the file, if any, will be truncated before any compressed data is written to it. =item * A Filehandle If C<$output> is a filehandle, the file pointer will be positioned to the end of the file via a call to C before any compressed data is written to it. Otherwise the file pointer will not be moved. =back This parameter defaults to 0. =item C<< Merge => 0|1 >> This option is used to compress input data and append it to an existing compressed data stream in C<$output>. The end result is a single compressed data stream stored in C<$output>. It is a fatal error to attempt to use this option when C<$output> is not an RFC 1950 data stream. There are a number of other limitations with the C option: =over 5 =item 1 This module needs to have been built with zlib 1.2.1 or better to work. A fatal error will be thrown if C is used with an older version of zlib. =item 2 If C<$output> is a file or a filehandle, it must be seekable. =back This parameter defaults to 0. =item -Level Defines the compression level used by zlib. The value should either be a number between 0 and 9 (0 means no compression and 9 is maximum compression), or one of the symbolic constants defined below. Z_NO_COMPRESSION Z_BEST_SPEED Z_BEST_COMPRESSION Z_DEFAULT_COMPRESSION The default is Z_DEFAULT_COMPRESSION. Note, these constants are not imported by C by default. use IO::Compress::Deflate qw(:strategy); use IO::Compress::Deflate qw(:constants); use IO::Compress::Deflate qw(:all); =item -Strategy Defines the strategy used to tune the compression. Use one of the symbolic constants defined below. Z_FILTERED Z_HUFFMAN_ONLY Z_RLE Z_FIXED Z_DEFAULT_STRATEGY The default is Z_DEFAULT_STRATEGY. =item C<< Strict => 0|1 >> This is a placeholder option. =back =head2 Examples TODO =head1 Methods =head2 print Usage is $z->print($data) print $z $data Compresses and outputs the contents of the C<$data> parameter. This has the same behaviour as the C built-in. Returns true if successful. =head2 printf Usage is $z->printf($format, $data) printf $z $format, $data Compresses and outputs the contents of the C<$data> parameter. Returns true if successful. =head2 syswrite Usage is $z->syswrite $data $z->syswrite $data, $length $z->syswrite $data, $length, $offset Compresses and outputs the contents of the C<$data> parameter. Returns the number of uncompressed bytes written, or C if unsuccessful. =head2 write Usage is $z->write $data $z->write $data, $length $z->write $data, $length, $offset Compresses and outputs the contents of the C<$data> parameter. Returns the number of uncompressed bytes written, or C if unsuccessful. =head2 flush Usage is $z->flush; $z->flush($flush_type); Flushes any pending compressed data to the output file/buffer. This method takes an optional parameter, C<$flush_type>, that controls how the flushing will be carried out. By default the C<$flush_type> used is C. Other valid values for C<$flush_type> are C, C, C and C. It is strongly recommended that you only set the C parameter if you fully understand the implications of what it does - overuse of C can seriously degrade the level of compression achieved. See the C documentation for details. Returns true on success. =head2 tell Usage is $z->tell() tell $z Returns the uncompressed file offset. =head2 eof Usage is $z->eof(); eof($z); Returns true if the C method has been called. =head2 seek $z->seek($position, $whence); seek($z, $position, $whence); Provides a sub-set of the C functionality, with the restriction that it is only legal to seek forward in the output file/buffer. It is a fatal error to attempt to seek backward. Empty parts of the file/buffer will have NULL (0x00) bytes written to them. The C<$whence> parameter takes one the usual values, namely SEEK_SET, SEEK_CUR or SEEK_END. Returns 1 on success, 0 on failure. =head2 binmode Usage is $z->binmode binmode $z ; This is a noop provided for completeness. =head2 opened $z->opened() Returns true if the object currently refers to a opened file/buffer. =head2 autoflush my $prev = $z->autoflush() my $prev = $z->autoflush(EXPR) If the C<$z> object is associated with a file or a filehandle, this method returns the current autoflush setting for the underlying filehandle. If C is present, and is non-zero, it will enable flushing after every write/print operation. If C<$z> is associated with a buffer, this method has no effect and always returns C. B that the special variable C<$|> B be used to set or retrieve the autoflush setting. =head2 input_line_number $z->input_line_number() $z->input_line_number(EXPR) This method always returns C when compressing. =head2 fileno $z->fileno() fileno($z) If the C<$z> object is associated with a file or a filehandle, C will return the underlying file descriptor. Once the C method is called C will return C. If the C<$z> object is associated with a buffer, this method will return C. =head2 close $z->close() ; close $z ; Flushes any pending compressed data and then closes the output file/buffer. For most versions of Perl this method will be automatically invoked if the IO::Compress::Deflate object is destroyed (either explicitly or by the variable with the reference to the object going out of scope). The exceptions are Perl versions 5.005 through 5.00504 and 5.8.0. In these cases, the C method will be called automatically, but not until global destruction of all live objects when the program is terminating. Therefore, if you want your scripts to be able to run on all versions of Perl, you should call C explicitly and not rely on automatic closing. Returns true on success, otherwise 0. If the C option has been enabled when the IO::Compress::Deflate object was created, and the object is associated with a file, the underlying file will also be closed. =head2 newStream([OPTS]) Usage is $z->newStream( [OPTS] ) Closes the current compressed data stream and starts a new one. OPTS consists of any of the options that are available when creating the C<$z> object. See the L section for more details. =head2 deflateParams Usage is $z->deflateParams TODO =head1 Importing A number of symbolic constants are required by some methods in C. None are imported by default. =over 5 =item :all Imports C, C<$DeflateError> and all symbolic constants that can be used by C. Same as doing this use IO::Compress::Deflate qw(deflate $DeflateError :constants) ; =item :constants Import all symbolic constants. Same as doing this use IO::Compress::Deflate qw(:flush :level :strategy) ; =item :flush These symbolic constants are used by the C method. Z_NO_FLUSH Z_PARTIAL_FLUSH Z_SYNC_FLUSH Z_FULL_FLUSH Z_FINISH Z_BLOCK =item :level These symbolic constants are used by the C option in the constructor. Z_NO_COMPRESSION Z_BEST_SPEED Z_BEST_COMPRESSION Z_DEFAULT_COMPRESSION =item :strategy These symbolic constants are used by the C option in the constructor. Z_FILTERED Z_HUFFMAN_ONLY Z_RLE Z_FIXED Z_DEFAULT_STRATEGY =back =head1 EXAMPLES =head2 Apache::GZip Revisited See L =head2 Working with Net::FTP See L =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L L, L, L, L For RFC 1950, 1951 and 1952 see L, L and L The I compression library was written by Jean-loup Gailly C and Mark Adler C. The primary site for the I compression library is L. The primary site for gzip is L. =head1 AUTHOR This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY See the Changes file. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/IO/Compress/FAQ.pod000066400000000000000000000510301357305601700214070ustar00rootroot00000000000000 =head1 NAME IO::Compress::FAQ -- Frequently Asked Questions about IO::Compress =head1 DESCRIPTION Common questions answered. =head1 GENERAL =head2 Compatibility with Unix compress/uncompress. Although C has a pair of functions called C and C, they are I related to the Unix programs of the same name. The C module is not compatible with Unix C. If you have the C program available, you can use this to read compressed files open F, "uncompress -c $filename |"; while () { ... Alternatively, if you have the C program available, you can use this to read compressed files open F, "gunzip -c $filename |"; while () { ... and this to write compress files, if you have the C program available open F, "| compress -c $filename "; print F "data"; ... close F ; =head2 Accessing .tar.Z files The C module can optionally use C (via the C module) to access tar files that have been compressed with C. Unfortunately tar files compressed with the Unix C utility cannot be read by C and so cannot be directly accessed by C. If the C or C programs are available, you can use one of these workarounds to read C<.tar.Z> files from C Firstly with C use strict; use warnings; use Archive::Tar; open F, "uncompress -c $filename |"; my $tar = Archive::Tar->new(*F); ... and this with C use strict; use warnings; use Archive::Tar; open F, "gunzip -c $filename |"; my $tar = Archive::Tar->new(*F); ... Similarly, if the C program is available, you can use this to write a C<.tar.Z> file use strict; use warnings; use Archive::Tar; use IO::File; my $fh = new IO::File "| compress -c >$filename"; my $tar = Archive::Tar->new(); ... $tar->write($fh); $fh->close ; =head2 How do I recompress using a different compression? This is easier that you might expect if you realise that all the C objects are derived from C and that all the C modules can read from an C filehandle. So, for example, say you have a file compressed with gzip that you want to recompress with bzip2. Here is all that is needed to carry out the recompression. use IO::Uncompress::Gunzip ':all'; use IO::Compress::Bzip2 ':all'; my $gzipFile = "somefile.gz"; my $bzipFile = "somefile.bz2"; my $gunzip = new IO::Uncompress::Gunzip $gzipFile or die "Cannot gunzip $gzipFile: $GunzipError\n" ; bzip2 $gunzip => $bzipFile or die "Cannot bzip2 to $bzipFile: $Bzip2Error\n" ; Note, there is a limitation of this technique. Some compression file formats store extra information along with the compressed data payload. For example, gzip can optionally store the original filename and Zip stores a lot of information about the original file. If the original compressed file contains any of this extra information, it will not be transferred to the new compressed file using the technique above. =head1 ZIP =head2 What Compression Types do IO::Compress::Zip & IO::Uncompress::Unzip support? The following compression formats are supported by C and C =over 5 =item * Store (method 0) No compression at all. =item * Deflate (method 8) This is the default compression used when creating a zip file with C. =item * Bzip2 (method 12) Only supported if the C module is installed. =item * Lzma (method 14) Only supported if the C module is installed. =back =head2 Can I Read/Write Zip files larger the 4 Gig? Yes, both the C and C modules support the zip feature called I. That allows them to read/write files/buffers larger than 4Gig. If you are creating a Zip file using the one-shot interface, and any of the input files is greater than 4Gig, a zip64 complaint zip file will be created. zip "really-large-file" => "my.zip"; Similarly with the one-shot interface, if the input is a buffer larger than 4 Gig, a zip64 complaint zip file will be created. zip \$really_large_buffer => "my.zip"; The one-shot interface allows you to force the creation of a zip64 zip file by including the C option. zip $filehandle => "my.zip", Zip64 => 1; If you want to create a zip64 zip file with the OO interface you must specify the C option. my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; When uncompressing with C, it will automatically detect if the zip file is zip64. If you intend to manipulate the Zip64 zip files created with C using an external zip/unzip, make sure that it supports Zip64. In particular, if you are using Info-Zip you need to have zip version 3.x or better to update a Zip64 archive and unzip version 6.x to read a zip64 archive. =head2 Can I write more that 64K entries is a Zip files? Yes. Zip64 allows this. See previous question. =head2 Zip Resources The primary reference for zip files is the "appnote" document available at L An alternatively is the Info-Zip appnote. This is available from L =head1 GZIP =head2 Gzip Resources The primary reference for gzip files is RFC 1952 L The primary site for gzip is L. =head2 Dealing with concatenated gzip files If the gunzip program encounters a file containing multiple gzip files concatenated together it will automatically uncompress them all. The example below illustrates this behaviour $ echo abc | gzip -c >x.gz $ echo def | gzip -c >>x.gz $ gunzip -c x.gz abc def By default C will I behave like the gunzip program. It will only uncompress the first gzip data stream in the file, as shown below $ perl -MIO::Uncompress::Gunzip=:all -e 'gunzip "x.gz" => \*STDOUT' abc To force C to uncompress all the gzip data streams, include the C option, as shown below $ perl -MIO::Uncompress::Gunzip=:all -e 'gunzip "x.gz" => \*STDOUT, MultiStream => 1' abc def =head2 Reading bgzip files with IO::Uncompress::Gunzip A C file consists of a series of valid gzip-compliant data streams concatenated together. To read a file created by C with C use the C option as shown in the previous section. See the section titled "The BGZF compression format" in L for a definition of C. =head1 ZLIB =head2 Zlib Resources The primary site for the I compression library is L. =head1 Bzip2 =head2 Bzip2 Resources The primary site for bzip2 is L. =head2 Dealing with Concatenated bzip2 files If the bunzip2 program encounters a file containing multiple bzip2 files concatenated together it will automatically uncompress them all. The example below illustrates this behaviour $ echo abc | bzip2 -c >x.bz2 $ echo def | bzip2 -c >>x.bz2 $ bunzip2 -c x.bz2 abc def By default C will I behave like the bunzip2 program. It will only uncompress the first bunzip2 data stream in the file, as shown below $ perl -MIO::Uncompress::Bunzip2=:all -e 'bunzip2 "x.bz2" => \*STDOUT' abc To force C to uncompress all the bzip2 data streams, include the C option, as shown below $ perl -MIO::Uncompress::Bunzip2=:all -e 'bunzip2 "x.bz2" => \*STDOUT, MultiStream => 1' abc def =head2 Interoperating with Pbzip2 Pbzip2 (L) is a parallel implementation of bzip2. The output from pbzip2 consists of a series of concatenated bzip2 data streams. By default C will only uncompress the first bzip2 data stream in a pbzip2 file. To uncompress the complete pbzip2 file you must include the C option, like this. bunzip2 $input => \$output, MultiStream => 1 or die "bunzip2 failed: $Bunzip2Error\n"; =head1 HTTP & NETWORK =head2 Apache::GZip Revisited Below is a mod_perl Apache compression module, called C, taken from L package Apache::GZip; #File: Apache::GZip.pm use strict vars; use Apache::Constants ':common'; use Compress::Zlib; use IO::File; use constant GZIP_MAGIC => 0x1f8b; use constant OS_MAGIC => 0x03; sub handler { my $r = shift; my ($fh,$gz); my $file = $r->filename; return DECLINED unless $fh=IO::File->new($file); $r->header_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; tie *STDOUT,'Apache::GZip',$r; print($_) while <$fh>; untie *STDOUT; return OK; } sub TIEHANDLE { my($class,$r) = @_; # initialize a deflation stream my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; # gzip header -- don't ask how I found out $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); return bless { r => $r, crc => crc32(undef), d => $d, l => 0 },$class; } sub PRINT { my $self = shift; foreach (@_) { # deflate the data my $data = $self->{d}->deflate($_); $self->{r}->print($data); # keep track of its length and crc $self->{l} += length($_); $self->{crc} = crc32($_,$self->{crc}); } } sub DESTROY { my $self = shift; # flush the output buffers my $data = $self->{d}->flush; $self->{r}->print($data); # print the CRC and the total length (uncompressed) $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); } 1; Here's the Apache configuration entry you'll need to make use of it. Once set it will result in everything in the /compressed directory will be compressed automagically. SetHandler perl-script PerlHandler Apache::GZip Although at first sight there seems to be quite a lot going on in C, you could sum up what the code was doing as follows -- read the contents of the file in C<< $r->filename >>, compress it and write the compressed data to standard output. That's all. This code has to jump through a few hoops to achieve this because =over =item 1. The gzip support in C version 1.x can only work with a real filesystem filehandle. The filehandles used by Apache modules are not associated with the filesystem. =item 2. That means all the gzip support has to be done by hand - in this case by creating a tied filehandle to deal with creating the gzip header and trailer. =back C doesn't have that filehandle limitation (this was one of the reasons for writing it in the first place). So if C is used instead of C the whole tied filehandle code can be removed. Here is the rewritten code. package Apache::GZip; use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip; use IO::File; sub handler { my $r = shift; my ($fh,$gz); my $file = $r->filename; return DECLINED unless $fh=IO::File->new($file); $r->header_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; my $gz = new IO::Compress::Gzip '-', Minimal => 1 or return DECLINED ; print $gz $_ while <$fh>; return OK; } or even more succinctly, like this, using a one-shot gzip package Apache::GZip; use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip qw(gzip); sub handler { my $r = shift; $r->header_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; gzip $r->filename => '-', Minimal => 1 or return DECLINED ; return OK; } 1; The use of one-shot C above just reads from C<< $r->filename >> and writes the compressed data to standard output. Note the use of the C option in the code above. When using gzip for Content-Encoding you should I use this option. In the example above it will prevent the filename being included in the gzip header and make the size of the gzip data stream a slight bit smaller. =head2 Compressed files and Net::FTP The C module provides two low-level methods called C and C that both return filehandles. These filehandles can used with the C modules to compress or uncompress files read from or written to an FTP Server on the fly, without having to create a temporary file. Firstly, here is code that uses C to uncompressed a file as it is read from the FTP Server. use Net::FTP; use IO::Uncompress::Gunzip qw(:all); my $ftp = new Net::FTP ... my $retr_fh = $ftp->retr($compressed_filename); gunzip $retr_fh => $outFilename, AutoClose => 1 or die "Cannot uncompress '$compressed_file': $GunzipError\n"; and this to compress a file as it is written to the FTP Server use Net::FTP; use IO::Compress::Gzip qw(:all); my $stor_fh = $ftp->stor($filename); gzip "filename" => $stor_fh, AutoClose => 1 or die "Cannot compress '$filename': $GzipError\n"; =head1 MISC =head2 Using C to uncompress data embedded in a larger file/buffer. A fairly common use-case is where compressed data is embedded in a larger file/buffer and you want to read both. As an example consider the structure of a zip file. This is a well-defined file format that mixes both compressed and uncompressed sections of data in a single file. For the purposes of this discussion you can think of a zip file as sequence of compressed data streams, each of which is prefixed by an uncompressed local header. The local header contains information about the compressed data stream, including the name of the compressed file and, in particular, the length of the compressed data stream. To illustrate how to use C here is a script that walks a zip file and prints out how many lines are in each compressed file (if you intend write code to walking through a zip file for real see L ). Also, although this example uses the zlib-based compression, the technique can be used by the other C modules. use strict; use warnings; use IO::File; use IO::Uncompress::RawInflate qw(:all); use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; use constant ZIP_LOCAL_HDR_LENGTH => 30; my $file = $ARGV[0] ; my $fh = new IO::File "<$file" or die "Cannot open '$file': $!\n"; while (1) { my $sig; my $buffer; my $x ; ($x = $fh->read($buffer, ZIP_LOCAL_HDR_LENGTH)) == ZIP_LOCAL_HDR_LENGTH or die "Truncated file: $!\n"; my $signature = unpack ("V", substr($buffer, 0, 4)); last unless $signature == ZIP_LOCAL_HDR_SIG; # Read Local Header my $gpFlag = unpack ("v", substr($buffer, 6, 2)); my $compressedMethod = unpack ("v", substr($buffer, 8, 2)); my $compressedLength = unpack ("V", substr($buffer, 18, 4)); my $uncompressedLength = unpack ("V", substr($buffer, 22, 4)); my $filename_length = unpack ("v", substr($buffer, 26, 2)); my $extra_length = unpack ("v", substr($buffer, 28, 2)); my $filename ; $fh->read($filename, $filename_length) == $filename_length or die "Truncated file\n"; $fh->read($buffer, $extra_length) == $extra_length or die "Truncated file\n"; if ($compressedMethod != 8 && $compressedMethod != 0) { warn "Skipping file '$filename' - not deflated $compressedMethod\n"; $fh->read($buffer, $compressedLength) == $compressedLength or die "Truncated file\n"; next; } if ($compressedMethod == 0 && $gpFlag & 8 == 8) { die "Streamed Stored not supported for '$filename'\n"; } next if $compressedLength == 0; # Done reading the Local Header my $inf = new IO::Uncompress::RawInflate $fh, Transparent => 1, InputLength => $compressedLength or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; while (<$inf>) { ++ $line_count; } print "$filename: $line_count\n"; } The majority of the code above is concerned with reading the zip local header data. The code that I want to focus on is at the bottom. while (1) { # read local zip header data # get $filename # get $compressedLength my $inf = new IO::Uncompress::RawInflate $fh, Transparent => 1, InputLength => $compressedLength or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; while (<$inf>) { ++ $line_count; } print "$filename: $line_count\n"; } The call to C creates a new filehandle C<$inf> that can be used to read from the parent filehandle C<$fh>, uncompressing it as it goes. The use of the C option will guarantee that I C<$compressedLength> bytes of compressed data will be read from the C<$fh> filehandle (The only exception is for an error case like a truncated file or a corrupt data stream). This means that once RawInflate is finished C<$fh> will be left at the byte directly after the compressed data stream. Now consider what the code looks like without C while (1) { # read local zip header data # get $filename # get $compressedLength # read all the compressed data into $data read($fh, $data, $compressedLength); my $inf = new IO::Uncompress::RawInflate \$data, Transparent => 1, or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; while (<$inf>) { ++ $line_count; } print "$filename: $line_count\n"; } The difference here is the addition of the temporary variable C<$data>. This is used to store a copy of the compressed data while it is being uncompressed. If you know that C<$compressedLength> isn't that big then using temporary storage won't be a problem. But if C<$compressedLength> is very large or you are writing an application that other people will use, and so have no idea how big C<$compressedLength> will be, it could be an issue. Using C avoids the use of temporary storage and means the application can cope with large compressed data streams. One final point -- obviously C can only be used whenever you know the length of the compressed data beforehand, like here with a zip file. =head1 SUPPORT General feedback/questions/bug reports should be sent to L (preferred) or L. =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L L L, L, L, L =head1 AUTHOR This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY See the Changes file. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005-2019 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libio-compress-perl-2.093/lib/IO/Compress/Gzip.pm000066400000000000000000001045611357305601700215530ustar00rootroot00000000000000package IO::Compress::Gzip ; require 5.006 ; use strict ; use warnings; use bytes; require Exporter ; use IO::Compress::RawDeflate 2.093 () ; use IO::Compress::Adapter::Deflate 2.093 ; use IO::Compress::Base::Common 2.093 qw(:Status ); use IO::Compress::Gzip::Constants 2.093 ; use IO::Compress::Zlib::Extra 2.093 ; BEGIN { if (defined &utf8::downgrade ) { *noUTF8 = \&utf8::downgrade } else { *noUTF8 = sub {} } } our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); $VERSION = '2.093'; $GzipError = '' ; @ISA = qw(IO::Compress::RawDeflate Exporter); @EXPORT_OK = qw( $GzipError gzip ) ; %EXPORT_TAGS = %IO::Compress::RawDeflate::DEFLATE_CONSTANTS ; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); sub new { my $class = shift ; my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$GzipError); $obj->_create(undef, @_); } sub gzip { my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$GzipError); return $obj->_def(@_); } #sub newHeader #{ # my $self = shift ; # #return GZIP_MINIMUM_HEADER ; # return $self->mkHeader(*$self->{Got}); #} sub getExtraParams { my $self = shift ; return ( # zlib behaviour $self->getZlibParams(), # Gzip header fields 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 'comment' => [IO::Compress::Base::Common::Parse_any, undef], 'name' => [IO::Compress::Base::Common::Parse_any, undef], 'time' => [IO::Compress::Base::Common::Parse_any, undef], 'textflag' => [IO::Compress::Base::Common::Parse_boolean, 0], 'headercrc' => [IO::Compress::Base::Common::Parse_boolean, 0], 'os_code' => [IO::Compress::Base::Common::Parse_unsigned, $Compress::Raw::Zlib::gzip_os_code], 'extrafield'=> [IO::Compress::Base::Common::Parse_any, undef], 'extraflags'=> [IO::Compress::Base::Common::Parse_any, undef], ); } sub ckParams { my $self = shift ; my $got = shift ; # gzip always needs crc32 $got->setValue('crc32' => 1); return 1 if $got->getValue('merge') ; my $strict = $got->getValue('strict') ; { if (! $got->parsed('time') ) { # Modification time defaults to now. $got->setValue(time => time) ; } # Check that the Name & Comment don't have embedded NULLs # Also check that they only contain ISO 8859-1 chars. if ($got->parsed('name') && defined $got->getValue('name')) { my $name = $got->getValue('name'); return $self->saveErrorString(undef, "Null Character found in Name", Z_DATA_ERROR) if $strict && $name =~ /\x00/ ; return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Name", Z_DATA_ERROR) if $strict && $name =~ /$GZIP_FNAME_INVALID_CHAR_RE/o ; } if ($got->parsed('comment') && defined $got->getValue('comment')) { my $comment = $got->getValue('comment'); return $self->saveErrorString(undef, "Null Character found in Comment", Z_DATA_ERROR) if $strict && $comment =~ /\x00/ ; return $self->saveErrorString(undef, "Non ISO 8859-1 Character found in Comment", Z_DATA_ERROR) if $strict && $comment =~ /$GZIP_FCOMMENT_INVALID_CHAR_RE/o; } if ($got->parsed('os_code') ) { my $value = $got->getValue('os_code'); return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'") if $value < 0 || $value > 255 ; } # gzip only supports Deflate at present $got->setValue('method' => Z_DEFLATED) ; if ( ! $got->parsed('extraflags')) { $got->setValue('extraflags' => 2) if $got->getValue('level') == Z_BEST_COMPRESSION ; $got->setValue('extraflags' => 4) if $got->getValue('level') == Z_BEST_SPEED ; } my $data = $got->getValue('extrafield') ; if (defined $data) { my $bad = IO::Compress::Zlib::Extra::parseExtraField($data, $strict, 1) ; return $self->saveErrorString(undef, "Error with ExtraField Parameter: $bad", Z_DATA_ERROR) if $bad ; $got->setValue('extrafield' => $data) ; } } return 1; } sub mkTrailer { my $self = shift ; return pack("V V", *$self->{Compress}->crc32(), *$self->{UnCompSize}->get32bit()); } sub getInverseClass { return ('IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError); } sub getFileInfo { my $self = shift ; my $params = shift; my $filename = shift ; return if IO::Compress::Base::Common::isaScalar($filename); my $defaultTime = (stat($filename))[9] ; $params->setValue('name' => $filename) if ! $params->parsed('name') ; $params->setValue('time' => $defaultTime) if ! $params->parsed('time') ; } sub mkHeader { my $self = shift ; my $param = shift ; # short-circuit if a minimal header is requested. return GZIP_MINIMUM_HEADER if $param->getValue('minimal') ; # METHOD my $method = $param->valueOrDefault('method', GZIP_CM_DEFLATED) ; # FLAGS my $flags = GZIP_FLG_DEFAULT ; $flags |= GZIP_FLG_FTEXT if $param->getValue('textflag') ; $flags |= GZIP_FLG_FHCRC if $param->getValue('headercrc') ; $flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ; $flags |= GZIP_FLG_FNAME if $param->wantValue('name') ; $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ; # MTIME my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ; # EXTRA FLAGS my $extra_flags = $param->valueOrDefault('extraflags', GZIP_XFL_DEFAULT); # OS CODE my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ; my $out = pack("C4 V C C", GZIP_ID1, # ID1 GZIP_ID2, # ID2 $method, # Compression Method $flags, # Flags $time, # Modification Time $extra_flags, # Extra Flags $os_code, # Operating System Code ) ; # EXTRA if ($flags & GZIP_FLG_FEXTRA) { my $extra = $param->getValue('extrafield') ; $out .= pack("v", length $extra) . $extra ; } # NAME if ($flags & GZIP_FLG_FNAME) { my $name .= $param->getValue('name') ; $name =~ s/\x00.*$//; $out .= $name ; # Terminate the filename with NULL unless it already is $out .= GZIP_NULL_BYTE if !length $name or substr($name, 1, -1) ne GZIP_NULL_BYTE ; } # COMMENT if ($flags & GZIP_FLG_FCOMMENT) { my $comment .= $param->getValue('comment') ; $comment =~ s/\x00.*$//; $out .= $comment ; # Terminate the comment with NULL unless it already is $out .= GZIP_NULL_BYTE if ! length $comment or substr($comment, 1, -1) ne GZIP_NULL_BYTE; } # HEADER CRC $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->getValue('headercrc') ; noUTF8($out); return $out ; } sub mkFinalTrailer { return ''; } 1; __END__ =head1 NAME IO::Compress::Gzip - Write RFC 1952 files/buffers =head1 SYNOPSIS use IO::Compress::Gzip qw(gzip $GzipError) ; my $status = gzip $input => $output [,OPTS] or die "gzip failed: $GzipError\n"; my $z = new IO::Compress::Gzip $output [,OPTS] or die "gzip failed: $GzipError\n"; $z->print($string); $z->printf($format, $string); $z->write($string); $z->syswrite($string [, $length, $offset]); $z->flush(); $z->tell(); $z->eof(); $z->seek($position, $whence); $z->binmode(); $z->fileno(); $z->opened(); $z->autoflush(); $z->input_line_number(); $z->newStream( [OPTS] ); $z->deflateParams(); $z->close() ; $GzipError ; # IO::File mode print $z $string; printf $z $format, $string; tell $z eof $z seek $z, $position, $whence binmode $z fileno $z close $z ; =head1 DESCRIPTION This module provides a Perl interface that allows writing compressed data to files or buffer as defined in RFC 1952. All the gzip headers defined in RFC 1952 can be created using this module. For reading RFC 1952 files/buffers, see the companion module L. =head1 Functional Interface A top-level function, C, is provided to carry out "one-shot" compression between buffers and/or files. For finer control over the compression process, see the L section. use IO::Compress::Gzip qw(gzip $GzipError) ; gzip $input_filename_or_reference => $output_filename_or_reference [,OPTS] or die "gzip failed: $GzipError\n"; The functional interface needs Perl5.005 or better. =head2 gzip $input_filename_or_reference => $output_filename_or_reference [, OPTS] C expects at least two parameters, C<$input_filename_or_reference> and C<$output_filename_or_reference> and zero or more optional parameters (see L) =head3 The C<$input_filename_or_reference> parameter The parameter, C<$input_filename_or_reference>, is used to define the source of the uncompressed data. It can take one of the following forms: =over 5 =item A filename If the C<$input_filename_or_reference> parameter is a simple scalar, it is assumed to be a filename. This file will be opened for reading and the input data will be read from it. =item A filehandle If the C<$input_filename_or_reference> parameter is a filehandle, the input data will be read from it. The string '-' can be used as an alias for standard input. =item A scalar reference If C<$input_filename_or_reference> is a scalar reference, the input data will be read from C<$$input_filename_or_reference>. =item An array reference If C<$input_filename_or_reference> is an array reference, each element in the array must be a filename. The input data will be read from each file in turn. The complete array will be walked to ensure that it only contains valid filenames before any data is compressed. =item An Input FileGlob string If C<$input_filename_or_reference> is a string that is delimited by the characters "<" and ">" C will assume that it is an I. The input is the list of files that match the fileglob. See L for more details. =back If the C<$input_filename_or_reference> parameter is any other type, C will be returned. In addition, if C<$input_filename_or_reference> is a simple filename, the default values for the C and C