From f2231cfa1b8172e771e372ed04fa2125f7ba54f7 Mon Sep 17 00:00:00 2001 From: gregor herrmann Date: Mon, 4 Nov 2019 17:14:13 +0100 Subject: Fix typos in POD Origin: vendor Last-Update: 2019-11-04 Forwarded: https://github.com/pmqs/IO-Compress/pull/7 Bug: https://github.com/pmqs/IO-Compress/pull/7 Gbp-Pq: Name spelling.patch --- bin/streamzip | 2 +- lib/IO/Compress/Zip.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/streamzip b/bin/streamzip index ba8ab3f..1a34fef 100755 --- a/bin/streamzip +++ b/bin/streamzip @@ -111,7 +111,7 @@ streamzip - create a zip file from stdin =head1 SYNOPSIS - producer | streamzip [opts] | comsumer + producer | streamzip [opts] | consumer producer | streamzip [opts] -zipfile=output.zip =head1 DESCRIPTION diff --git a/lib/IO/Compress/Zip.pm b/lib/IO/Compress/Zip.pm index 97c6f5f..eb57dc0 100644 --- a/lib/IO/Compress/Zip.pm +++ b/lib/IO/Compress/Zip.pm @@ -1356,7 +1356,7 @@ You should only need to use this option if you want the I to be different from the uncompressed filename or when the input is a filehandle or a buffer. The default behaviour for what I is used when the C option -is I speficied depends on the form of the C<$input> parameter: +is I specified depends on the form of the C<$input> parameter: =over 5 -- cgit v1.2.3 From 3ee783f4678b43cb2e913303518333b08cec9524 Mon Sep 17 00:00:00 2001 From: gregor herrmann Date: Sun, 10 Nov 2019 22:51:50 +0100 Subject: set bindir when run under autopkgtest Origin: vendor Forwarded: not-needed Last-Update: 2019-11-10 Gbp-Pq: Name autopkgtest.patch --- t/011-streamzip.t | 1 + 1 file changed, 1 insertion(+) diff --git a/t/011-streamzip.t b/t/011-streamzip.t index df3fbfb..cf7df33 100644 --- a/t/011-streamzip.t +++ b/t/011-streamzip.t @@ -40,6 +40,7 @@ $Perl = "$Perl $Inc -w" ; #$Perl .= " -Mblib " ; my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" : "./bin/"; +$binDir = '/usr/bin/' if $ENV{AUTOPKGTEST_TMP}; my $hello1 = < Date: Sun, 8 Dec 2019 16:34:53 +0100 Subject: Import libio-compress-perl_2.093-1.debian.tar.xz [dgit import tarball libio-compress-perl 2.093-1 libio-compress-perl_2.093-1.debian.tar.xz] --- changelog | 421 ++++++++++++++++++++++++++++++++++ control | 59 +++++ copyright | 44 ++++ libio-compress-perl.examples | 1 + libio-compress-perl.lintian-overrides | 3 + patches/autopkgtest.patch | 16 ++ patches/series | 1 + postrm | 25 ++ preinst | 25 ++ rules | 15 ++ source/format | 1 + source/lintian-overrides | 4 + tests/pkg-perl/smoke-env | 1 + tests/pkg-perl/smoke-files | 2 + tests/pkg-perl/use-name | 1 + upstream/metadata | 5 + watch | 2 + 17 files changed, 626 insertions(+) create mode 100644 changelog create mode 100644 control create mode 100644 copyright create mode 100644 libio-compress-perl.examples create mode 100644 libio-compress-perl.lintian-overrides create mode 100644 patches/autopkgtest.patch create mode 100644 patches/series create mode 100644 postrm create mode 100644 preinst create mode 100755 rules create mode 100644 source/format create mode 100644 source/lintian-overrides create mode 100644 tests/pkg-perl/smoke-env create mode 100644 tests/pkg-perl/smoke-files create mode 100644 tests/pkg-perl/use-name create mode 100644 upstream/metadata create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..1600178 --- /dev/null +++ b/changelog @@ -0,0 +1,421 @@ +libio-compress-perl (2.093-1) unstable; urgency=medium + + * Team upload + + * New upstream version 2.093 + * d/control: + - Refresh build dependencies + - Add Rules-Requires-Root field + * d/copyright: + - Sort header stanza + * d/u/metadata: + - Add Bug-Submit field + + -- Nick Morrott Sun, 08 Dec 2019 15:34:53 +0000 + +libio-compress-perl (2.090-1) unstable; urgency=medium + + * Import upstream version 2.090. + * Drop spelling.patch, merged upstream. + * Bump version of build dependencies. + * Add patch to make new test work under autopkgtest. + + -- gregor herrmann Sun, 10 Nov 2019 22:51:50 +0100 + +libio-compress-perl (2.089-1) unstable; urgency=medium + + * Import upstream version 2.089. + * Update versioned build dependencies. + * Declare compliance with Debian Policy 4.4.1. + * Remove obsolete fields Name, Contact from debian/upstream/metadata. + * Update lintian overrides. + * Add diversions for the new scipt streamzip and its manpage to the + preinst and postinst scripts proactively, under the assumption that it + will appear in perl core when IO::Compress is updated there. + * Add spelling.patch. + + -- gregor herrmann Mon, 04 Nov 2019 17:14:13 +0100 + +libio-compress-perl (2.087-1) unstable; urgency=medium + + * Import upstream version 2.087. + * Annotate test-only build dependencies with . + * debian/watch: use uscan version 4. + * Bump versioned build dependencies. + + -- gregor herrmann Sun, 11 Aug 2019 14:43:32 +0200 + +libio-compress-perl (2.086-1) unstable; urgency=medium + + * Team upload + + [ Utkarsh Gupta ] + * New upstream version 2.086 + * Update dependency on libcompress-raw-* + * Bump compat to 12, Standards-Version to 4.4.0 + + [ gregor herrmann ] + * Update debian/upstream/metadata. + + -- Utkarsh Gupta Tue, 16 Jul 2019 21:17:39 +0530 + +libio-compress-perl (2.084-1) unstable; urgency=medium + + * Import upstream version 2.084. + * Update years of upstream and packaging copyright. + * Bump versioned build dependencies. + + -- gregor herrmann Sat, 12 Jan 2019 18:04:27 +0100 + +libio-compress-perl (2.083-1) unstable; urgency=medium + + * Email change: Xavier Guimard -> yadd@debian.org + * Import upstream version 2.083 + * Bump debhelper compatibility level to 11 + * Declare compliance with policy 4.3.0 + * Update dependencies versions (libcompress-raw-bzip2-perl and + libcompress-raw-zlib-perl) + + -- Xavier Guimard Wed, 02 Jan 2019 23:32:14 +0100 + +libio-compress-perl (2.081-1) unstable; urgency=medium + + [ Alex Muntada ] + * Remove inactive pkg-perl members from Uploaders. + + [ Salvatore Bonaccorso ] + * Update Vcs-* headers for switch to salsa.debian.org + + [ Xavier Guimard ] + * Import upstream version 2.081 + * Declare compliance with Debian Policy 4.1.4 + * Update Compress::Zlib and Compress::Bzip2 version dependencies + * Update copyright years + + -- Xavier Guimard Sun, 15 Apr 2018 08:35:27 +0200 + +libio-compress-perl (2.074-1) unstable; urgency=medium + + [ gregor herrmann ] + * Rename autopkgtest configuration file. + + [ Salvatore Bonaccorso ] + * debian/control: Use HTTPS transport protocol for Vcs-Git URI + + [ gregor herrmann ] + * debian/copyright: change Copyright-Format 1.0 URL to HTTPS. + * Remove Jonathan Yu from Uploaders. Thanks for your work! + * Remove Ryan Niebur from Uploaders. Thanks for your work! + + [ Nick Morrott ] + * New upstream version 2.070 (Closes: #839208) + * debian/copyright: update copyright years + * debian/control: declare compliance with Debian Policy 3.9.8 + * debian/control: refresh build-dependencies + * debian/upstream/metadata: add Bug-* fields + * Add debian/libio-compress-perl.lintian-overrides + + [ gregor herrmann ] + * Import upstream version 2.074 + * Set TEST_SKIP_VERSION_CHECK=1 for autopkgtest as well. + * Update years of upstream and packaging copyright. + * debian/control: bump versioned build dependencies. + * Drop Breaks/Replaces against ancient packages which are not even in + oldoldstable anymore. Also drop the Provides for them; there are still + consumers but the same virtual packages are provided by src:perl. + * Add debian/tests/pkg-perl/use-name to activate autopkgtest's use.t. + + -- gregor herrmann Sun, 18 Jun 2017 16:34:22 +0200 + +libio-compress-perl (2.069-1) unstable; urgency=medium + + * Import upstream version 2.069 + * Update years of upstream copyright. + * Bump versioned (build) dependencies. + * Bump debhelper compatibility level to 9. + + -- gregor herrmann Mon, 05 Oct 2015 18:11:26 +0200 + +libio-compress-perl (2.068-2) unstable; urgency=medium + + * Divert away /usr/bin/zipdetails from perl core and its manpage. + (Closes: #790666) + + -- gregor herrmann Wed, 01 Jul 2015 19:17:42 +0200 + +libio-compress-perl (2.068-1) unstable; urgency=medium + + * Add debian/upstream/metadata + * Import upstream version 2.068 + * Update years of packaging copyright. + * Bump versioned (build) dependencies. + + -- gregor herrmann Wed, 06 May 2015 21:57:40 +0200 + +libio-compress-perl (2.066-1) unstable; urgency=medium + + [ gregor herrmann ] + * debian/control: remove Nicholas Bamber from Uploaders on request of + the MIA team. + * Strip trailing slash from metacpan URLs. + + [ Salvatore Bonaccorso ] + * Update Vcs-Browser URL to cgit web frontend + + [ gregor herrmann ] + * New upstream release. + Fixes "IO::Uncompress::Gunzip: Can no longer gunzip to in-memory file + handle" (Closes: #762486) + * Bump versioned (build) dependencies. + * Declare compliance with Debian Policy 3.9.6. + * Mark package as autopkgtest-able. + + -- gregor herrmann Tue, 23 Sep 2014 17:24:52 +0200 + +libio-compress-perl (2.064-1) unstable; urgency=medium + + * New upstream release. + * Update years of copyright. + * Bump versioned build dependencies. + + -- gregor herrmann Wed, 12 Feb 2014 19:16:31 +0100 + +libio-compress-perl (2.063-1) unstable; urgency=low + + * New upstream release. + * Bump versioned (build) dependencies. + * Declare compliance with Debian Policy 3.9.5. + + -- gregor herrmann Mon, 04 Nov 2013 18:29:48 +0100 + +libio-compress-perl (2.062-1) unstable; urgency=low + + * New upstream release. + * Update years of packaging copyright. + * Bump versioned build dependencies. + + -- gregor herrmann Sat, 05 Oct 2013 20:25:47 +0200 + +libio-compress-perl (2.061-1) unstable; urgency=low + + * Imported Upstream version 2.061 + * Update dependencies versions + + -- Xavier Guimard Sat, 01 Jun 2013 08:20:42 +0200 + +libio-compress-perl (2.060-1) unstable; urgency=low + + [ Salvatore Bonaccorso ] + * Change Vcs-Git to canonical URI (git://anonscm.debian.org) + + [ gregor herrmann ] + * Recommend libio-compress-lzma-perl. Thanks to Vincent Lefevre for the + bug report. (Closes: #698790) + * Improve long description. Thanks to Vincent Lefevre for the hints. + + [ Salvatore Bonaccorso ] + * Change search.cpan.org based URIs to metacpan.org based URIs + + [ Xavier Guimard ] + * Imported Upstream version 2.060 + * Bump Standards-Version to 3.9.4 + * Update debian/copyright years + + -- gregor herrmann Sat, 04 May 2013 20:21:02 +0200 + +libio-compress-perl (2.055-1) unstable; urgency=low + + * New upstream release + * Add myself to Uploaders + * Bump build deps versions + + -- Alessandro Ghedini Sat, 11 Aug 2012 14:00:32 +0200 + +libio-compress-perl (2.052-1) unstable; urgency=low + + [ Alessandro Ghedini ] + * New upstream release 2.049 + * Use ${source:Upstream-Version} instead of manually setting the required + version for libcompress-raw-{bzip2,zlib}-perl + + [ Scott Kitterman ] + * Remove myself from uploaders + + [ gregor herrmann ] + * New upstream release 2.052. + * Bump build dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.052. + * debian/rules: remove unneeded override_dh_auto_configure. + * debian/copyright: update to Copyright-Format 1.0. + * Bump Standards-Version to 3.9.3 (no changes). + + -- gregor herrmann Fri, 04 May 2012 14:53:56 +0200 + +libio-compress-perl (2.048-1) unstable; urgency=low + + * New upstream release. + * Update years of upstream and packaging copyright. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.048. + + -- gregor herrmann Mon, 30 Jan 2012 22:51:04 +0100 + +libio-compress-perl (2.046-1) unstable; urgency=low + + * New upstream release. + + -- gregor herrmann Mon, 19 Dec 2011 23:11:06 +0100 + +libio-compress-perl (2.045-1) unstable; urgency=low + + * New upstream release. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.045. + * The FAQ now gets manified and installed by the upstream build system, + remove manual pod2man invocation from debian/rules. + + -- gregor herrmann Wed, 07 Dec 2011 18:01:46 +0100 + +libio-compress-perl (2.043-1) unstable; urgency=low + + * New upstream release. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.043. + + -- gregor herrmann Fri, 25 Nov 2011 15:07:51 +0100 + +libio-compress-perl (2.040-1) unstable; urgency=low + + * New upstream release. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.040. + + -- gregor herrmann Wed, 02 Nov 2011 20:50:39 +0100 + +libio-compress-perl (2.037-2) unstable; urgency=low + + * Team upload. + + [ gregor herrmann ] + * Remove transitional dummy packages + (closes: #542686, #542691, #542694, #542696). + + [ Ansgar Burchardt ] + * debian/control: Convert Vcs-* fields to Git. + + [ Salvatore Bonaccorso ] + * debian/copyright: Replace DEP5 Format-Specification URL from + svn.debian.org to anonscm.debian.org URL. + + -- Ansgar Burchardt Sat, 17 Sep 2011 12:14:05 +0200 + +libio-compress-perl (2.037-1) unstable; urgency=low + + * New upstream release. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.037. + + -- gregor herrmann Sun, 03 Jul 2011 16:36:18 +0200 + +libio-compress-perl (2.036-1) unstable; urgency=low + + * New upstream release. + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.036. + + -- gregor herrmann Sun, 19 Jun 2011 18:02:32 +0200 + +libio-compress-perl (2.035-1) unstable; urgency=low + + [ Nicholas Bamber ] + * New upstream release + * Raised standards version to 3.9.2 + + [ gregor herrmann ] + * Bump build and runtime dependencies on libcompress-raw-zlib-perl and + libcompress-raw-bzip2-perl to >= 2.035. + * Bump debhelper compatibility level to 8. + + -- gregor herrmann Sat, 14 May 2011 15:28:58 +0200 + +libio-compress-perl (2.033-1) unstable; urgency=low + + [ gregor herrmann ] + * New upstream release 2.025 + * Remove patch disable-zlib-version-test, applied upstream. Remove quilt + framework. + * Convert to source format 3.0 (quilt). + * Bump versioned (build) dependency on libcompress-raw-bzip2-perl and + libcompress-raw-zlib-perl. + * Set Standards-Version to 3.9.1; replace Conflicts with Breaks. + + [ Chris Butler ] + * New upstream release 2.026 + + [ Jonathan Yu ] + * New upstream release 2.030, 2.033 + * Refresh copyright information + + [ Nicholas Bamber ] + * Adding myself to Uploaders + + -- gregor herrmann Fri, 18 Mar 2011 22:02:36 +0100 + +libio-compress-perl (2.024-1) unstable; urgency=low + + [ Jonathan Yu ] + * New upstream release 2.023 + * Drop perl version dependency + * Update rules to use commonly accepted pkg-perl styles + + [ gregor herrmann ] + * Fix Homepage field in debian/control. + + [ Maximilian Gass ] + * Add patch to disable zlib version tests (Closes: #564352) + * debian/rules: switch to find for fixing examples (multiple directories) + + [ gregor herrmann ] + * New upstream release 2.024. + * debian/copyright: update years of copyright and formatting. + * Set Standards-Version to 3.8.4 (no changes). + * Bump versioned build and runtime dependencies on + libcompress-raw-bzip2-perl and libcompress-raw-zlib-perl. + * debian/rules: set DESTDIR instead of using a separate .install file; use + variables for several overrides. + + -- gregor herrmann Thu, 11 Feb 2010 16:32:49 +0100 + +libio-compress-perl (2.022-1) unstable; urgency=low + + [ Ryan Niebur ] + * Update ryan52's email address + + [ Damyan Ivanov ] + * New upstream release + + -- Damyan Ivanov Sun, 01 Nov 2009 19:35:42 +0200 + +libio-compress-perl (2.021-1) unstable; urgency=low + + * New upstream release + - update deps + * Add myself to Uploaders + + -- Ryan Niebur Tue, 01 Sep 2009 13:18:17 -0700 + +libio-compress-perl (2.020-2) unstable; urgency=low + + * fix interpreter path of examples (Closes: #543611) + * add myself to Uploaders + + -- Damyan Ivanov Wed, 26 Aug 2009 11:36:26 +0300 + +libio-compress-perl (2.020-1) unstable; urgency=low + + [ Scott Kitterman ] + * Initial release that combines Compress-Zlib, IO-Compress-Zlib, + IO-Compress-Bzip2, and IO-Compress-Base into a single package + (Closes: #538214) + + -- gregor herrmann Fri, 21 Aug 2009 14:58:23 +0200 diff --git a/control b/control new file mode 100644 index 0000000..4a04c50 --- /dev/null +++ b/control @@ -0,0 +1,59 @@ +Source: libio-compress-perl +Maintainer: Debian Perl Group +Uploaders: gregor herrmann , + Damyan Ivanov , + Xavier Guimard +Section: perl +Testsuite: autopkgtest-pkg-perl +Priority: optional +Build-Depends: debhelper-compat (= 12) +Build-Depends-Indep: libcompress-raw-bzip2-perl (>= 2.093) , + libcompress-raw-zlib-perl (>= 2.093) , + libtest-pod-perl , + perl +Standards-Version: 4.4.1 +Vcs-Browser: https://salsa.debian.org/perl-team/modules/packages/libio-compress-perl +Vcs-Git: https://salsa.debian.org/perl-team/modules/packages/libio-compress-perl.git +Homepage: https://metacpan.org/release/IO-Compress +Rules-Requires-Root: no + +Package: libio-compress-perl +Architecture: all +Depends: ${misc:Depends}, + ${perl:Depends}, + libcompress-raw-bzip2-perl (>= ${source:Upstream-Version}), + libcompress-raw-zlib-perl (>= ${source:Upstream-Version}) +Recommends: libio-compress-lzma-perl (>= ${source:Upstream-Version}) +Description: bundle of IO::Compress modules + This package contains the following IO::Compress and IO::Uncompress modules: + . + - Compress::Zlib + - IO::Compress::Base + - IO::Compress::Bzip2 + - IO::Compress::Deflate + - IO::Compress::Gzip + - IO::Compress::RawDeflate + - IO::Compress::Zip + - IO::Uncompress::Base + - IO::Uncompress::Bunzip2 + - IO::Uncompress::Gunzip + - IO::Uncompress::Inflate + - IO::Uncompress::RawInflate + - IO::Uncompress::Unzip + . + Compress::Zlib is a Perl external module which provides an interface to + the info-zip zlib compression library. zlib is a general purpose + compression library. + . + Some of the features provided by Compress::Zlib include: + . + * in-memory compression and decompression + * read and write gzip (.gz) files directly. + . + IO::Compress::Bunzip2 and IO::Uncompress::Bunzip2 provide a Perl interface + that allows transparent reading and writing bzip2 compressed data to files or + buffers. + . + IO::Compress::Base is the base class for all IO::Compress and IO::Uncompress + modules. It is not intended for direct use in application code. Its sole + purpose is to be sub-classed by IO::Compress modules. diff --git a/copyright b/copyright new file mode 100644 index 0000000..2eb47aa --- /dev/null +++ b/copyright @@ -0,0 +1,44 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Source: https://metacpan.org/release/IO-Compress +Upstream-Contact: Paul Marquess +Upstream-Name: IO-Compress + +Files: * +Copyright: 1995-2019, Paul Marquess +License: Artistic or GPL-1+ + +Files: t/Test/More.pm t/Test/Simple.pm +Copyright: 2001, 2002, 2004, Michael G Schwern +License: Artistic or GPL-1+ + +Files: t/Test/Builder.pm +Copyright: 2002, 2004, chromatic + 2002, 2004, Michael G Schwern +License: Artistic or GPL-1+ + +Files: debian/* +Copyright: 2009, Scott Kitterman + 2009, Damyan Ivanov + 2009, Ryan Niebur + 2009-2019, gregor herrmann + 2010, Jonathan Yu + 2011, Ansgar Burchardt + 2012, Alessandro Ghedini + 2012-2018, Xavier Guimard +License: Artistic or GPL-1+ + +License: Artistic + This program is free software; you can redistribute it and/or modify + it under the terms of the Artistic License, which comes with Perl. + . + On Debian systems, the complete text of the Artistic License can be + found in `/usr/share/common-licenses/Artistic'. + +License: GPL-1+ + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + . + On Debian systems, the complete text of version 1 of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL-1'. diff --git a/libio-compress-perl.examples b/libio-compress-perl.examples new file mode 100644 index 0000000..e39721e --- /dev/null +++ b/libio-compress-perl.examples @@ -0,0 +1 @@ +examples/* diff --git a/libio-compress-perl.lintian-overrides b/libio-compress-perl.lintian-overrides new file mode 100644 index 0000000..8f1c46e --- /dev/null +++ b/libio-compress-perl.lintian-overrides @@ -0,0 +1,3 @@ +# Useful tools provided with library +libio-compress-perl: library-package-name-for-application usr/bin/streamzip usr/bin/zipdetails +libio-compress-perl: application-in-library-section perl usr/bin/streamzip usr/bin/zipdetails diff --git a/patches/autopkgtest.patch b/patches/autopkgtest.patch new file mode 100644 index 0000000..9554543 --- /dev/null +++ b/patches/autopkgtest.patch @@ -0,0 +1,16 @@ +Description: set bindir when run under autopkgtest +Origin: vendor +Forwarded: not-needed +Author: gregor herrmann +Last-Update: 2019-11-10 + +--- a/t/011-streamzip.t ++++ b/t/011-streamzip.t +@@ -40,6 +40,7 @@ + #$Perl .= " -Mblib " ; + my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" + : "./bin/"; ++$binDir = '/usr/bin/' if $ENV{AUTOPKGTEST_TMP}; + + my $hello1 = < libcompress-raw-bzip2-perl +libio-compress-perl source: version-substvar-for-external-package libio-compress-perl -> libcompress-raw-zlib-perl +libio-compress-perl source: version-substvar-for-external-package libio-compress-perl -> libio-compress-lzma-perl diff --git a/tests/pkg-perl/smoke-env b/tests/pkg-perl/smoke-env new file mode 100644 index 0000000..1d2fa7f --- /dev/null +++ b/tests/pkg-perl/smoke-env @@ -0,0 +1 @@ +TEST_SKIP_VERSION_CHECK=1 diff --git a/tests/pkg-perl/smoke-files b/tests/pkg-perl/smoke-files new file mode 100644 index 0000000..d5ac44b --- /dev/null +++ b/tests/pkg-perl/smoke-files @@ -0,0 +1,2 @@ +t +examples diff --git a/tests/pkg-perl/use-name b/tests/pkg-perl/use-name new file mode 100644 index 0000000..afc7905 --- /dev/null +++ b/tests/pkg-perl/use-name @@ -0,0 +1 @@ +IO::Compress::Gzip diff --git a/upstream/metadata b/upstream/metadata new file mode 100644 index 0000000..1ea7096 --- /dev/null +++ b/upstream/metadata @@ -0,0 +1,5 @@ +Archive: CPAN +Bug-Database: https://github.com/pmqs/IO-Compress/issues +Bug-Submit: https://github.com/pmqs/IO-Compress/issues/new +Repository: https://github.com/pmqs/IO-Compress.git +Repository-Browse: https://github.com/pmqs/IO-Compress diff --git a/watch b/watch new file mode 100644 index 0000000..4e0df77 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=4 +https://metacpan.org/release/IO-Compress .*/IO-Compress-v?@ANY_VERSION@@ARCHIVE_EXT@$ -- cgit v1.2.3 From 473e0cd0a0f299d679f483163171a9497356a3d0 Mon Sep 17 00:00:00 2001 From: Nick Morrott Date: Sun, 8 Dec 2019 16:34:53 +0100 Subject: Import libio-compress-perl_2.093.orig.tar.gz [dgit import orig libio-compress-perl_2.093.orig.tar.gz] --- Changes | 1402 +++++++++++++++++++++ MANIFEST | 165 +++ META.json | 57 + META.yml | 31 + Makefile.PL | 87 ++ README | 124 ++ bin/streamzip | 212 ++++ bin/zipdetails | 2212 +++++++++++++++++++++++++++++++++ examples/compress-zlib/filtdef | 29 + examples/compress-zlib/filtinf | 28 + examples/compress-zlib/gzcat | 27 + examples/compress-zlib/gzgrep | 27 + examples/compress-zlib/gzstream | 19 + examples/io/anycat | 17 + examples/io/bzip2/bzcat | 29 + examples/io/bzip2/bzgrep | 25 + examples/io/bzip2/bzstream | 9 + examples/io/gzip/gzappend | 24 + examples/io/gzip/gzcat | 29 + examples/io/gzip/gzgrep | 40 + examples/io/gzip/gzstream | 24 + lib/Compress/Zlib.pm | 1513 ++++++++++++++++++++++ lib/File/GlobMapper.pm | 679 ++++++++++ lib/IO/Compress/Adapter/Bzip2.pm | 154 +++ lib/IO/Compress/Adapter/Deflate.pm | 170 +++ lib/IO/Compress/Adapter/Identity.pm | 101 ++ lib/IO/Compress/Base.pm | 1054 ++++++++++++++++ lib/IO/Compress/Base/Common.pm | 1053 ++++++++++++++++ lib/IO/Compress/Bzip2.pm | 825 ++++++++++++ lib/IO/Compress/Deflate.pm | 958 ++++++++++++++ lib/IO/Compress/FAQ.pod | 689 ++++++++++ lib/IO/Compress/Gzip.pm | 1270 +++++++++++++++++++ lib/IO/Compress/Gzip/Constants.pm | 148 +++ lib/IO/Compress/RawDeflate.pm | 1014 +++++++++++++++ lib/IO/Compress/Zip.pm | 2094 +++++++++++++++++++++++++++++++ lib/IO/Compress/Zip/Constants.pm | 125 ++ lib/IO/Compress/Zlib/Constants.pm | 77 ++ lib/IO/Compress/Zlib/Extra.pm | 229 ++++ lib/IO/Uncompress/Adapter/Bunzip2.pm | 112 ++ lib/IO/Uncompress/Adapter/Identity.pm | 188 +++ lib/IO/Uncompress/Adapter/Inflate.pm | 157 +++ lib/IO/Uncompress/AnyInflate.pm | 1006 +++++++++++++++ lib/IO/Uncompress/AnyUncompress.pm | 1082 ++++++++++++++++ lib/IO/Uncompress/Base.pm | 1567 +++++++++++++++++++++++ lib/IO/Uncompress/Bunzip2.pm | 914 ++++++++++++++ lib/IO/Uncompress/Gunzip.pm | 1129 +++++++++++++++++ lib/IO/Uncompress/Inflate.pm | 1001 +++++++++++++++ lib/IO/Uncompress/RawInflate.pm | 1129 +++++++++++++++++ lib/IO/Uncompress/Unzip.pm | 1906 ++++++++++++++++++++++++++++ private/MakeUtil.pm | 383 ++++++ t/000prereq.t | 102 ++ t/001bzip2.t | 206 +++ t/001zlib-generic-deflate.t | 20 + t/001zlib-generic-gzip.t | 20 + t/001zlib-generic-rawdeflate.t | 20 + t/001zlib-generic-zip.t | 20 + t/002any-deflate.t | 29 + t/002any-gzip.t | 29 + t/002any-rawdeflate.t | 28 + t/002any-transparent.t | 72 ++ t/002any-zip.t | 29 + t/004gziphdr.t | 993 +++++++++++++++ t/005defhdr.t | 360 ++++++ t/006zip.t | 404 ++++++ t/010examples-bzip2.t | 134 ++ t/010examples-zlib.t | 135 ++ t/011-streamzip.t | 118 ++ t/01misc.t | 406 ++++++ t/020isize.t | 158 +++ t/050interop-gzip.t | 147 +++ t/100generic-bzip2.t | 21 + t/100generic-deflate.t | 22 + t/100generic-gzip.t | 21 + t/100generic-rawdeflate.t | 21 + t/100generic-zip.t | 21 + t/101truncate-bzip2.t | 41 + t/101truncate-deflate.t | 41 + t/101truncate-gzip.t | 40 + t/101truncate-rawdeflate.t | 134 ++ t/101truncate-zip.t | 42 + t/102tied-bzip2.t | 21 + t/102tied-deflate.t | 21 + t/102tied-gzip.t | 21 + t/102tied-rawdeflate.t | 21 + t/102tied-zip.t | 21 + t/103newtied-bzip2.t | 21 + t/103newtied-deflate.t | 21 + t/103newtied-gzip.t | 21 + t/103newtied-rawdeflate.t | 21 + t/103newtied-zip.t | 21 + t/104destroy-bzip2.t | 21 + t/104destroy-deflate.t | 21 + t/104destroy-gzip.t | 21 + t/104destroy-rawdeflate.t | 21 + t/104destroy-zip.t | 21 + t/105oneshot-bzip2.t | 22 + t/105oneshot-deflate.t | 21 + t/105oneshot-gzip-only.t | 134 ++ t/105oneshot-gzip.t | 22 + t/105oneshot-rawdeflate.t | 21 + t/105oneshot-zip-bzip2-only.t | 166 +++ t/105oneshot-zip-only.t | 324 +++++ t/105oneshot-zip-store-only.t | 102 ++ t/105oneshot-zip.t | 21 + t/106prime-bzip2.t | 21 + t/106prime-deflate.t | 21 + t/106prime-gzip.t | 21 + t/106prime-rawdeflate.t | 21 + t/106prime-zip.t | 21 + t/107multi-bzip2.t | 21 + t/107multi-deflate.t | 21 + t/107multi-gzip.t | 21 + t/107multi-rawdeflate.t | 21 + t/107multi-zip-only.t | 102 ++ t/107multi-zip.t | 21 + t/108anyunc-bzip2.t | 29 + t/108anyunc-deflate.t | 29 + t/108anyunc-gzip.t | 29 + t/108anyunc-rawdeflate.t | 29 + t/108anyunc-transparent.t | 72 ++ t/108anyunc-zip.t | 29 + t/109merge-deflate.t | 21 + t/109merge-gzip.t | 21 + t/109merge-rawdeflate.t | 21 + t/109merge-zip.t | 24 + t/110encode-bzip2.t | 21 + t/110encode-deflate.t | 21 + t/110encode-gzip.t | 21 + t/110encode-rawdeflate.t | 21 + t/110encode-zip.t | 21 + t/111const-deflate.t | 100 ++ t/112utf8-zip.t | 220 ++++ t/999meta-json.t | 12 + t/999meta-yml.t | 12 + t/999pod.t | 16 + t/Test/Builder.pm | 1625 ++++++++++++++++++++++++ t/Test/More.pm | 1493 ++++++++++++++++++++++ t/Test/Simple.pm | 236 ++++ t/compress/CompTestUtils.pm | 775 ++++++++++++ t/compress/any.pl | 103 ++ t/compress/anyunc.pl | 93 ++ t/compress/destroy.pl | 115 ++ t/compress/encode.pl | 198 +++ t/compress/generic.pl | 1747 ++++++++++++++++++++++++++ t/compress/merge.pl | 322 +++++ t/compress/multi.pl | 263 ++++ t/compress/newtied.pl | 374 ++++++ t/compress/oneshot.pl | 1672 +++++++++++++++++++++++++ t/compress/prime.pl | 94 ++ t/compress/tied.pl | 492 ++++++++ t/compress/truncate.pl | 295 +++++ t/compress/zlib-generic.pl | 233 ++++ t/cz-01version.t | 45 + t/cz-03zlib-v1.t | 1268 +++++++++++++++++++ t/cz-05examples.t | 163 +++ t/cz-06gzsetp.t | 146 +++ t/cz-08encoding.t | 142 +++ t/cz-14gzopen.t | 681 ++++++++++ t/files/bad-efs.zip | Bin 0 -> 126 bytes t/files/encrypt-aes.zip | Bin 0 -> 9007 bytes t/files/encrypt-standard.zip | Bin 0 -> 207 bytes t/files/jar.zip | Bin 0 -> 434 bytes t/files/meta.xml | 2 + t/files/test.ods | Bin 0 -> 7403 bytes t/globmapper.t | 308 +++++ 165 files changed, 46292 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100755 bin/streamzip create mode 100755 bin/zipdetails create mode 100755 examples/compress-zlib/filtdef create mode 100755 examples/compress-zlib/filtinf create mode 100755 examples/compress-zlib/gzcat create mode 100755 examples/compress-zlib/gzgrep create mode 100755 examples/compress-zlib/gzstream create mode 100755 examples/io/anycat create mode 100755 examples/io/bzip2/bzcat create mode 100755 examples/io/bzip2/bzgrep create mode 100755 examples/io/bzip2/bzstream create mode 100644 examples/io/gzip/gzappend create mode 100755 examples/io/gzip/gzcat create mode 100755 examples/io/gzip/gzgrep create mode 100755 examples/io/gzip/gzstream create mode 100644 lib/Compress/Zlib.pm create mode 100644 lib/File/GlobMapper.pm create mode 100644 lib/IO/Compress/Adapter/Bzip2.pm create mode 100644 lib/IO/Compress/Adapter/Deflate.pm create mode 100644 lib/IO/Compress/Adapter/Identity.pm create mode 100644 lib/IO/Compress/Base.pm create mode 100644 lib/IO/Compress/Base/Common.pm create mode 100644 lib/IO/Compress/Bzip2.pm create mode 100644 lib/IO/Compress/Deflate.pm create mode 100644 lib/IO/Compress/FAQ.pod create mode 100644 lib/IO/Compress/Gzip.pm create mode 100644 lib/IO/Compress/Gzip/Constants.pm create mode 100644 lib/IO/Compress/RawDeflate.pm create mode 100644 lib/IO/Compress/Zip.pm create mode 100644 lib/IO/Compress/Zip/Constants.pm create mode 100644 lib/IO/Compress/Zlib/Constants.pm create mode 100644 lib/IO/Compress/Zlib/Extra.pm create mode 100644 lib/IO/Uncompress/Adapter/Bunzip2.pm create mode 100755 lib/IO/Uncompress/Adapter/Identity.pm create mode 100644 lib/IO/Uncompress/Adapter/Inflate.pm create mode 100644 lib/IO/Uncompress/AnyInflate.pm create mode 100644 lib/IO/Uncompress/AnyUncompress.pm create mode 100644 lib/IO/Uncompress/Base.pm create mode 100644 lib/IO/Uncompress/Bunzip2.pm create mode 100644 lib/IO/Uncompress/Gunzip.pm create mode 100644 lib/IO/Uncompress/Inflate.pm create mode 100755 lib/IO/Uncompress/RawInflate.pm create mode 100644 lib/IO/Uncompress/Unzip.pm create mode 100644 private/MakeUtil.pm create mode 100644 t/000prereq.t create mode 100644 t/001bzip2.t create mode 100644 t/001zlib-generic-deflate.t create mode 100644 t/001zlib-generic-gzip.t create mode 100644 t/001zlib-generic-rawdeflate.t create mode 100644 t/001zlib-generic-zip.t create mode 100644 t/002any-deflate.t create mode 100644 t/002any-gzip.t create mode 100644 t/002any-rawdeflate.t create mode 100644 t/002any-transparent.t create mode 100644 t/002any-zip.t create mode 100644 t/004gziphdr.t create mode 100644 t/005defhdr.t create mode 100644 t/006zip.t create mode 100644 t/010examples-bzip2.t create mode 100644 t/010examples-zlib.t create mode 100644 t/011-streamzip.t create mode 100644 t/01misc.t create mode 100644 t/020isize.t create mode 100644 t/050interop-gzip.t create mode 100644 t/100generic-bzip2.t create mode 100644 t/100generic-deflate.t create mode 100644 t/100generic-gzip.t create mode 100644 t/100generic-rawdeflate.t create mode 100644 t/100generic-zip.t create mode 100644 t/101truncate-bzip2.t create mode 100644 t/101truncate-deflate.t create mode 100644 t/101truncate-gzip.t create mode 100644 t/101truncate-rawdeflate.t create mode 100644 t/101truncate-zip.t create mode 100644 t/102tied-bzip2.t create mode 100644 t/102tied-deflate.t create mode 100644 t/102tied-gzip.t create mode 100644 t/102tied-rawdeflate.t create mode 100644 t/102tied-zip.t create mode 100644 t/103newtied-bzip2.t create mode 100644 t/103newtied-deflate.t create mode 100644 t/103newtied-gzip.t create mode 100644 t/103newtied-rawdeflate.t create mode 100644 t/103newtied-zip.t create mode 100644 t/104destroy-bzip2.t create mode 100644 t/104destroy-deflate.t create mode 100644 t/104destroy-gzip.t create mode 100644 t/104destroy-rawdeflate.t create mode 100644 t/104destroy-zip.t create mode 100644 t/105oneshot-bzip2.t create mode 100644 t/105oneshot-deflate.t create mode 100644 t/105oneshot-gzip-only.t create mode 100644 t/105oneshot-gzip.t create mode 100644 t/105oneshot-rawdeflate.t create mode 100644 t/105oneshot-zip-bzip2-only.t create mode 100644 t/105oneshot-zip-only.t create mode 100644 t/105oneshot-zip-store-only.t create mode 100644 t/105oneshot-zip.t create mode 100644 t/106prime-bzip2.t create mode 100644 t/106prime-deflate.t create mode 100644 t/106prime-gzip.t create mode 100644 t/106prime-rawdeflate.t create mode 100644 t/106prime-zip.t create mode 100644 t/107multi-bzip2.t create mode 100644 t/107multi-deflate.t create mode 100644 t/107multi-gzip.t create mode 100644 t/107multi-rawdeflate.t create mode 100644 t/107multi-zip-only.t create mode 100644 t/107multi-zip.t create mode 100644 t/108anyunc-bzip2.t create mode 100644 t/108anyunc-deflate.t create mode 100644 t/108anyunc-gzip.t create mode 100644 t/108anyunc-rawdeflate.t create mode 100644 t/108anyunc-transparent.t create mode 100644 t/108anyunc-zip.t create mode 100644 t/109merge-deflate.t create mode 100644 t/109merge-gzip.t create mode 100644 t/109merge-rawdeflate.t create mode 100644 t/109merge-zip.t create mode 100644 t/110encode-bzip2.t create mode 100644 t/110encode-deflate.t create mode 100644 t/110encode-gzip.t create mode 100644 t/110encode-rawdeflate.t create mode 100644 t/110encode-zip.t create mode 100644 t/111const-deflate.t create mode 100644 t/112utf8-zip.t create mode 100644 t/999meta-json.t create mode 100644 t/999meta-yml.t create mode 100644 t/999pod.t create mode 100644 t/Test/Builder.pm create mode 100644 t/Test/More.pm create mode 100644 t/Test/Simple.pm create mode 100644 t/compress/CompTestUtils.pm create mode 100644 t/compress/any.pl create mode 100644 t/compress/anyunc.pl create mode 100644 t/compress/destroy.pl create mode 100644 t/compress/encode.pl create mode 100644 t/compress/generic.pl create mode 100644 t/compress/merge.pl create mode 100644 t/compress/multi.pl create mode 100644 t/compress/newtied.pl create mode 100755 t/compress/oneshot.pl create mode 100644 t/compress/prime.pl create mode 100644 t/compress/tied.pl create mode 100644 t/compress/truncate.pl create mode 100644 t/compress/zlib-generic.pl create mode 100644 t/cz-01version.t create mode 100755 t/cz-03zlib-v1.t create mode 100644 t/cz-05examples.t create mode 100644 t/cz-06gzsetp.t create mode 100644 t/cz-08encoding.t create mode 100644 t/cz-14gzopen.t create mode 100644 t/files/bad-efs.zip create mode 100644 t/files/encrypt-aes.zip create mode 100644 t/files/encrypt-standard.zip create mode 100644 t/files/jar.zip create mode 100644 t/files/meta.xml create mode 100644 t/files/test.ods create mode 100644 t/globmapper.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..ba15691 --- /dev/null +++ b/Changes @@ -0,0 +1,1402 @@ +CHANGES +------- + + 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 diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..e397a2a --- /dev/null +++ b/MANIFEST @@ -0,0 +1,165 @@ +Changes +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) diff --git a/META.json b/META.json new file mode 100644 index 0000000..315aa87 --- /dev/null +++ b/META.json @@ -0,0 +1,57 @@ +{ + "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" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..d3fbde7 --- /dev/null +++ b/META.yml @@ -0,0 +1,31 @@ +--- +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' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..d22a4c2 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,87 @@ +#! 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 + diff --git a/README b/README new file mode 100644 index 0000000..664c384 --- /dev/null +++ b/README @@ -0,0 +1,124 @@ + + 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 diff --git a/bin/streamzip b/bin/streamzip new file mode 100755 index 0000000..1a34fef --- /dev/null +++ b/bin/streamzip @@ -0,0 +1,212 @@ +#!/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. + diff --git a/bin/zipdetails b/bin/zipdetails new file mode 100755 index 0000000..bff32a1 --- /dev/null +++ b/bin/zipdetails @@ -0,0 +1,2212 @@ +#!/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. + diff --git a/examples/compress-zlib/filtdef b/examples/compress-zlib/filtdef new file mode 100755 index 0000000..57dfeb9 --- /dev/null +++ b/examples/compress-zlib/filtdef @@ -0,0 +1,29 @@ +#!/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 ; diff --git a/examples/compress-zlib/filtinf b/examples/compress-zlib/filtinf new file mode 100755 index 0000000..1df202b --- /dev/null +++ b/examples/compress-zlib/filtinf @@ -0,0 +1,28 @@ +#!/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 ; + diff --git a/examples/compress-zlib/gzcat b/examples/compress-zlib/gzcat new file mode 100755 index 0000000..5241a5a --- /dev/null +++ b/examples/compress-zlib/gzcat @@ -0,0 +1,27 @@ +#!/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() ; +} diff --git a/examples/compress-zlib/gzgrep b/examples/compress-zlib/gzgrep new file mode 100755 index 0000000..324d3e6 --- /dev/null +++ b/examples/compress-zlib/gzgrep @@ -0,0 +1,27 @@ +#!/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() ; +} diff --git a/examples/compress-zlib/gzstream b/examples/compress-zlib/gzstream new file mode 100755 index 0000000..faacb0a --- /dev/null +++ b/examples/compress-zlib/gzstream @@ -0,0 +1,19 @@ +#!/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 ; diff --git a/examples/io/anycat b/examples/io/anycat new file mode 100755 index 0000000..b7f7001 --- /dev/null +++ b/examples/io/anycat @@ -0,0 +1,17 @@ +#!/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" ; + +} diff --git a/examples/io/bzip2/bzcat b/examples/io/bzip2/bzcat new file mode 100755 index 0000000..8112320 --- /dev/null +++ b/examples/io/bzip2/bzcat @@ -0,0 +1,29 @@ +#!/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() ; +} + diff --git a/examples/io/bzip2/bzgrep b/examples/io/bzip2/bzgrep new file mode 100755 index 0000000..ceb4e84 --- /dev/null +++ b/examples/io/bzip2/bzgrep @@ -0,0 +1,25 @@ +#!/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 ; +} diff --git a/examples/io/bzip2/bzstream b/examples/io/bzip2/bzstream new file mode 100755 index 0000000..3e88d68 --- /dev/null +++ b/examples/io/bzip2/bzstream @@ -0,0 +1,9 @@ +#!/usr/local/bin/perl + +use strict ; +use warnings ; +use IO::Compress::Bzip2 qw(:all); + +bzip2 '-' => '-' + or die "bzstream: $Bzip2Error\n" ; + diff --git a/examples/io/gzip/gzappend b/examples/io/gzip/gzappend new file mode 100644 index 0000000..a4a60a9 --- /dev/null +++ b/examples/io/gzip/gzappend @@ -0,0 +1,24 @@ +#!/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; + + + diff --git a/examples/io/gzip/gzcat b/examples/io/gzip/gzcat new file mode 100755 index 0000000..5572bae --- /dev/null +++ b/examples/io/gzip/gzcat @@ -0,0 +1,29 @@ +#!/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() ; +} + diff --git a/examples/io/gzip/gzgrep b/examples/io/gzip/gzgrep new file mode 100755 index 0000000..33820ba --- /dev/null +++ b/examples/io/gzip/gzgrep @@ -0,0 +1,40 @@ +#!/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() ; +} diff --git a/examples/io/gzip/gzstream b/examples/io/gzip/gzstream new file mode 100755 index 0000000..9d03bc5 --- /dev/null +++ b/examples/io/gzip/gzstream @@ -0,0 +1,24 @@ +#!/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" ; diff --git a/lib/Compress/Zlib.pm b/lib/Compress/Zlib.pm new file mode 100644 index 0000000..4a0aae6 --- /dev/null +++ b/lib/Compress/Zlib.pm @@ -0,0 +1,1513 @@ + +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. + diff --git a/lib/File/GlobMapper.pm b/lib/File/GlobMapper.pm new file mode 100644 index 0000000..a4e5385 --- /dev/null +++ b/lib/File/GlobMapper.pm @@ -0,0 +1,679 @@ +package 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. diff --git a/lib/IO/Compress/Adapter/Bzip2.pm b/lib/IO/Compress/Adapter/Bzip2.pm new file mode 100644 index 0000000..a8a7762 --- /dev/null +++ b/lib/IO/Compress/Adapter/Bzip2.pm @@ -0,0 +1,154 @@ +package 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__ + diff --git a/lib/IO/Compress/Adapter/Deflate.pm b/lib/IO/Compress/Adapter/Deflate.pm new file mode 100644 index 0000000..140d29f --- /dev/null +++ b/lib/IO/Compress/Adapter/Deflate.pm @@ -0,0 +1,170 @@ +package 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__ + diff --git a/lib/IO/Compress/Adapter/Identity.pm b/lib/IO/Compress/Adapter/Identity.pm new file mode 100644 index 0000000..487cfa7 --- /dev/null +++ b/lib/IO/Compress/Adapter/Identity.pm @@ -0,0 +1,101 @@ +package 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__ + diff --git a/lib/IO/Compress/Base.pm b/lib/IO/Compress/Base.pm new file mode 100644 index 0000000..f817d13 --- /dev/null +++ b/lib/IO/Compress/Base.pm @@ -0,0 +1,1054 @@ + +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. + diff --git a/lib/IO/Compress/Base/Common.pm b/lib/IO/Compress/Base/Common.pm new file mode 100644 index 0000000..87af18b --- /dev/null +++ b/lib/IO/Compress/Base/Common.pm @@ -0,0 +1,1053 @@ +package 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; diff --git a/lib/IO/Compress/Bzip2.pm b/lib/IO/Compress/Bzip2.pm new file mode 100644 index 0000000..13d3b46 --- /dev/null +++ b/lib/IO/Compress/Bzip2.pm @@ -0,0 +1,825 @@ +package 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. + diff --git a/lib/IO/Compress/Deflate.pm b/lib/IO/Compress/Deflate.pm new file mode 100644 index 0000000..5ecac19 --- /dev/null +++ b/lib/IO/Compress/Deflate.pm @@ -0,0 +1,958 @@ +package 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. + diff --git a/lib/IO/Compress/FAQ.pod b/lib/IO/Compress/FAQ.pod new file mode 100644 index 0000000..697f0f3 --- /dev/null +++ b/lib/IO/Compress/FAQ.pod @@ -0,0 +1,689 @@ + +=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. + diff --git a/lib/IO/Compress/Gzip.pm b/lib/IO/Compress/Gzip.pm new file mode 100644 index 0000000..3fd1369 --- /dev/null +++ b/lib/IO/Compress/Gzip.pm @@ -0,0 +1,1270 @@ +package 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