diff options
82 files changed, 9900 insertions, 0 deletions
@@ -0,0 +1,433 @@ +Revision history for Perl extension Archive-Zip + +1.49 Fri 31 Jul 2015 + - Fails on unseekable file handle after desiredCompressionLevel(), RT #54827 + - Upgrade build tools to avoid tar warnings, RT #105547 + +1.48 Thu 18 Jun 2015 + - Wrap skip in a SKIP: block [github/plicease] + +1.47 Wed 17 Jun 2015 + - zip file with a deflated directory cannot be written out again [github/ntyni] + - add missing test data to MANIFEST + +1.46 Tue 24 Mar 2015 + - "CRC or size mismatch" when extracting member second time [github/AGWA github/pwr22] + +1.45 Mon 26 Jan 2015 + - FreeBSD unzip sets $? to 0 for empty zip file [github.com/revhippie] + +1.44 Fri 23 Jan 2015 + - Win32 with ZIP executable cannot create temp file [github.com/revhippie] + +1.43 Wed 14 Jan 2015 + - Restore 101374 - failing tests were not regressions. + +1.42 Sun 11 Jan 2015 + - Revert 101374, caused tester regression + - https://rt.cpan.org/Public/Bug/Display.html?id=101240 [cpan/PMQS] + +1.41 Fri 09 Jan 2015 + - https://rt.cpan.org/Public/Bug/Display.html?id=101374 [zefram] + +1.40 Sun 04 Jan 2015 + - https://rt.cpan.org/Public/Bug/Display.html?id=92205 [cpan/PMQS] + - https://rt.cpan.org/Public/Bug/Display.html?id=101092 [cpan/PMQS] + +1.39 Tue 21 Oct 2014 + - store test data in temp dirs to fix parallelism and shuffling + [Graham Knop] + +1.38 Tue 02 Sep 2014 + - Setting unicode flag for each member when using $Archive::Zip::UNICODE [github.com/lackas] + https://rt.cpan.org/Ticket/Display.html?id=83367 + +1.37 Wed 08 Jan 2014 + - Need newer Test::More to support done_testing() [thaljef] + +1.36 Mon 30 Dec 2013 + - Fix error in version update with 1.35 [RT #91744] + +1.35 Mon 30 Dec 2013 + - fallback on copy if move gives permission denied [github.com/plicease] + +1.34 Mon 2 Dec 2013 + - Restore svn history from svn.ali.as (thanks H. Merijn Brand) + - #90854 Test 17 in t/03_ex.t is failing + - Allow reading ZIP from seekable streams (like PerlIO::Scalar) + - RT#75197 + - Fixes: #76780: Cannot create member called "0" with addString (HAGGAI) + +1.33 Sat 9 Nov 2013 + - #59102 (Spelling error in manapage) [github.com/dsteinbrunner] + - #86600 typo fixes [github.com/dsteinbrunner] + +1.32 Fri 8 Nov 2013 + - #89777 Unlink temp files generated by tempFile. [PHRED] + +1.31_04 Fri 14 Oct 2011 - Alan Haggai Alavi + - Updated Perl dependency to 5.006 to reflect implicit dependencies + in the code exposed by Perl::MinimumVersion xt test (ADAMK) + - Fixes: #68446: Set compressed size and uncompressed size of an entry to 0 + if either of them is 0 (HAGGAI) + - Added $VERSION to crc32 (ADAMK) + +1.31_03 Thu 30 Jun 2011 - H.Merijn Brand + - Add decryption support + +1.31_02 Wed 9 Mar 2011 - Adam Kennedy + - More fixes by HAGGAI, which he still doesn't detail in Changes + +1.31_01 Fri 5 Mar 2010 - Adam Kennedy + - Various fixes by HAGGAI, which he has not yet provided details on: + - Experimental Unicode in file/dir names + +1.30 Tue 30 Jun 2009 - Adam Kennedy + - Fixed a bad use of Cwd::getcwd + +1.29 Mon 29 Jun 2009 - Adam Kennedy + - Changed _asLocalName back to rel2abs, but this time using + Cwd::getcwd as the base path instead of Cwd::cwd. + This hopefully resolved #47223 (ADAMK) + +1.28 Tue 16 Jun 2009 - Adam Kennedy + - Changing to production version for release + - Reverted to revision 4736 and converted `External File Attribute' + values for symbolic links to hexadecimal (HAGGAI) + - Fixed: #15026: AddTree does not include files with german + umlauts in the filename (HAGGAI) + - Switched from Compress::Zlib to Compress::Raw::Zlib (AGRUNDMA) + - Moved crc32 from bin to script (ADAMK) + +1.27_01 Tue 16 Dec 2008 - Adam Kennedy + - Makefile.PL will create a better META.yml + - This is a test release for various improvements provided by + Alan Haggai. The entire release is credited to his grant work. + - Fixed #25726: extractMembers failing across fork on Windows. + - Fixed #12493: Can't add new files to archives which contain + files named 0,1,2,3,4,5,6,7,8,9 with no extension. + (Files named "0" are not archived) + - Fixed #22933: Properly extract symbolic links. + - Fixed #20246: Ability to assign a compression level to addTree + calls. + - Corrected regular expression for stripping trailing / + - Corrected addFileOrDirectory() behaviour and cleaned up some code + - Added symbolic link support to addFileOrDirectory + - Fixed #34657: No option, undefined behavior zipping symbolic + links (symlinks) + - Added storeSymbolicLink() + - Fixed bitFlag() to set General Pupose Bit Flags + +1.26 Mon 13 Oct 2008 - Adam Kennedy + - Fixed the dreaded but #24036: WinXP Explorer Exposes Problems. + This caused directories to appear as files in Windows Explorer + and was caused by Windows always reading the msdos directory bit + even when the file attributes are types as unix. + Resolved by emulating the behaviour of Info-Zip and setting + the 5th bit in the externalFileAttributes field. + +1.25 Sat 11 Oct 2008 - Adam Kennedy + - Removing "use warnings" instances that somehow slipped in + - Skip test if Digest::MD5 is not available + +1.24 Sun 23 Aug 2008 - Adam Kennedy + - Blatantly pander to CPANTS by adding use strict to a deprecated module + - Add an explicit load of FileHandle since in some circumstances, + calling GLOB->print() failed. + - Fixed http://rt.cpan.org/Public/Bug/Display.html?id=25925 : + - Archive-Zip wrote faulty .zip files when $\ was set (such as when running + using perl -l). + - Incorporated a heavily modified version of ECARROLL's test file. + - Thanks for ECARROLL for reporting it, and helping with the investigation. + - The fix was to convert all $fh->print(@data) to $self->_print($fh, @data) + where the _print() method localizes $\ to undef. + - Fixed http://rt.cpan.org/Ticket/Display.html?id=14132 : + - Incorrect file permissions after extraction. + - Archive-Zip did not set the file permissions correctly in + extractToFileNamed(). + - Added t/10_chmod.t and t/data/chmod.zip. Changed + lib/Archive/Zip/Member.pm. + - Reported by ak2 and jlv (Thanks!) + - SHLOMIF wrote the test script. + - (SHLOMIF) + - Removed a double "required module" from the Archive::Zip POD. + - Fixed http://rt.cpan.org/Ticket/Display.html?id=24557 ("documentation + improvement"): + - mentioned Archive::Zip::MemberRead in a few places. + - TODO: + - 1. Add a method to Archive::Zip to get a ::MemberRead from an + archive member using -> notation. (?) + - 2. In the POD of ::MemberRead - replace the indirect object + call. + - Changed the POD of ::MemberRead: + - replaced the indirect object construction with $PKG->new(). + - Fixed http://rt.cpan.org/Public/Bug/Display.html?id=34103 : + - changed the example to read unless ( .. == AZ_OK) instead of + unless ( != AZ_OK), which was incorrect. + +1.23 Thu 8 Nov 2007 - Adam Kennedy + - Temporarily skilling some failing tests on Win32 in the + interests of toolchain sanity. (until we work out the + real problem here) + +1.22 Fri 2 Nov 2007 - Adam Kennedy + - Fixing platform compatibility bugs in the new regression tests + from 1.21. + +1.21 Thu 1 Nov 2007 - Adam Kennedy + - Tidying up copyright formatting a bit. + - Disable the GPBF_HAS_DATA_DESCRIPTOR_MASK bit when auto-switching + directory storage to STORED because of a WinZip workaround because + the read code in Java JAR which was... ok, I really don't understand, + but Roland from Verisign says this one extra line unbreaks JAR files, + so I just applied it :) + - fixed http://rt.cpan.org/Public/Bug/Display.html?id=27463 with a + regression test - cannot add files whose entire filenames are "0". + (SHLOMIF). + - fixed http://rt.cpan.org/Public/Bug/Display.html?id=26384 with a + regression test - Archive::Zip::MemberRead::getline ignores + $INPUT_RECORD_SEPARATOR . The modified file in the bug had it to be + reworked a bit and tests were added in the file + 08_readmember_record_sep.t. + - Thanks to kovesp [...] sympatico.ca + - (SHLOMIF) + +1.20 Tue 5 Jun 2007 - Adam Kennedy + - Removing dependency on File::Which due to public outburst of flaming + on cpanra(n)tings by H.Merijn Brand. Try a simple email next time. :( + - Embedding an entire copy of File::Which inside the tests instead as + an alternative to compensating for the lack of build_requires. + - Removing the docs directory. + It only had out of date files and non-free copyrighted materials. + The tarball was probably illegal to distribute as a result. + (reported by Debian devs) + +1.19 Internal use, public release skipped + +1.18 Wed 25 Oct 2006 - Adam Kennedy + - Changing to a production version for final release + - No other changes of any kind + +1.17_05 Tue 19 Sep 2006 - Adam Kennedy + - Seperated the classes from the main file into seperate packages. + - Merged the Zip.pod into the main Zip.pm file. + - Applied default Perl::Tidy to all of the source files, to improve + the readability and maintainability of the files. + - Added license in Makefile.PL + - Added some additional entries to the realclean files + +1.17_03 Sat 16 Sep 2006 - Adam Kennedy + - Adding dependency on File::Which to deal with problems on systems + that lack zip and unzip programs. This really should be a build-time + dependency only, but ExtUtils::MakeMaker lacks that capability. + - Builds and tests cleanly on Win32 now. + +1.17_02 Sun 7 May 2006 - Adam Kennedy + - Renamed the test scripts to the more conventional 01_name.t style + - Upgraded all test scripts from Test.pm to Test::More (removing Test.pm dependency) + - Various other miscellaneous cleanups of the test scripts + - Removed MANIFEST and pod.t from repository (will be auto-generated) + - Some cleaning up of the POD documentation for readability + - Added SUPPORT section to docs + - Merged external TODO file into the POD as a more-common TO DO section + - Added a BUGS section to the docs + +1.17_01 Sun 30 Apr 2006 - Adam Kennedy + - Imported Archive::Zip into http://svn.ali.as/cpan/ orphanage. + If you have a CPAN login and have released a module, ask ADAMK about an + account and you can repair your bug directly in the repository. + - Removed the revision comments from the old CVS repository + - DOS DateTime Format doesn't support dates before 1980 and goes crazy when + decoding back to unix time. If we don't get passed a time at all + (0 or undef) we now throw an error. + - DOS DateTime Format doesn't support dates before 1980, so if we find any + we warn and use Jan 1 12:01pm 1980 if we encounter any + - Win32 doesn't support directory modification times. + Tentatively use the current time as the mod-time to prevent sending + null times to the unix2dos converter (and the resulting error) + - Reformat the expected empty zip warning in the output to add a note that + the warning is entirely normal. Would be nice if some time later we can + suppress it altogether, but I don't have the cross-platform STDERR-fu + without adding a dependency to IPC::Run3 (which would be bad). + - Adding a proper $VERSION to all classes, and synchronising them to the + same value. + - Adding a BEGIN block around the require 5.003_96 so it works at + compile-time instead of post-compile. + - Moved crc32 to bin/crc32 in line with package layout conventions + +1.16 Mon Jul 04 12:49:30 CDT 2005 + - Grrrr...removed test that fails when installing under CPANPLUS. + +1.15 Wed Jun 22 10:24:25 CDT 2005 + - added fix for RT #12771 Minor nit: warning in Archive::Zip::DirectoryMember::contents() + - added fix for RT #13327 Formatting problem in Archive::Zip::Tree manpage + +1.15_02 Sat Mar 12 09:16:30 CST 2005 + - fixed dates in previous entry! + - began the process of migrating from the monolithic t/test.t to + smaller scripts using Test::More. + - started work on improving Archive::Zip's test coverage. Coverage + is now up to just over 80%. + - added error handling to writeToFileHandle + - fixed small bug in extractMember from previous version + +1.15_01 Wed Mar 9 22:26:52 CST 2005 + - added fix for RT #11818 extractMember method corrupts archive + - added t/pod.t to test for pod correctness + +1.10 Thu Mar 25 06:24:17 PST 2004 + - Fixed documentation of setErrorHandler() + - Fixed link to Japanese translation of docs + - Added Compress::Zlib Bufsize patch from Yeasah Pell that was supposed to + have been added in 1.02 + - Fixed problems with backup filenames for zips with no extension + - Fixed problems with undef volume names in _asLocalName() + +1.09 Wed Nov 26 17:43:49 PST 2003 + - Fixed handling of inserted garbage (as from viruses) + - Always check for local header signatures before using them + - Added updateMember() and updateTree() functions + - Added examples/mailZip.pl + - Added examples/updateTree.pl + - Fixed some potential but unreported bugs with function parameters like '0' + - Removed stray warn() call + - Caught undef second arg to replaceMember() + - Fixed test suite run with spaces in build dir name (ticket 4214) + +1.08 Tue Oct 21 07:01:29 PDT 2003 + - test noise fix from Michael Schwern (ticket 4174) + - FAQ NAME fix from Michael Schwern (ticket 4175) + +1.07 Mon Oct 20 06:48:41 PDT 2003 + - Added file attribute code by Maurice Aubrey + - Added FAQ about RedHat 9 + - Added check for empty filenames + +1.06 Thu Jul 17 11:06:18 PDT 2003 + - Fixed seek use with IO::Scalar and IO::String + - Fixed use of binmode with pseudo-file handles + - Removed qr{} form for older Perl versions + - Changed rel2abs logic in _asLocalName() if there is a volume + - Fixed errors with making directories in extractMember() when none provided + - Return AZ_OK in extractMemberWithoutPaths() if member is a directory + - Fixed problem in extractTree with blank directory becoming "." prefix + - Added examples/writeScalar2.pl to show how to use IO::String as destination of Zip write + - Edited docs and FAQ to recommend against using absolute path names in zip files. + +1.05 Wed Sep 11 12:31:20 PDT 2002 + - fixed untaint from 1.04 + +1.04 Wed Sep 11 07:22:04 PDT 2002 + - added untaint of lastModFileDateTime + +1.03 Mon Sep 2 20:42:43 PDT 2002 + - Removed dependency on IO::Scalar + - Set required version of File::Spec to 0.8 + - Removed tests of examples that needed IO::Scalar + - Added binmode() call to read/writeScalar examples + - Fixed addTree() for 5.005 compatibility (still untested with 5.004) + - Fixed mkdir() calls for 5.005 + - Clarified documentation of tree operations + +1.02 Fri Aug 23 17:07:22 PDT 2002 + - Many changes for cross-platform use (use File::Spec everywhere) + - Separated POD from Perl + - Moved Archive::Zip::Tree contents into Archive::Zip + A::Z::Tree is now deprecated and will warn with -w + - Reorganized docs + - Added FAQ + - Added chunkSize() call to report current chunk size + and added C::Z BufSize patch from Yeasah Pell. + - Added fileName() to report last read zip file name + - Added capability to prepend data, like for SFX files + - Added examples/selfex.pl for self-extracting archives creation + - Added examples/zipcheck.pl for validity testing + - Made extractToFileNamed() set access/modification times + - Added t/testTree.t to test A::Z::Tree + - Fix/speed up memberNamed() + - Added Archive::Zip::MemberRead by Sreeji K. Das + - Added tempFile(), tempName() + - Added overwrite() and overwriteAs() to allow read/modify/write of zip + - added examples/updateZip.pl to show how to read/modify/write + +1.01 Tue Apr 30 10:34:44 PDT 2002 + - Changed mkpath call for directories to work with BSD/OS + - Changed tests to work with BSD/OS + +1.00 Sun Apr 28 2002 + - Added several examples: + - examples/calcSizes.pl + How to find out how big a zip file will be before writing it + - examples/readScalar.pl + shows how to use IO::Scalar as the source of a zip read + - examples/unzipAll.pl + uses Archive::Zip::Tree to unzip an entire zip + - examples/writeScalar.pl + shows how to use IO::Scalar as the destination of a zip write + - examples/zipGrep.pl + Searches for text in zip files + - Changed required version of Compress::Zlib to 1.08 + - Added detection and repair of zips with added garbage (as caused by + the Sircam worm) + - Added more documentation for FAQ-type questions, though few seem to + actually read the documentation. + - Fixed problem with stat vs lstat + - Changed version number to 1.00 for PHB compatibility + +0.12 Wed May 23 17:48:21 PDT 2001 + - Added writeScalar.pl and readScalar.pl to show use of IO::Scalar + - Fixed docs + - Fixed bug with EOCD signature on block boundary + - Made it work with IO::Scalar as file handles + - added readFromFileHandle() + - remove guess at seekability for Windows compatibility + +0.11 Tue Jan 9 11:40:10 PST 2001 + - Added examples/ziprecent.pl (by Rudi Farkas) + - Fixed up documentation in Archive::Zip::Tree + - Added to documentation in Archive::Zip::Tree + - Fixed bugs in Archive::Zip::Tree that kept predicates from working + - Detected file not existing errors in addFile + +0.10 Tue Aug 8 13:50:19 PDT 2000 + - Several bug fixes + - More robust new file handle logic can (again) + take opened file handles + - Detect attempts to overwrite zip file when members + depend on it + +0.09 Tue May 9 13:27:35 PDT 2000 + - Added fix for bug in contents() + - removed system("rm") call in t/test.t for Windows. + +0.08 March 27 2000 (unreleased) + - Fixed documentation + - Used IO::File instead of FileHandle, allowed for use of almost anything as + a file handle. + - Extra filenames can be passed to extractMember(), + extractMemberWithoutPaths(), addFile(), addDirectory() + - Added work-around for WinZip bug with 0-length DEFLATED files + - Added Archive::Zip::Tree module for adding/extracting hierarchies + +0.07 Fri Mar 24 10:26:51 PST 2000 + - Added copyright + - Added desiredCompressionLevel() and documentation + - Made writeToFileHandle() detect seekability by default + - Allowed Archive::Zip->new() to take filename for read() + - Added crc32String() to Archive::Zip::Member + - Changed requirement in Makefile.PL to Compress::Zip + version 1.06 or later (bug in earlier versions can truncate data) + - Moved BufferedFileHandle and MockFileHandle into + Archive::Zip namespace + - Allowed changing error printing routine + - Factored out reading of signatures + - Made re-read of local header for directory members + depend on file handle seekability + - Added ability to change member contents + - Fixed a possible truncation bug in contents() method + +0.06 Tue Mar 21 15:28:22 PST 2000 + - first release to CPAN + +0.01 Sun Mar 12 18:59:55 2000 + - original version; created by h2xs 1.19 diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..57ec4c7 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,82 @@ +Changes +examples/calcSizes.pl +examples/copy.pl +examples/extract.pl +examples/mailZip.pl +examples/mfh.pl +examples/readScalar.pl +examples/selfex.pl +examples/unzipAll.pl +examples/updateTree.pl +examples/updateZip.pl +examples/writeScalar.pl +examples/writeScalar2.pl +examples/zip.pl +examples/zipcheck.pl +examples/zipGrep.pl +examples/zipinfo.pl +examples/ziprecent.pl +examples/ziptest.pl +lib/Archive/Zip.pm +lib/Archive/Zip/Archive.pm +lib/Archive/Zip/BufferedFileHandle.pm +lib/Archive/Zip/DirectoryMember.pm +lib/Archive/Zip/FAQ.pod +lib/Archive/Zip/FileMember.pm +lib/Archive/Zip/Member.pm +lib/Archive/Zip/MemberRead.pm +lib/Archive/Zip/MockFileHandle.pm +lib/Archive/Zip/NewFileMember.pm +lib/Archive/Zip/StringMember.pm +lib/Archive/Zip/Tree.pm +lib/Archive/Zip/ZipFileMember.pm +Makefile.PL +MANIFEST This list of files +script/crc32 +t/01_compile.t +t/02_main.t +t/03_ex.t +t/04_readmember.t +t/05_tree.t +t/06_update.t +t/07_filenames_of_0.t +t/08_readmember_record_sep.t +t/09_output_record_sep.t +t/10_chmod.t +t/11_explorer.t +t/12_bug_47223.t +t/13_bug_46303.t +t/14_leading_separator.t +t/15_decrypt.t +t/16_decrypt.t +t/17_101092.t +t/18_bug_92205.t +t/19_bug_101240.t +t/20_bug_github11.t +t/21_zip64.t +t/22_deflated_dir.t +t/badjpeg/expected.jpg +t/badjpeg/source.zip +t/common.pm +t/data/bad_github11.zip +t/data/chmod.zip +t/data/crypcomp.zip +t/data/crypt.zip +t/data/def.zip +t/data/defstr.zip +t/data/good_github11.zip +t/data/jar.zip +t/data/store.zip +t/data/storestr.zip +t/data/emptydef.zip +t/data/emptydefstr.zip +t/data/emptystore.zip +t/data/emptystorestr.zip +t/data/linux.zip +t/data/mkzip.pl +t/data/perl.zip +t/data/streamed.zip +t/data/winzip.zip +t/data/zip64.zip +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..317a592 --- /dev/null +++ b/META.json @@ -0,0 +1,57 @@ +{ + "abstract" : "Provide an interface to ZIP archive files.", + "author" : [ + "Ned Konz <perl@bike-nomad.com>" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Archive-Zip", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "Test::More" : "0.88" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Compress::Raw::Zlib" : "2.017", + "File::Basename" : "0", + "File::Copy" : "0", + "File::Find" : "0", + "File::Path" : "0", + "File::Spec" : "0.80", + "File::Temp" : "0", + "IO::File" : "0", + "IO::Handle" : "0", + "IO::Seekable" : "0", + "Time::Local" : "0", + "perl" : "5.006" + } + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "https://github.com/redhotpenguin/perl-Archive-Zip-svn" + } + }, + "version" : "1.49" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..cf8d979 --- /dev/null +++ b/META.yml @@ -0,0 +1,35 @@ +--- +abstract: 'Provide an interface to ZIP archive files.' +author: + - 'Ned Konz <perl@bike-nomad.com>' +build_requires: + Test::More: '0.88' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Archive-Zip +no_index: + directory: + - t + - inc +requires: + Compress::Raw::Zlib: '2.017' + File::Basename: '0' + File::Copy: '0' + File::Find: '0' + File::Path: '0' + File::Spec: '0.80' + File::Temp: '0' + IO::File: '0' + IO::Handle: '0' + IO::Seekable: '0' + Time::Local: '0' + perl: '5.006' +resources: + repository: https://github.com/redhotpenguin/perl-Archive-Zip-svn +version: '1.49' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..35f2b0f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,85 @@ +use strict; +BEGIN { + require 5.004; +} + +use Config; +use ExtUtils::MakeMaker; + +WriteMakefile1( + META_MERGE => { + resources => { + repository => 'https://github.com/redhotpenguin/perl-Archive-Zip-svn', + }, + }, + NAME => 'Archive::Zip', + VERSION_FROM => 'lib/Archive/Zip.pm', + EXE_FILES => [ 'script/crc32' ], + PREREQ_PM => { + 'Compress::Raw::Zlib' => '2.017', + # 'Data::Dumper' => 0, # examples/zipinfo.pl + 'File::Path' => 0, + 'File::Find' => 0, + 'File::Basename' => 0, + 'File::Spec' => '0.80', # need splitpath() + 'File::Copy' => 0, + 'File::Temp' => 0, + # 'File::Which' => '0.05', # Embedded in common.pl + # 'Getopt::Std' => 0, # examples/extract.pl + 'IO::File' => 0, + 'IO::Handle' => 0, + 'IO::Seekable' => 0, + 'Time::Local' => 0, + }, + BUILD_REQUIRES => { + 'Test::More' => '0.88', + }, + clean => { + FILES => join( ' ', qw{ + test.log + testdir/* + testdir/ + extracted/testdir/* + extracted/testdir + extracted/ + testin.zip + testout.zip + test2.zip + } ), + }, + dist => { + COMPRESS => 'gzip', + SUFFIX => '.gz', + ZIP => 'zip', + ZIPFLAGS => '-r' + }, + LICENSE => 'perl', + MIN_PERL_VERSION => 5.006, + BINARY_LOCATION => $Config{'archname'} . "/\$(DISTVNAME)-PPD.tar\$(SUFFIX)", + AUTHOR => 'Ned Konz <perl@bike-nomad.com>', + ABSTRACT_FROM => 'lib/Archive/Zip.pm', +); + +sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. + my %params=@_; + my $eumm_version=$ExtUtils::MakeMaker::VERSION; + $eumm_version=eval $eumm_version; + die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; + die "License not specified" if not exists $params{LICENSE}; + if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { + #EUMM 6.5502 has problems with BUILD_REQUIRES + $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; + delete $params{BUILD_REQUIRES}; + } + delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; + delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; + delete $params{META_MERGE} if $eumm_version < 6.46; + delete $params{META_ADD} if $eumm_version < 6.46; + delete $params{LICENSE} if $eumm_version < 6.31; + delete $params{AUTHOR} if $] < 5.005; + delete $params{ABSTRACT_FROM} if $] < 5.005; + delete $params{BINARY_LOCATION} if $] < 5.005; + + WriteMakefile(%params); +} + diff --git a/examples/calcSizes.pl b/examples/calcSizes.pl new file mode 100644 index 0000000..9fd9e0b --- /dev/null +++ b/examples/calcSizes.pl @@ -0,0 +1,31 @@ +# Example of how to compute compressed sizes +# $Revision: 1.2 $ +use strict; +use Archive::Zip qw(:ERROR_CODES); +use File::Spec; +my $zip = Archive::Zip->new(); +my $blackHoleDevice = File::Spec->devnull(); + +$zip->addFile($_) foreach (<*.pl>); + +# Write and throw the data away. +# after members are written, the writeOffset will be set +# to the compressed size. +$zip->writeToFileNamed($blackHoleDevice); + +my $totalSize = 0; +my $totalCompressedSize = 0; +foreach my $member ($zip->members()) { + $totalSize += $member->uncompressedSize; + $totalCompressedSize += $member->_writeOffset; + print "Member ", $member->externalFileName, + " size=", $member->uncompressedSize, + ", writeOffset=", $member->_writeOffset, + ", compressed=", $member->compressedSize, + "\n"; +} + +print "Total Size=", $totalSize, ", total compressed=", $totalCompressedSize, + "\n"; + +$zip->writeToFileNamed('test.zip'); diff --git a/examples/copy.pl b/examples/copy.pl new file mode 100644 index 0000000..47c74e5 --- /dev/null +++ b/examples/copy.pl @@ -0,0 +1,17 @@ +# Copies a zip file to another. +# Usage: +# perl copy.pl input.zip output.zip +# $Revision: 1.4 $ + +use Archive::Zip qw(:ERROR_CODES); + +die "usage: perl copy.pl input.zip output.zip\n" + if scalar(@ARGV) != 2; + +my $zip = Archive::Zip->new(); + +my $status = $zip->read($ARGV[0]); +die("read $ARGV[0] failed: $status\n") if $status != AZ_OK; + +$status = $zip->writeToFileNamed($ARGV[1]); +die("writeToFileNamed $ARGV[1] failed: $status\n") if $status != AZ_OK; diff --git a/examples/extract.pl b/examples/extract.pl new file mode 100644 index 0000000..528ec5f --- /dev/null +++ b/examples/extract.pl @@ -0,0 +1,39 @@ +#!/bin/perl -w +# Extracts the named files into 'extractTest' subdir +# usage: +# perl extract.pl [-j] zipfile.zip filename [...] +# if -j option given, discards paths. +# +# $Revision: 1.5 $ +# +use strict; + +my $dirName = 'extractTest'; + +use vars qw( $opt_j ); +use Archive::Zip qw(:ERROR_CODES); +use Getopt::Std; + +$opt_j = 0; +getopts('j'); + +if (@ARGV < 2) { + die <<EOF + usage: perl extract.pl [-j] zipfile.zip filename [...] + if -j option given, discards paths. +EOF +} + +my $zip = Archive::Zip->new(); +my $zipName = shift(@ARGV); +my $status = $zip->read($zipName); +die "Read of $zipName failed\n" if $status != AZ_OK; + +foreach my $memberName (@ARGV) { + print "Extracting $memberName\n"; + $status = + $opt_j + ? $zip->extractMemberWithoutPaths($memberName) + : $zip->extractMember($memberName); + die "Extracting $memberName from $zipName failed\n" if $status != AZ_OK; +} diff --git a/examples/mailZip.pl b/examples/mailZip.pl new file mode 100644 index 0000000..4e043aa --- /dev/null +++ b/examples/mailZip.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w +# Requires the following to be installed: +# File::Path +# File::Spec +# IO::Scalar, ... from the IO-stringy distribution +# MIME::Base64 +# MIME::QuotedPrint +# Net::SMTP +# Mail::Internet, ... from the MailTools distribution. +# MIME::Tools + +use strict; +use Archive::Zip qw(:CONSTANTS :ERROR_CODES); +use IO::Scalar; +use MIME::Entity; # part of MIME::Tools package + +my $zipContents = ''; +my $SH = IO::Scalar->new(\$zipContents); + +my $zip = Archive::Zip->new(); +my $member; + +# add a string as a member: +my $stringMember = '<html><head></head><body><h1>Testing</h1></body></html>'; +$member = $zip->addString($stringMember, 'whatever.html'); + +# $member->desiredCompressionMethod(COMPRESSION_STORED); + +# write it to the scalar +my $status = $zip->writeToFileHandle($SH); +$SH->close; + +print STDERR "zip is " . length($zipContents) . " bytes long\n"; + +### Create an entity: +my $top = MIME::Entity->build( + Type => 'multipart/mixed', + From => 'ned@bike-nomad.com', + To => 'billnevin@tricom.net', + Subject => "Your zip", +); + +# attach the message +$top->attach( + Encoding => '7bit', + Data => "here is the zip you ordered\n" +); + +# attach the zip +$top->attach( + Data => \$zipContents, + Type => "application/x-zip", + Encoding => "base64", + Disposition => 'attachment', + Filename => 'your.zip' +); + +# attach this code +$top->attach( + Encoding => '8bit', + Type => 'text/plain', + Path => $0, + + # Data => 'whatever', + Disposition => 'inline' +); + +# and print it out to stdout +$top->print(\*STDOUT); diff --git a/examples/mfh.pl b/examples/mfh.pl new file mode 100644 index 0000000..21ce421 --- /dev/null +++ b/examples/mfh.pl @@ -0,0 +1,28 @@ +# Prints messages on every chunk write. +# Usage: +# perl mfh.pl zipfile.zip +# $Revision: 1.4 $ +use strict; +use Archive::Zip qw(:ERROR_CODES); +use Archive::Zip::MockFileHandle; + +package NedsFileHandle; +use vars qw(@ISA); +@ISA = qw( Archive::Zip::MockFileHandle ); + +sub writeHook { + my $self = shift; + my $bytes = shift; + my $length = length($bytes); + printf "write %d bytes (position now %d)\n", $length, $self->tell(); + return $length; +} + +package main; + +my $zip = Archive::Zip->new(); +my $status = $zip->read($ARGV[0]); +exit $status if $status != AZ_OK; + +my $fh = NedsFileHandle->new(); +$zip->writeToFileHandle($fh, 0); diff --git a/examples/readScalar.pl b/examples/readScalar.pl new file mode 100644 index 0000000..58dac47 --- /dev/null +++ b/examples/readScalar.pl @@ -0,0 +1,26 @@ +#!/usr/bin/perl -w +# Demonstrates reading a zip from an IO::Scalar +# $Revision: 1.4 $ +use strict; +use Archive::Zip qw(:CONSTANTS :ERROR_CODES); +use IO::Scalar; +use IO::File; + +# test reading from a scalar +my $file = IO::File->new('testin.zip', 'r'); +my $zipContents; +binmode($file); +$file->read($zipContents, 20000); +$file->close(); +printf "Read %d bytes\n", length($zipContents); + +my $SH = IO::Scalar->new(\$zipContents); + +my $zip = Archive::Zip->new(); +$zip->readFromFileHandle($SH); +my $member = $zip->addString('c' x 300, 'bunchOfCs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +$member = $zip->addString('d' x 300, 'bunchOfDs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); + +$zip->writeToFileNamed('test2.zip'); diff --git a/examples/selfex.pl b/examples/selfex.pl new file mode 100644 index 0000000..7876a96 --- /dev/null +++ b/examples/selfex.pl @@ -0,0 +1,66 @@ +#/usr/bin/perl -w +# +# Shows one way to write a self-extracting archive file. +# This is not intended for production use, and it always extracts to a +# subdirectory with a fixed name. +# Plus, it requires Perl and A::Z to be installed first. +# +# In general, you want to provide a stub that is platform-specific. +# You can use 'unzipsfx' that it provided with the Info-Zip unzip program. +# Get this from http://www.info-zip.org . +# +# $Revision: 1.6 $ +# +use strict; + +use Archive::Zip; +use IO::File; + +# Make a self-extracting Zip file. + +die "usage: $0 sfxname file [...]\n" unless @ARGV > 1; + +my $outputName = shift(); + +my $zip = Archive::Zip->new(); + +foreach my $file (@ARGV) { + $zip->addFileOrDirectory($file); +} + +my $fh = IO::File->new($outputName, O_CREAT | O_WRONLY | O_TRUNC, 0777) + or die "Can't open $outputName\: $!\n"; +binmode($fh); + +# add self-extracting Perl code + +while (<DATA>) { + $fh->print($_) +} + +$zip->writeToFileHandle($fh); + +$fh->close(); + +# below the __DATA__ line is the extraction stub: +__DATA__ +#!/usr/local/bin/perl +# Self-extracting Zip file extraction stub +# Copyright (C) 2002 Ned Konz + +use Archive::Zip qw(:ERROR_CODES); +use IO::File; +use File::Spec; + +my $dir = 'extracted'; +my $zip = Archive::Zip->new(); +my $fh = IO::File->new($0) or die "Can't open $0\: $!\n"; +die "Zip read error\n" unless $zip->readFromFileHandle($fh) == AZ_OK; + +(mkdir($dir, 0777) or die "Can't create directory $dir\: $!\n") unless -d $dir; + +for my $member ( $zip->members ) +{ + $member->extractToFileNamed( File::Spec->catfile($dir,$member->fileName) ); +} +__DATA__ diff --git a/examples/unzipAll.pl b/examples/unzipAll.pl new file mode 100644 index 0000000..02f35d9 --- /dev/null +++ b/examples/unzipAll.pl @@ -0,0 +1,29 @@ +#!/bin/perl -w +# Extracts all files from the given zip +# $Revision: 1.3 $ +# usage: +# perl unzipAll.pl [-j] zipfile.zip +# if -j option given, discards paths. +# +use strict; + +use vars qw( $opt_j ); +use Archive::Zip qw(:ERROR_CODES); +use Getopt::Std; + +$opt_j = 0; +getopts('j'); + +if (@ARGV < 1) { + die <<EOF + usage: perl $0 [-j] zipfile.zip + if -j option given, discards paths. +EOF +} + +my $zip = Archive::Zip->new(); +my $zipName = shift(@ARGV); +my $status = $zip->read($zipName); +die "Read of $zipName failed\n" if $status != AZ_OK; + +$zip->extractTree(); diff --git a/examples/updateTree.pl b/examples/updateTree.pl new file mode 100644 index 0000000..5ba98c3 --- /dev/null +++ b/examples/updateTree.pl @@ -0,0 +1,33 @@ +# Shows how to update a Zip in place using a temp file. +# +# usage: +# perl [-m] examples/updateTree.pl zipfile.zip dirname +# +# -m means to mirror +# +# $Id: updateTree.pl,v 1.2 2003/11/27 17:03:51 ned Exp $ +# +use Archive::Zip qw(:ERROR_CODES); + +my $mirror = 0; +if ($ARGV[0] eq '-m') { shift; $mirror = 1; } + +my $zipName = shift || die 'must provide a zip name'; +my $dirName = shift || die 'must provide a directory name'; + +# Read the zip +my $zip = Archive::Zip->new(); + +if (-f $zipName) { + die "can't read $zipName\n" unless $zip->read($zipName) == AZ_OK; + + # Update the zip + $zip->updateTree($dirName, undef, undef, $mirror); + + # Now the zip is updated. Write it back via a temp file. + exit($zip->overwrite()); +} else # new zip +{ + $zip->addTree($dirName); + exit($zip->writeToFileNamed($zipName)); +} diff --git a/examples/updateZip.pl b/examples/updateZip.pl new file mode 100644 index 0000000..6b87d23 --- /dev/null +++ b/examples/updateZip.pl @@ -0,0 +1,33 @@ +# Shows how to update a Zip in place using a temp file. +# $Revision: 1.1 $ +# +use Archive::Zip qw(:ERROR_CODES); +use File::Copy(); + +my $zipName = shift || die 'must provide a zip name'; +my @fileNames = @ARGV; +die 'must provide file names' unless scalar(@fileNames); + +# Read the zip +my $zip = Archive::Zip->new(); +die "can't read $zipName\n" unless $zip->read($zipName) == AZ_OK; + +# Update the zip +foreach my $file (@fileNames) { + $zip->removeMember($file); + if (-r $file) { + if (-f $file) { + $zip->addFile($file) or die "Can't add $file to zip!\n"; + } elsif (-d $file) { + $zip->addDirectory($file) or die "Can't add $file to zip!\n"; + } else { + warn "Don't know how to add $file\n"; + } + } else { + warn "Can't read $file\n"; + } +} + +# Now the zip is updated. Write it back via a temp file. + +exit($zip->overwrite()); diff --git a/examples/writeScalar.pl b/examples/writeScalar.pl new file mode 100644 index 0000000..aa1aa98 --- /dev/null +++ b/examples/writeScalar.pl @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w +use strict; +use Archive::Zip qw(:CONSTANTS :ERROR_CODES); +use IO::Scalar; +use IO::File; + +# test writing to a scalar +my $zipContents = ''; +my $SH = IO::Scalar->new(\$zipContents); + +my $zip = Archive::Zip->new(); +my $member = $zip->addString('a' x 300, 'bunchOfAs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +$member = $zip->addString('b' x 300, 'bunchOfBs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +my $status = $zip->writeToFileHandle($SH); + +my $file = IO::File->new('test.zip', 'w'); +binmode($file); +$file->print($zipContents); +$file->close(); + diff --git a/examples/writeScalar2.pl b/examples/writeScalar2.pl new file mode 100644 index 0000000..dab44c5 --- /dev/null +++ b/examples/writeScalar2.pl @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w +use strict; +use Archive::Zip qw(:CONSTANTS :ERROR_CODES); +use IO::String; +use IO::File; + +# test writing to a scalar +my $zipContents = ''; +my $SH = IO::String->new($zipContents); + +my $zip = Archive::Zip->new(); +my $member = $zip->addString('a' x 300, 'bunchOfAs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +$member = $zip->addString('b' x 300, 'bunchOfBs.txt'); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +my $status = $zip->writeToFileHandle($SH); + +my $file = IO::File->new('test.zip', 'w'); +binmode($file); +$file->print($zipContents); +$file->close(); + diff --git a/examples/zip.pl b/examples/zip.pl new file mode 100644 index 0000000..a3811d1 --- /dev/null +++ b/examples/zip.pl @@ -0,0 +1,26 @@ +#!/bin/perl -w +# Creates a zip file, adding the given directories and files. +# Usage: +# perl zip.pl zipfile.zip file [...] + +use strict; +use Archive::Zip qw(:ERROR_CODES :CONSTANTS); + +die "usage: $0 zipfile.zip file [...]\n" + if (scalar(@ARGV) < 2); + +my $zipName = shift(@ARGV); +my $zip = Archive::Zip->new(); + +foreach my $memberName (map { glob } @ARGV) { + if (-d $memberName) { + warn "Can't add tree $memberName\n" + if $zip->addTree($memberName, $memberName) != AZ_OK; + } else { + $zip->addFile($memberName) + or warn "Can't add file $memberName\n"; + } +} + +my $status = $zip->writeToFileNamed($zipName); +exit $status; diff --git a/examples/zipGrep.pl b/examples/zipGrep.pl new file mode 100644 index 0000000..b9f07b8 --- /dev/null +++ b/examples/zipGrep.pl @@ -0,0 +1,52 @@ +#!/usr/bin/perl -w +# This program searches for the given Perl regular expression in a Zip archive. +# Archive is assumed to contain text files. +# By Ned Konz, perl@bike-nomad.com +# Usage: +# perl zipGrep.pl 'pattern' myZip.zip +# +use strict; +use Archive::Zip qw(:CONSTANTS :ERROR_CODES); + +if (@ARGV != 2) { + print <<EOF; +This program searches for the given Perl regular expression in a Zip archive. +Archive is assumed to contain text files. +Usage: + perl $0 'pattern' myZip.zip +EOF + exit 1; +} + +my $pattern = shift; +$pattern = qr{$pattern}; # compile the regular expression +my $zipName = shift; + +my $zip = Archive::Zip->new(); +if ($zip->read($zipName) != AZ_OK) { + die "Read error reading $zipName\n"; +} + +foreach my $member ($zip->members()) { + my ($bufferRef, $status, $lastChunk); + my $memberName = $member->fileName(); + my $lineNumber = 1; + $lastChunk = ''; + $member->desiredCompressionMethod(COMPRESSION_STORED); + $status = $member->rewindData(); + die "rewind error $status" if $status != AZ_OK; + + while (!$member->readIsDone()) { + ($bufferRef, $status) = $member->readChunk(); + die "readChunk error $status" + if $status != AZ_OK && $status != AZ_STREAM_END; + + my $buffer = $lastChunk . $$bufferRef; + while ($buffer =~ m{(.*$pattern.*\n)}mg) { + print "$memberName:$1"; + } + ($lastChunk) = $$bufferRef =~ m{([^\n\r]+)\z}; + } + + $member->endRead(); +} diff --git a/examples/zipcheck.pl b/examples/zipcheck.pl new file mode 100644 index 0000000..3d7dccc --- /dev/null +++ b/examples/zipcheck.pl @@ -0,0 +1,35 @@ +#!/bin/perl -w +# usage: valid zipname.zip +# exits with non-zero status if invalid zip +# status = 1: invalid arguments +# status = 2: generic error somewhere +# status = 3: format error +# status = 4: IO error +use strict; +use Archive::Zip qw(:ERROR_CODES); +use IO::Handle; +use File::Spec; + +# instead of stack dump: +Archive::Zip::setErrorHandler(sub { warn shift() }); + +my $nullFileName = File::Spec->devnull(); +my $zip = Archive::Zip->new(); +my $zipName = shift(@ARGV) || exit 1; +eval { + my $status = $zip->read($zipName); + exit $status if $status != AZ_OK; +}; +if ($@) { warn 'error reading zip:', $@, "\n"; exit 2 } + +eval { + foreach my $member ($zip->members) { + my $fh = IO::File->new(); + $fh->open(">$nullFileName") || die "can't open $nullFileName\: $!\n"; + my $status = $member->extractToFileHandle($fh); + if ($status != AZ_OK) { + warn "Extracting ", $member->fileName(), " from $zipName failed\n"; + exit $status; + } + } +} diff --git a/examples/zipinfo.pl b/examples/zipinfo.pl new file mode 100644 index 0000000..8433493 --- /dev/null +++ b/examples/zipinfo.pl @@ -0,0 +1,142 @@ +#! /usr/bin/perl -w +# Print out information about a ZIP file. +# Note that this buffers the entire file into memory! +# usage: +# perl examples/zipinfo.pl zipfile.zip + +use strict; + +use Data::Dumper (); +use FileHandle; +use Archive::Zip qw(:ERROR_CODES :CONSTANTS :PKZIP_CONSTANTS); +use Archive::Zip::BufferedFileHandle; + +$| = 1; + +### Workaround for a bug in version of Data::Dumper bundled +### with some versions of Perl, which causes warnings when +### calling ->Seen below. +if (defined &Data::Dumper::init_refaddr_format) { + Data::Dumper::init_refaddr_format(); +} + +# use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING; +use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE_STRING => + pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE); +use constant LOCAL_FILE_HEADER_SIGNATURE_STRING => + pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE); + +$Data::Dumper::Useqq = 1; # enable double-quotes for string values +$Data::Dumper::Indent = 1; + +my $zip = Archive::Zip->new(); +my $zipFileName = shift(@ARGV); + +my $fh = Archive::Zip::BufferedFileHandle->new(); +$fh->readFromFile($zipFileName) or exit($!); + +my $status = $zip->_findEndOfCentralDirectory($fh); +die("can't find EOCD\n") if $status != AZ_OK; + +my $eocdPosition = $fh->tell(); + +$status = $zip->_readEndOfCentralDirectory($fh); +die("can't read EOCD\n") if $status != AZ_OK; + +my $zipDumper = Data::Dumper->new([$zip], ['ZIP']); +$zipDumper->Seen({ref($fh), $fh}); +print $zipDumper->Dump(), "\n"; + +my $expectedEOCDPosition = + $zip->centralDirectoryOffsetWRTStartingDiskNumber() + + $zip->centralDirectorySize(); + +my $eocdOffset = $zip->{eocdOffset} = $eocdPosition - $expectedEOCDPosition; + +if ($eocdOffset) { + printf "Expected EOCD at %d (0x%x) but found it at %d (0x%x)\n", + ($expectedEOCDPosition) x 2, ($eocdPosition) x 2; +} else { + printf("Found EOCD at %d (0x%x)\n\n", ($eocdPosition) x 2); +} + +my $contents = $fh->contents(); +my $offset = $eocdPosition + $eocdOffset - 1; +my $cdPos; +my @members; +my $numberOfMembers = $zip->numberOfCentralDirectoriesOnThisDisk(); +foreach my $n (0 .. $numberOfMembers - 1) { + my $index = $numberOfMembers - $n; + $cdPos = rindex($contents, + CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE_STRING, $offset); + if ($cdPos < 0) { + print "No central directory found for member #$index\n"; + last; + } else { + print "Found central directory for member #$index at $cdPos\n"; + $fh->seek($cdPos + SIGNATURE_LENGTH, 0); # SEEK_SET + my $newMember = + Archive::Zip::Member->_newFromZipFile($fh, "($zipFileName)"); + $status = $newMember->_readCentralDirectoryFileHeader(); + if ($status != AZ_OK and $status != AZ_STREAM_END) { + printf "read CD header status=%d\n", $status; + last; + } + unshift(@members, $newMember); + + my $memberDumper = + Data::Dumper->new([$newMember], ['CDMEMBER' . $index]); + $memberDumper->Seen({ref($fh), $fh}); + print $memberDumper->Dump(), "\n"; + } + $offset = $cdPos - 1; +} + +if ( $cdPos >= 0 + and $cdPos != $zip->centralDirectoryOffsetWRTStartingDiskNumber()) { + printf + "Expected to find central directory at %d (0x%x), but found it at %d (0x%x)\n", + ($zip->centralDirectoryOffsetWRTStartingDiskNumber()) x 2, + ($cdPos) x 2; +} + +print "\n"; + +# Now read the local headers + +foreach my $n (0 .. $#members) { + my $member = $members[$n]; + $fh->seek( + $member->localHeaderRelativeOffset() + $eocdOffset + SIGNATURE_LENGTH, + 0); + $status = $member->_readLocalFileHeader(); + if ($status != AZ_OK and $status != AZ_STREAM_END) { + printf "member %d read header status=%d\n", $n + 1, $status; + last; + } + + my $memberDumper = Data::Dumper->new([$member], ['LHMEMBER' . ($n + 1)]); + $memberDumper->Seen({ref($fh), $fh}); + print $memberDumper->Dump(), "\n"; + + my $endOfMember = + $member->localHeaderRelativeOffset() + + $member->_localHeaderSize() + + $member->compressedSize(); + + if ( + $endOfMember > $cdPos + or ( $n < $#members + and $endOfMember > $members[$n + 1]->localHeaderRelativeOffset()) + ) { + print "Error: "; + } + printf("End of member: %d, CD at %d", $endOfMember, $cdPos); + if ($n < $#members) { + printf(", next member starts at %d", + $members[$n + 1]->localHeaderRelativeOffset()); + } + print("\n\n"); +} + +# vim: ts=4 sw=4 diff --git a/examples/ziprecent.pl b/examples/ziprecent.pl new file mode 100644 index 0000000..9345349 --- /dev/null +++ b/examples/ziprecent.pl @@ -0,0 +1,308 @@ +#!/usr/bin/perl -w +# Makes a zip file of the most recent files in a specified directory. +# By Rudi Farkas, rudif@bluemail.ch, 9 December 2000 +# Usage: +# ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>] +# Zips files in source directory and its subdirectories +# whose file extension is in specified extensions (default: any extension). +# -d <days> max age (days) for files to be zipped (default: 1 day) +# <dir> source directory +# -e <ext> one or more space-separated extensions +# -h print help text and exit +# -msvc may be given instead of -e and will zip all msvc source files +# -q query only (list files but don't zip) +# <zippath>.zip path to zipfile to be created (or updated if it exists) +# +# $Revision: 1.2 $ + +use strict; + +use Archive::Zip qw(:ERROR_CODES :CONSTANTS); +use Cwd; +use File::Basename; +use File::Copy; +use File::Find; +use File::Path; + +# argument and variable defaults +# +my $maxFileAgeDays = 1; +my $defaultzipdir = 'h:/zip/_homework'; +my ($sourcedir, $zipdir, $zippath, @extensions, $query); + +# usage +# +my $scriptname = basename $0; +my $usage = <<ENDUSAGE; +$scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>] +Zips files in source directory and its subdirectories +whose file extension is in specified extensions (default: any extension). + -d <days> max age (days) for files to be zipped (default: 1 day) + <dir> source directory + -e <ext> one or more space-separated extensions + -h print help text and exit + -msvc may be given instead of -e and will zip all msvc source files + -q query only (list files but don't zip) + <zippath>.zip path to zipfile to be created (or updated if it exists) +ENDUSAGE + +# parse arguments +# +while (@ARGV) { + my $arg = shift; + + if ($arg eq '-d') { + $maxFileAgeDays = shift; + $maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0; + } elsif ($arg eq '-e') { + while ($ARGV[0] && $ARGV[0] !~ /^-/) { + push @extensions, shift; + } + } elsif ($arg eq '-msvc') { + push @extensions, + qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /; + } elsif ($arg eq '-q') { + $query = 1; + } elsif ($arg eq '-h') { + print STDERR $usage; + exit; + } elsif (-d $arg) { + $sourcedir = $arg; + } elsif ($arg eq '-z') { + if ($ARGV[0]) { + $zipdir = shift; + } + } elsif ($arg =~ /\.zip$/) { + $zippath = $arg; + } else { + errorExit("Unknown option or argument: $arg"); + } +} + +# process arguments +# +errorExit("Please specify an existing source directory") + unless defined($sourcedir) && -d $sourcedir; + +my $extensions; +if (@extensions) { + $extensions = join "|", @extensions; +} else { + $extensions = ".*"; +} + +# change '\' to '/' (avoids trouble in substitution on Win2k) +# +$sourcedir =~ s|\\|/|g; +$zippath =~ s|\\|/|g if defined($zippath); + +# find files +# +my @files; +cwd $sourcedir; +find(\&listFiles, $sourcedir); +printf STDERR "Found %d file(s)\n", scalar @files; + +# exit ? +# +exit if $query; +exit if @files <= 0; + +# prepare zip directory +# +if (defined($zippath)) { + + # deduce directory from zip path + $zipdir = dirname($zippath); + $zipdir = '.' unless length $zipdir; +} else { + $zipdir = $defaultzipdir; +} + +# make sure that zip directory exists +# +mkpath $zipdir unless -d $zipdir; +-d $zipdir or die "Can't find/make directory $zipdir\n"; + +# create the zip object +# +my $zip = Archive::Zip->new(); + +# read-in the existing zip file if any +# +if (defined $zippath && -f $zippath) { + my $status = $zip->read($zippath); + warn "Read $zippath failed\n" if $status != AZ_OK; +} + +# add files +# +foreach my $memberName (@files) { + if (-d $memberName) { + warn "Can't add tree $memberName\n" + if $zip->addTree($memberName, $memberName) != AZ_OK; + } else { + $zip->addFile($memberName) + or warn "Can't add file $memberName\n"; + } +} + +# prepare the new zip path +# +my $newzipfile = genfilename(); +my $newzippath = "$zipdir/$newzipfile"; + +# write the new zip file +# +my $status = $zip->writeToFileNamed($newzippath); +if ($status == AZ_OK) { + + # rename (and overwrite the old zip file if any)? + # + if (defined $zippath) { + my $res = rename $newzippath, $zippath; + if ($res) { + print STDERR "Updated file $zippath\n"; + } else { + print STDERR + "Created file $newzippath, failed to rename to $zippath\n"; + } + } else { + print STDERR "Created file $newzippath\n"; + } +} else { + print STDERR "Failed to create file $newzippath\n"; +} + +# subroutines +# + +sub listFiles { + if (/\.($extensions)$/) { + cwd $File::Find::dir; + return if -d $File::Find::name; # skip directories + my $fileagedays = fileAgeDays($_); + if ($fileagedays < $maxFileAgeDays) { + printf STDERR "$File::Find::name (%.3g)\n", $fileagedays; + (my $filename = $File::Find::name) =~ + s/^[a-zA-Z]://; # remove the leading drive letter: + push @files, $filename; + } + } +} + +sub errorExit { + printf STDERR "*** %s ***\n$usage\n", shift; + exit; +} + +sub mtime { + (stat shift)[9]; +} + +sub fileAgeDays { + (time() - mtime(shift)) / 86400; +} + +sub genfilename { + my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + localtime(time); + sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year + 1900, $mon + 1, $mday, + $hour, $min, $sec; +} + +__END__ + +=head1 NAME + +ziprecent.pl + +=head1 SYNOPSIS + + ziprecent h:/myperl + + ziprecent h:/myperl -e pl pm -d 365 + + ziprecent h:/myperl -q + + ziprecent h:/myperl h:/temp/zip/file1.zip + + +=head1 DESCRIPTION + +This script helps to collect recently modified files in a source directory +into a zip file (new or existing). + +It uses Archive::Zip. + +=over 4 + +=item C< ziprecent h:/myperl > + +Lists and zips all files more recent than 1 day (24 hours) +in directory h:/myperl and it's subdirectories, +and places the zip file into default zip directory. +The generated zip file name is based on local time (e.g. 20001208-231237.zip). + + +=item C< ziprecent h:/myperl -e pl pm -d 365 > + +Zips only .pl and .pm files more recent than one year. + + +=item C< ziprecent h:/myperl -msvc > + +Zips source files found in a typical MSVC project. + + +=item C< ziprecent h:/myperl -q > + +Lists files that should be zipped. + + +=item C< ziprecent h:/myperl h:/temp/zip/file1.zip > + +Updates file named h:/temp/zip/file1.zip +(overwrites an existing file if writable). + + +=item C< ziprecent -h > + +Prints the help text and exits. + + ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>] + Zips files in source directory and its subdirectories + whose file extension is in specified extensions (default: any extension). + -d <days> max age (days) for files to be zipped (default: 1 day) + <dir> source directory + -e <ext> one or more space-separated extensions + -h print help text and exit + -msvc may be given instead of -e and will zip all msvc source files + -q query only (list files but don't zip) + <zippath>.zip path to zipfile to be created (or updated if it exists) + +=back + + +=head1 BUGS + +Tested only on Win2k. + +Does not handle filenames without extension. + +Does not accept more than one source directory (workaround: invoke separately +for each directory, specifying the same zip file). + + +=head1 AUTHOR + +Rudi Farkas rudif@lecroy.com rudif@bluemail.ch + +=head1 SEE ALSO + +perl ;-) + +=cut + + + diff --git a/examples/ziptest.pl b/examples/ziptest.pl new file mode 100644 index 0000000..662adcc --- /dev/null +++ b/examples/ziptest.pl @@ -0,0 +1,76 @@ +#!/bin/perl -w +# $Revision: 1.7 $ +# Lists the zipfile given as a first argument and tests CRC's. +# Usage: +# perl ziptest.pl zipfile.zip + +use strict; + +use Archive::Zip qw(:ERROR_CODES :CONSTANTS); + +package CRCComputingFileHandle; +use Archive::Zip::MockFileHandle; + +use vars qw( @ISA ); +@ISA = qw( Archive::Zip::MockFileHandle ); + +my $crc; + +sub writeHook { + my $self = shift; + my $bytes = shift; + my $length = length($bytes); + $crc = Archive::Zip::computeCRC32($bytes, $crc); +} + +sub resetCRC { $crc = 0 } + +sub crc { $crc } + +package main; + +die "usage: $0 zipfile.zip\n" + if (scalar(@ARGV) != 1); + +my $zip = Archive::Zip->new(); +my $status = $zip->read($ARGV[0]); +exit $status if $status != AZ_OK; + +print " Length Size Last Modified CRC-32 Name\n"; +print "-------- -------- ------------------------ -------- ----\n"; + +my $fh = CRCComputingFileHandle->new(); +my @errors; + +foreach my $member ($zip->members()) { + my $compressedSize = $member->compressedSize(); + $fh->resetCRC(); + $member->desiredCompressionMethod(COMPRESSION_STORED); + $status = $member->extractToFileHandle($fh); + exit $status if $status != AZ_OK; + my $crc = $fh->crc(); + + my $ct = scalar(localtime($member->lastModTime())); + chomp($ct); + + printf( + "%8d %8d %s %08x %s\n", + $member->uncompressedSize(), + $compressedSize, $ct, $member->crc32(), $member->fileName()); + + if ($member->crc32() != $crc) { + push( + @errors, + sprintf( + "Member %s CRC error: file says %08x computed: %08x\n", + $member->fileName(), $member->crc32(), $crc + )); + } +} + +if (scalar(@errors)) { + print join("\n", @errors); + die "CRC errors found\n"; +} else { + print "All CRCs check OK\n"; +} diff --git a/lib/Archive/Zip.pm b/lib/Archive/Zip.pm new file mode 100644 index 0000000..22ac703 --- /dev/null +++ b/lib/Archive/Zip.pm @@ -0,0 +1,2163 @@ +package Archive::Zip; + +use 5.006; +use strict; +use Carp (); +use Cwd (); +use IO::File (); +use IO::Seekable (); +use Compress::Raw::Zlib (); +use File::Spec (); +use File::Temp (); +use FileHandle (); + +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + + require Exporter; + @ISA = qw( Exporter ); +} + +use vars qw( $ChunkSize $ErrorHandler ); + +BEGIN { + # This is the size we'll try to read, write, and (de)compress. + # You could set it to something different if you had lots of memory + # and needed more speed. + $ChunkSize ||= 32768; + + $ErrorHandler = \&Carp::carp; +} + +# BEGIN block is necessary here so that other modules can use the constants. +use vars qw( @EXPORT_OK %EXPORT_TAGS ); + +BEGIN { + @EXPORT_OK = ('computeCRC32'); + %EXPORT_TAGS = ( + CONSTANTS => [ + qw( + FA_MSDOS + FA_UNIX + GPBF_ENCRYPTED_MASK + GPBF_DEFLATING_COMPRESSION_MASK + GPBF_HAS_DATA_DESCRIPTOR_MASK + COMPRESSION_STORED + COMPRESSION_DEFLATED + COMPRESSION_LEVEL_NONE + COMPRESSION_LEVEL_DEFAULT + COMPRESSION_LEVEL_FASTEST + COMPRESSION_LEVEL_BEST_COMPRESSION + IFA_TEXT_FILE_MASK + IFA_TEXT_FILE + IFA_BINARY_FILE + ) + ], + + MISC_CONSTANTS => [ + qw( + FA_AMIGA + FA_VAX_VMS + FA_VM_CMS + FA_ATARI_ST + FA_OS2_HPFS + FA_MACINTOSH + FA_Z_SYSTEM + FA_CPM + FA_TOPS20 + FA_WINDOWS_NTFS + FA_QDOS + FA_ACORN + FA_VFAT + FA_MVS + FA_BEOS + FA_TANDEM + FA_THEOS + GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK + GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK + GPBF_IS_COMPRESSED_PATCHED_DATA_MASK + COMPRESSION_SHRUNK + DEFLATING_COMPRESSION_NORMAL + DEFLATING_COMPRESSION_MAXIMUM + DEFLATING_COMPRESSION_FAST + DEFLATING_COMPRESSION_SUPER_FAST + COMPRESSION_REDUCED_1 + COMPRESSION_REDUCED_2 + COMPRESSION_REDUCED_3 + COMPRESSION_REDUCED_4 + COMPRESSION_IMPLODED + COMPRESSION_TOKENIZED + COMPRESSION_DEFLATED_ENHANCED + COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED + ) + ], + + ERROR_CODES => [ + qw( + AZ_OK + AZ_STREAM_END + AZ_ERROR + AZ_FORMAT_ERROR + AZ_IO_ERROR + ) + ], + + # For Internal Use Only + PKZIP_CONSTANTS => [ + qw( + SIGNATURE_FORMAT + SIGNATURE_LENGTH + + LOCAL_FILE_HEADER_SIGNATURE + LOCAL_FILE_HEADER_FORMAT + LOCAL_FILE_HEADER_LENGTH + + DATA_DESCRIPTOR_SIGNATURE + DATA_DESCRIPTOR_FORMAT + DATA_DESCRIPTOR_LENGTH + + DATA_DESCRIPTOR_FORMAT_NO_SIG + DATA_DESCRIPTOR_LENGTH_NO_SIG + + CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE + CENTRAL_DIRECTORY_FILE_HEADER_FORMAT + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH + + ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE + ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_FORMAT + ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH + + ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_SIGNATURE + ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_FORMAT + ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH + + END_OF_CENTRAL_DIRECTORY_SIGNATURE + END_OF_CENTRAL_DIRECTORY_FORMAT + END_OF_CENTRAL_DIRECTORY_LENGTH + + END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING + ) + ], + + # For Internal Use Only + UTILITY_METHODS => [ + qw( + _error + _printError + _ioError + _formatError + _subclassResponsibility + _binmode + _isSeekable + _newFileHandle + _readSignature + _asZipDirName + ) + ], + ); + + # Add all the constant names and error code names to @EXPORT_OK + Exporter::export_ok_tags( + qw( + CONSTANTS + ERROR_CODES + PKZIP_CONSTANTS + UTILITY_METHODS + MISC_CONSTANTS + )); + +} + +# Error codes +use constant AZ_OK => 0; +use constant AZ_STREAM_END => 1; +use constant AZ_ERROR => 2; +use constant AZ_FORMAT_ERROR => 3; +use constant AZ_IO_ERROR => 4; + +# File types +# Values of Archive::Zip::Member->fileAttributeFormat() + +use constant FA_MSDOS => 0; +use constant FA_AMIGA => 1; +use constant FA_VAX_VMS => 2; +use constant FA_UNIX => 3; +use constant FA_VM_CMS => 4; +use constant FA_ATARI_ST => 5; +use constant FA_OS2_HPFS => 6; +use constant FA_MACINTOSH => 7; +use constant FA_Z_SYSTEM => 8; +use constant FA_CPM => 9; +use constant FA_TOPS20 => 10; +use constant FA_WINDOWS_NTFS => 11; +use constant FA_QDOS => 12; +use constant FA_ACORN => 13; +use constant FA_VFAT => 14; +use constant FA_MVS => 15; +use constant FA_BEOS => 16; +use constant FA_TANDEM => 17; +use constant FA_THEOS => 18; + +# general-purpose bit flag masks +# Found in Archive::Zip::Member->bitFlag() + +use constant GPBF_ENCRYPTED_MASK => 1 << 0; +use constant GPBF_DEFLATING_COMPRESSION_MASK => 3 << 1; +use constant GPBF_HAS_DATA_DESCRIPTOR_MASK => 1 << 3; + +# deflating compression types, if compressionMethod == COMPRESSION_DEFLATED +# ( Archive::Zip::Member->bitFlag() & GPBF_DEFLATING_COMPRESSION_MASK ) + +use constant DEFLATING_COMPRESSION_NORMAL => 0 << 1; +use constant DEFLATING_COMPRESSION_MAXIMUM => 1 << 1; +use constant DEFLATING_COMPRESSION_FAST => 2 << 1; +use constant DEFLATING_COMPRESSION_SUPER_FAST => 3 << 1; + +# compression method + +# these two are the only ones supported in this module +use constant COMPRESSION_STORED => 0; # file is stored (no compression) +use constant COMPRESSION_DEFLATED => 8; # file is Deflated +use constant COMPRESSION_LEVEL_NONE => 0; +use constant COMPRESSION_LEVEL_DEFAULT => -1; +use constant COMPRESSION_LEVEL_FASTEST => 1; +use constant COMPRESSION_LEVEL_BEST_COMPRESSION => 9; + +# internal file attribute bits +# Found in Archive::Zip::Member::internalFileAttributes() + +use constant IFA_TEXT_FILE_MASK => 1; +use constant IFA_TEXT_FILE => 1; +use constant IFA_BINARY_FILE => 0; + +# PKZIP file format miscellaneous constants (for internal use only) +use constant SIGNATURE_FORMAT => "V"; +use constant SIGNATURE_LENGTH => 4; + +# these lengths are without the signature. +use constant LOCAL_FILE_HEADER_SIGNATURE => 0x04034b50; +use constant LOCAL_FILE_HEADER_FORMAT => "v3 V4 v2"; +use constant LOCAL_FILE_HEADER_LENGTH => 26; + +# PKZIP docs don't mention the signature, but Info-Zip writes it. +use constant DATA_DESCRIPTOR_SIGNATURE => 0x08074b50; +use constant DATA_DESCRIPTOR_FORMAT => "V3"; +use constant DATA_DESCRIPTOR_LENGTH => 12; + +# but the signature is apparently optional. +use constant DATA_DESCRIPTOR_FORMAT_NO_SIG => "V2"; +use constant DATA_DESCRIPTOR_LENGTH_NO_SIG => 8; + +use constant CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE => 0x02014b50; +use constant CENTRAL_DIRECTORY_FILE_HEADER_FORMAT => "C2 v3 V4 v5 V2"; +use constant CENTRAL_DIRECTORY_FILE_HEADER_LENGTH => 42; + +# zip64 support +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE => 0x06064b50; +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_FORMAT => 0; +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_LENGTH => 0; + +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_SIGNATURE => 0x07064b50; +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_FORMAT => 0; +use constant ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_LENGTH => 0; + + +use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE => 0x06054b50; +use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING => + pack("V", END_OF_CENTRAL_DIRECTORY_SIGNATURE); +use constant END_OF_CENTRAL_DIRECTORY_FORMAT => "v4 V2 v"; +use constant END_OF_CENTRAL_DIRECTORY_LENGTH => 18; + +use constant GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK => 1 << 1; +use constant GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK => 1 << 2; +use constant GPBF_IS_COMPRESSED_PATCHED_DATA_MASK => 1 << 5; + +# the rest of these are not supported in this module +use constant COMPRESSION_SHRUNK => 1; # file is Shrunk +use constant COMPRESSION_REDUCED_1 => 2; # file is Reduced CF=1 +use constant COMPRESSION_REDUCED_2 => 3; # file is Reduced CF=2 +use constant COMPRESSION_REDUCED_3 => 4; # file is Reduced CF=3 +use constant COMPRESSION_REDUCED_4 => 5; # file is Reduced CF=4 +use constant COMPRESSION_IMPLODED => 6; # file is Imploded +use constant COMPRESSION_TOKENIZED => 7; # reserved for Tokenizing compr. +use constant COMPRESSION_DEFLATED_ENHANCED => 9; # reserved for enh. Deflating +use constant COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED => 10; + +# Load the various required classes +require Archive::Zip::Archive; +require Archive::Zip::Member; +require Archive::Zip::FileMember; +require Archive::Zip::DirectoryMember; +require Archive::Zip::ZipFileMember; +require Archive::Zip::NewFileMember; +require Archive::Zip::StringMember; + +# Convenience functions + +sub _ISA ($$) { + + # Can't rely on Scalar::Util, so use the next best way + local $@; + !!eval { ref $_[0] and $_[0]->isa($_[1]) }; +} + +sub _CAN ($$) { + local $@; + !!eval { ref $_[0] and $_[0]->can($_[1]) }; +} + +##################################################################### +# Methods + +sub new { + my $class = shift; + return Archive::Zip::Archive->new(@_); +} + +sub computeCRC32 { + my ($data, $crc); + + if (ref($_[0]) eq 'HASH') { + $data = $_[0]->{string}; + $crc = $_[0]->{checksum}; + } else { + $data = shift; + $data = shift if ref($data); + $crc = shift; + } + + return Compress::Raw::Zlib::crc32($data, $crc); +} + +# Report or change chunk size used for reading and writing. +# Also sets Zlib's default buffer size (eventually). +sub setChunkSize { + shift if ref($_[0]) eq 'Archive::Zip::Archive'; + my $chunkSize = (ref($_[0]) eq 'HASH') ? shift->{chunkSize} : shift; + my $oldChunkSize = $Archive::Zip::ChunkSize; + $Archive::Zip::ChunkSize = $chunkSize if ($chunkSize); + return $oldChunkSize; +} + +sub chunkSize { + return $Archive::Zip::ChunkSize; +} + +sub setErrorHandler { + my $errorHandler = (ref($_[0]) eq 'HASH') ? shift->{subroutine} : shift; + $errorHandler = \&Carp::carp unless defined($errorHandler); + my $oldErrorHandler = $Archive::Zip::ErrorHandler; + $Archive::Zip::ErrorHandler = $errorHandler; + return $oldErrorHandler; +} + +###################################################################### +# Private utility functions (not methods). + +sub _printError { + my $string = join(' ', @_, "\n"); + my $oldCarpLevel = $Carp::CarpLevel; + $Carp::CarpLevel += 2; + &{$ErrorHandler}($string); + $Carp::CarpLevel = $oldCarpLevel; +} + +# This is called on format errors. +sub _formatError { + shift if ref($_[0]); + _printError('format error:', @_); + return AZ_FORMAT_ERROR; +} + +# This is called on IO errors. +sub _ioError { + shift if ref($_[0]); + _printError('IO error:', @_, ':', $!); + return AZ_IO_ERROR; +} + +# This is called on generic errors. +sub _error { + shift if ref($_[0]); + _printError('error:', @_); + return AZ_ERROR; +} + +# Called when a subclass should have implemented +# something but didn't +sub _subclassResponsibility { + Carp::croak("subclass Responsibility\n"); +} + +# Try to set the given file handle or object into binary mode. +sub _binmode { + my $fh = shift; + return _CAN($fh, 'binmode') ? $fh->binmode() : binmode($fh); +} + +# Attempt to guess whether file handle is seekable. +# Because of problems with Windows, this only returns true when +# the file handle is a real file. +sub _isSeekable { + my $fh = shift; + return 0 unless ref $fh; + _ISA($fh, "IO::Scalar") # IO::Scalar objects are brokenly-seekable + and return 0; + _ISA($fh, "IO::String") + and return 1; + if (_ISA($fh, "IO::Seekable")) { + + # Unfortunately, some things like FileHandle objects + # return true for Seekable, but AREN'T!!!!! + _ISA($fh, "FileHandle") + and return 0; + return 1; + } + + # open my $fh, "+<", \$data; + ref $fh eq "GLOB" && eval { seek $fh, 0, 1 } and return 1; + _CAN($fh, "stat") + and return -f $fh; + return (_CAN($fh, "seek") and _CAN($fh, "tell")) ? 1 : 0; +} + +# Print to the filehandle, while making sure the pesky Perl special global +# variables don't interfere. +sub _print { + my ($self, $fh, @data) = @_; + + local $\; + + return $fh->print(@data); +} + +# Return an opened IO::Handle +# my ( $status, fh ) = _newFileHandle( 'fileName', 'w' ); +# Can take a filename, file handle, or ref to GLOB +# Or, if given something that is a ref but not an IO::Handle, +# passes back the same thing. +sub _newFileHandle { + my $fd = shift; + my $status = 1; + my $handle; + + if (ref($fd)) { + if (_ISA($fd, 'IO::Scalar') or _ISA($fd, 'IO::String')) { + $handle = $fd; + } elsif (_ISA($fd, 'IO::Handle') or ref($fd) eq 'GLOB') { + $handle = IO::File->new; + $status = $handle->fdopen($fd, @_); + } else { + $handle = $fd; + } + } else { + $handle = IO::File->new; + $status = $handle->open($fd, @_); + } + + return ($status, $handle); +} + +# Returns next signature from given file handle, leaves +# file handle positioned afterwards. +# In list context, returns ($status, $signature) +# ( $status, $signature) = _readSignature( $fh, $fileName ); + +sub _readSignature { + my $fh = shift; + my $fileName = shift; + my $expectedSignature = shift; # optional + + my $signatureData; + my $bytesRead = $fh->read($signatureData, SIGNATURE_LENGTH); + if ($bytesRead != SIGNATURE_LENGTH) { + return _ioError("reading header signature"); + } + my $signature = unpack(SIGNATURE_FORMAT, $signatureData); + my $status = AZ_OK; + + # compare with expected signature, if any, or any known signature. + if ( + (defined($expectedSignature) && $signature != $expectedSignature) + || ( !defined($expectedSignature) + && $signature != CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE + && $signature != LOCAL_FILE_HEADER_SIGNATURE + && $signature != END_OF_CENTRAL_DIRECTORY_SIGNATURE + && $signature != DATA_DESCRIPTOR_SIGNATURE + && $signature != ZIP64_END_OF_CENTRAL_DIRECTORY_RECORD_SIGNATURE + && $signature != ZIP64_END_OF_CENTRAL_DIRECTORY_LOCATOR_SIGNATURE + ) + ) { + my $errmsg = sprintf("bad signature: 0x%08x", $signature); + if (_isSeekable($fh)) { + $errmsg .= sprintf(" at offset %d", $fh->tell() - SIGNATURE_LENGTH); + } + + $status = _formatError("$errmsg in file $fileName"); + } + + return ($status, $signature); +} + +# Utility method to make and open a temp file. +# Will create $temp_dir if it does not exist. +# Returns file handle and name: +# +# my ($fh, $name) = Archive::Zip::tempFile(); +# my ($fh, $name) = Archive::Zip::tempFile('mytempdir'); +# + +sub tempFile { + my $dir = (ref($_[0]) eq 'HASH') ? shift->{tempDir} : shift; + my ($fh, $filename) = File::Temp::tempfile( + SUFFIX => '.zip', + UNLINK => 1, + $dir ? (DIR => $dir) : ()); + return (undef, undef) unless $fh; + my ($status, $newfh) = _newFileHandle($fh, 'w+'); + return ($newfh, $filename); +} + +# Return the normalized directory name as used in a zip file (path +# separators become slashes, etc.). +# Will translate internal slashes in path components (i.e. on Macs) to +# underscores. Discards volume names. +# When $forceDir is set, returns paths with trailing slashes (or arrays +# with trailing blank members). +# +# If third argument is a reference, returns volume information there. +# +# input output +# . ('.') '.' +# ./a ('a') a +# ./a/b ('a','b') a/b +# ./a/b/ ('a','b') a/b +# a/b/ ('a','b') a/b +# /a/b/ ('','a','b') a/b +# c:\a\b\c.doc ('','a','b','c.doc') a/b/c.doc # on Windows +# "i/o maps:whatever" ('i_o maps', 'whatever') "i_o maps/whatever" # on Macs +sub _asZipDirName { + my $name = shift; + my $forceDir = shift; + my $volReturn = shift; + my ($volume, $directories, $file) = + File::Spec->splitpath(File::Spec->canonpath($name), $forceDir); + $$volReturn = $volume if (ref($volReturn)); + my @dirs = map { $_ =~ s{/}{_}g; $_ } File::Spec->splitdir($directories); + if (@dirs > 0) { pop(@dirs) unless $dirs[-1] } # remove empty component + push(@dirs, defined($file) ? $file : ''); + + #return wantarray ? @dirs : join ( '/', @dirs ); + + my $normalised_path = join '/', @dirs; + + # Leading directory separators should not be stored in zip archives. + # Example: + # C:\a\b\c\ a/b/c + # C:\a\b\c.txt a/b/c.txt + # /a/b/c/ a/b/c + # /a/b/c.txt a/b/c.txt + $normalised_path =~ s{^/}{}; # remove leading separator + + return $normalised_path; +} + +# Return an absolute local name for a zip name. +# Assume a directory if zip name has trailing slash. +# Takes an optional volume name in FS format (like 'a:'). +# +sub _asLocalName { + my $name = shift; # zip format + my $volume = shift; + $volume = '' unless defined($volume); # local FS format + + my @paths = split(/\//, $name); + my $filename = pop(@paths); + $filename = '' unless defined($filename); + my $localDirs = @paths ? File::Spec->catdir(@paths) : ''; + my $localName = File::Spec->catpath($volume, $localDirs, $filename); + unless ($volume) { + $localName = File::Spec->rel2abs($localName, Cwd::getcwd()); + } + return $localName; +} + +1; + +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +Archive::Zip - Provide an interface to ZIP archive files. + +=head1 SYNOPSIS + + # Create a Zip file + use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); + my $zip = Archive::Zip->new(); + + # Add a directory + my $dir_member = $zip->addDirectory( 'dirname/' ); + + # Add a file from a string with compression + my $string_member = $zip->addString( 'This is a test', 'stringMember.txt' ); + $string_member->desiredCompressionMethod( COMPRESSION_DEFLATED ); + + # Add a file from disk + my $file_member = $zip->addFile( 'xyz.pl', 'AnotherName.pl' ); + + # Save the Zip file + unless ( $zip->writeToFileNamed('someZip.zip') == AZ_OK ) { + die 'write error'; + } + + # Read a Zip file + my $somezip = Archive::Zip->new(); + unless ( $somezip->read( 'someZip.zip' ) == AZ_OK ) { + die 'read error'; + } + + # Change the compression type for a file in the Zip + my $member = $somezip->memberNamed( 'stringMember.txt' ); + $member->desiredCompressionMethod( COMPRESSION_STORED ); + unless ( $zip->writeToFileNamed( 'someOtherZip.zip' ) == AZ_OK ) { + die 'write error'; + } + +=head1 DESCRIPTION + +The Archive::Zip module allows a Perl program to create, manipulate, read, +and write Zip archive files. + +Zip archives can be created, or you can read from existing zip files. + +Once created, they can be written to files, streams, or strings. Members +can be added, removed, extracted, replaced, rearranged, and enumerated. +They can also be renamed or have their dates, comments, or other attributes +queried or modified. Their data can be compressed or uncompressed as needed. + +Members can be created from members in existing Zip files, or from existing +directories, files, or strings. + +This module uses the L<Compress::Raw::Zlib> library to read and write the +compressed streams inside the files. + +One can use L<Archive::Zip::MemberRead> to read the zip file archive members +as if they were files. + +=head2 File Naming + +Regardless of what your local file system uses for file naming, names in a +Zip file are in Unix format (I<forward> slashes (/) separating directory +names, etc.). + +C<Archive::Zip> tries to be consistent with file naming conventions, and will +translate back and forth between native and Zip file names. + +However, it can't guess which format names are in. So two rules control what +kind of file name you must pass various routines: + +=over 4 + +=item Names of files are in local format. + +C<File::Spec> and C<File::Basename> are used for various file +operations. When you're referring to a file on your system, use its +file naming conventions. + +=item Names of archive members are in Unix format. + +This applies to every method that refers to an archive member, or +provides a name for new archive members. The C<extract()> methods +that can take one or two names will convert from local to zip names +if you call them with a single name. + +=back + +=head2 Archive::Zip Object Model + +=head3 Overview + +Archive::Zip::Archive objects are what you ordinarily deal with. +These maintain the structure of a zip file, without necessarily +holding data. When a zip is read from a disk file, the (possibly +compressed) data still lives in the file, not in memory. Archive +members hold information about the individual members, but not +(usually) the actual member data. When the zip is written to a +(different) file, the member data is compressed or copied as needed. +It is possible to make archive members whose data is held in a string +in memory, but this is not done when a zip file is read. Directory +members don't have any data. + +=head2 Inheritance + + Exporter + Archive::Zip Common base class, has defs. + Archive::Zip::Archive A Zip archive. + Archive::Zip::Member Abstract superclass for all members. + Archive::Zip::StringMember Member made from a string + Archive::Zip::FileMember Member made from an external file + Archive::Zip::ZipFileMember Member that lives in a zip file + Archive::Zip::NewFileMember Member whose data is in a file + Archive::Zip::DirectoryMember Member that is a directory + +=head1 EXPORTS + +=over 4 + +=item :CONSTANTS + +Exports the following constants: + +FA_MSDOS FA_UNIX GPBF_ENCRYPTED_MASK +GPBF_DEFLATING_COMPRESSION_MASK GPBF_HAS_DATA_DESCRIPTOR_MASK +COMPRESSION_STORED COMPRESSION_DEFLATED IFA_TEXT_FILE_MASK +IFA_TEXT_FILE IFA_BINARY_FILE COMPRESSION_LEVEL_NONE +COMPRESSION_LEVEL_DEFAULT COMPRESSION_LEVEL_FASTEST +COMPRESSION_LEVEL_BEST_COMPRESSION + +=item :MISC_CONSTANTS + +Exports the following constants (only necessary for extending the +module): + +FA_AMIGA FA_VAX_VMS FA_VM_CMS FA_ATARI_ST FA_OS2_HPFS +FA_MACINTOSH FA_Z_SYSTEM FA_CPM FA_WINDOWS_NTFS +GPBF_IMPLODING_8K_SLIDING_DICTIONARY_MASK +GPBF_IMPLODING_3_SHANNON_FANO_TREES_MASK +GPBF_IS_COMPRESSED_PATCHED_DATA_MASK COMPRESSION_SHRUNK +DEFLATING_COMPRESSION_NORMAL DEFLATING_COMPRESSION_MAXIMUM +DEFLATING_COMPRESSION_FAST DEFLATING_COMPRESSION_SUPER_FAST +COMPRESSION_REDUCED_1 COMPRESSION_REDUCED_2 COMPRESSION_REDUCED_3 +COMPRESSION_REDUCED_4 COMPRESSION_IMPLODED COMPRESSION_TOKENIZED +COMPRESSION_DEFLATED_ENHANCED +COMPRESSION_PKWARE_DATA_COMPRESSION_LIBRARY_IMPLODED + +=item :ERROR_CODES + +Explained below. Returned from most methods. + +AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR + +=back + +=head1 ERROR CODES + +Many of the methods in Archive::Zip return error codes. These are implemented +as inline subroutines, using the C<use constant> pragma. They can be imported +into your namespace using the C<:ERROR_CODES> tag: + + use Archive::Zip qw( :ERROR_CODES ); + + ... + + unless ( $zip->read( 'myfile.zip' ) == AZ_OK ) { + die "whoops!"; + } + +=over 4 + +=item AZ_OK (0) + +Everything is fine. + +=item AZ_STREAM_END (1) + +The read stream (or central directory) ended normally. + +=item AZ_ERROR (2) + +There was some generic kind of error. + +=item AZ_FORMAT_ERROR (3) + +There is a format error in a ZIP file being read. + +=item AZ_IO_ERROR (4) + +There was an IO error. + +=back + +=head2 Compression + +Archive::Zip allows each member of a ZIP file to be compressed (using the +Deflate algorithm) or uncompressed. + +Other compression algorithms that some versions of ZIP have been able to +produce are not supported. Each member has two compression methods: the +one it's stored as (this is always COMPRESSION_STORED for string and external +file members), and the one you desire for the member in the zip file. + +These can be different, of course, so you can make a zip member that is not +compressed out of one that is, and vice versa. + +You can inquire about the current compression and set the desired +compression method: + + my $member = $zip->memberNamed( 'xyz.txt' ); + $member->compressionMethod(); # return current compression + + # set to read uncompressed + $member->desiredCompressionMethod( COMPRESSION_STORED ); + + # set to read compressed + $member->desiredCompressionMethod( COMPRESSION_DEFLATED ); + +There are two different compression methods: + +=over 4 + +=item COMPRESSION_STORED + +File is stored (no compression) + +=item COMPRESSION_DEFLATED + +File is Deflated + +=back + +=head2 Compression Levels + +If a member's desiredCompressionMethod is COMPRESSION_DEFLATED, you +can choose different compression levels. This choice may affect the +speed of compression and decompression, as well as the size of the +compressed member data. + + $member->desiredCompressionLevel( 9 ); + +The levels given can be: + +=over 4 + +=item * 0 or COMPRESSION_LEVEL_NONE + +This is the same as saying + + $member->desiredCompressionMethod( COMPRESSION_STORED ); + +=item * 1 .. 9 + +1 gives the best speed and worst compression, and 9 gives the +best compression and worst speed. + +=item * COMPRESSION_LEVEL_FASTEST + +This is a synonym for level 1. + +=item * COMPRESSION_LEVEL_BEST_COMPRESSION + +This is a synonym for level 9. + +=item * COMPRESSION_LEVEL_DEFAULT + +This gives a good compromise between speed and compression, +and is currently equivalent to 6 (this is in the zlib code). +This is the level that will be used if not specified. + +=back + +=head1 Archive::Zip Methods + +The Archive::Zip class (and its invisible subclass Archive::Zip::Archive) +implement generic zip file functionality. Creating a new Archive::Zip object +actually makes an Archive::Zip::Archive object, but you don't have to worry +about this unless you're subclassing. + +=head2 Constructor + +=over 4 + +=item new( [$fileName] ) + +=item new( { filename => $fileName } ) + +Make a new, empty zip archive. + + my $zip = Archive::Zip->new(); + +If an additional argument is passed, new() will call read() +to read the contents of an archive: + + my $zip = Archive::Zip->new( 'xyz.zip' ); + +If a filename argument is passed and the read fails for any +reason, new will return undef. For this reason, it may be +better to call read separately. + +=back + +=head2 Zip Archive Utility Methods + +These Archive::Zip methods may be called as functions or as object +methods. Do not call them as class methods: + + $zip = Archive::Zip->new(); + $crc = Archive::Zip::computeCRC32( 'ghijkl' ); # OK + $crc = $zip->computeCRC32( 'ghijkl' ); # also OK + $crc = Archive::Zip->computeCRC32( 'ghijkl' ); # NOT OK + +=over 4 + +=item Archive::Zip::computeCRC32( $string [, $crc] ) + +=item Archive::Zip::computeCRC32( { string => $string [, checksum => $crc ] } ) + +This is a utility function that uses the Compress::Raw::Zlib CRC +routine to compute a CRC-32. You can get the CRC of a string: + + $crc = Archive::Zip::computeCRC32( $string ); + +Or you can compute the running CRC: + + $crc = 0; + $crc = Archive::Zip::computeCRC32( 'abcdef', $crc ); + $crc = Archive::Zip::computeCRC32( 'ghijkl', $crc ); + +=item Archive::Zip::setChunkSize( $number ) + +=item Archive::Zip::setChunkSize( { chunkSize => $number } ) + +Report or change chunk size used for reading and writing. +This can make big differences in dealing with large files. +Currently, this defaults to 32K. This also changes the chunk +size used for Compress::Raw::Zlib. You must call setChunkSize() +before reading or writing. This is not exportable, so you +must call it like: + + Archive::Zip::setChunkSize( 4096 ); + +or as a method on a zip (though this is a global setting). +Returns old chunk size. + +=item Archive::Zip::chunkSize() + +Returns the current chunk size: + + my $chunkSize = Archive::Zip::chunkSize(); + +=item Archive::Zip::setErrorHandler( \&subroutine ) + +=item Archive::Zip::setErrorHandler( { subroutine => \&subroutine } ) + +Change the subroutine called with error strings. This +defaults to \&Carp::carp, but you may want to change it to +get the error strings. This is not exportable, so you must +call it like: + + Archive::Zip::setErrorHandler( \&myErrorHandler ); + +If myErrorHandler is undef, resets handler to default. +Returns old error handler. Note that if you call Carp::carp +or a similar routine or if you're chaining to the default +error handler from your error handler, you may want to +increment the number of caller levels that are skipped (do +not just set it to a number): + + $Carp::CarpLevel++; + +=item Archive::Zip::tempFile( [ $tmpdir ] ) + +=item Archive::Zip::tempFile( { tempDir => $tmpdir } ) + +Create a uniquely named temp file. It will be returned open +for read/write. If C<$tmpdir> is given, it is used as the +name of a directory to create the file in. If not given, +creates the file using C<File::Spec::tmpdir()>. Generally, you can +override this choice using the + + $ENV{TMPDIR} + +environment variable. But see the L<File::Spec|File::Spec> +documentation for your system. Note that on many systems, if you're +running in taint mode, then you must make sure that C<$ENV{TMPDIR}> is +untainted for it to be used. +Will I<NOT> create C<$tmpdir> if it does not exist (this is a change +from prior versions!). Returns file handle and name: + + my ($fh, $name) = Archive::Zip::tempFile(); + my ($fh, $name) = Archive::Zip::tempFile('myTempDir'); + my $fh = Archive::Zip::tempFile(); # if you don't need the name + +=back + +=head2 Zip Archive Accessors + +=over 4 + +=item members() + +Return a copy of the members array + + my @members = $zip->members(); + +=item numberOfMembers() + +Return the number of members I have + +=item memberNames() + +Return a list of the (internal) file names of the zip members + +=item memberNamed( $string ) + +=item memberNamed( { zipName => $string } ) + +Return ref to member whose filename equals given filename or +undef. C<$string> must be in Zip (Unix) filename format. + +=item membersMatching( $regex ) + +=item membersMatching( { regex => $regex } ) + +Return array of members whose filenames match given regular +expression in list context. Returns number of matching +members in scalar context. + + my @textFileMembers = $zip->membersMatching( '.*\.txt' ); + # or + my $numberOfTextFiles = $zip->membersMatching( '.*\.txt' ); + +=item diskNumber() + +Return the disk that I start on. Not used for writing zips, +but might be interesting if you read a zip in. This should be +0, as Archive::Zip does not handle multi-volume archives. + +=item diskNumberWithStartOfCentralDirectory() + +Return the disk number that holds the beginning of the +central directory. Not used for writing zips, but might be +interesting if you read a zip in. This should be 0, as +Archive::Zip does not handle multi-volume archives. + +=item numberOfCentralDirectoriesOnThisDisk() + +Return the number of CD structures in the zipfile last read in. +Not used for writing zips, but might be interesting if you read a zip +in. + +=item numberOfCentralDirectories() + +Return the number of CD structures in the zipfile last read in. +Not used for writing zips, but might be interesting if you read a zip +in. + +=item centralDirectorySize() + +Returns central directory size, as read from an external zip +file. Not used for writing zips, but might be interesting if +you read a zip in. + +=item centralDirectoryOffsetWRTStartingDiskNumber() + +Returns the offset into the zip file where the CD begins. Not +used for writing zips, but might be interesting if you read a +zip in. + +=item zipfileComment( [ $string ] ) + +=item zipfileComment( [ { comment => $string } ] ) + +Get or set the zipfile comment. Returns the old comment. + + print $zip->zipfileComment(); + $zip->zipfileComment( 'New Comment' ); + +=item eocdOffset() + +Returns the (unexpected) number of bytes between where the +EOCD was found and where it expected to be. This is normally +0, but would be positive if something (a virus, perhaps) had +added bytes somewhere before the EOCD. Not used for writing +zips, but might be interesting if you read a zip in. Here is +an example of how you can diagnose this: + + my $zip = Archive::Zip->new('somefile.zip'); + if ($zip->eocdOffset()) + { + warn "A virus has added ", $zip->eocdOffset, " bytes of garbage\n"; + } + +The C<eocdOffset()> is used to adjust the starting position of member +headers, if necessary. + +=item fileName() + +Returns the name of the file last read from. If nothing has +been read yet, returns an empty string; if read from a file +handle, returns the handle in string form. + +=back + +=head2 Zip Archive Member Operations + +Various operations on a zip file modify members. When a member is +passed as an argument, you can either use a reference to the member +itself, or the name of a member. Of course, using the name requires +that names be unique within a zip (this is not enforced). + +=over 4 + +=item removeMember( $memberOrName ) + +=item removeMember( { memberOrZipName => $memberOrName } ) + +Remove and return the given member, or match its name and +remove it. Returns undef if member or name does not exist in this +Zip. No-op if member does not belong to this zip. + +=item replaceMember( $memberOrName, $newMember ) + +=item replaceMember( { memberOrZipName => $memberOrName, + newMember => $newMember } ) + +Remove and return the given member, or match its name and +remove it. Replace with new member. Returns undef if member or +name does not exist in this Zip, or if C<$newMember> is undefined. + +It is an (undiagnosed) error to provide a C<$newMember> that is a +member of the zip being modified. + + my $member1 = $zip->removeMember( 'xyz' ); + my $member2 = $zip->replaceMember( 'abc', $member1 ); + # now, $member2 (named 'abc') is not in $zip, + # and $member1 (named 'xyz') is, having taken $member2's place. + +=item extractMember( $memberOrName [, $extractedName ] ) + +=item extractMember( { memberOrZipName => $memberOrName + [, name => $extractedName ] } ) + +Extract the given member, or match its name and extract it. +Returns undef if member does not exist in this Zip. If +optional second arg is given, use it as the name of the +extracted member. Otherwise, the internal filename of the +member is used as the name of the extracted file or +directory. +If you pass C<$extractedName>, it should be in the local file +system's format. +All necessary directories will be created. Returns C<AZ_OK> +on success. + +=item extractMemberWithoutPaths( $memberOrName [, $extractedName ] ) + +=item extractMemberWithoutPaths( { memberOrZipName => $memberOrName + [, name => $extractedName ] } ) + +Extract the given member, or match its name and extract it. +Does not use path information (extracts into the current +directory). Returns undef if member does not exist in this +Zip. +If optional second arg is given, use it as the name of the +extracted member (its paths will be deleted too). Otherwise, +the internal filename of the member (minus paths) is used as +the name of the extracted file or directory. Returns C<AZ_OK> +on success. + +=item addMember( $member ) + +=item addMember( { member => $member } ) + +Append a member (possibly from another zip file) to the zip +file. Returns the new member. Generally, you will use +addFile(), addDirectory(), addFileOrDirectory(), addString(), +or read() to add members. + + # Move member named 'abc' to end of zip: + my $member = $zip->removeMember( 'abc' ); + $zip->addMember( $member ); + +=item updateMember( $memberOrName, $fileName ) + +=item updateMember( { memberOrZipName => $memberOrName, name => $fileName } ) + +Update a single member from the file or directory named C<$fileName>. +Returns the (possibly added or updated) member, if any; C<undef> on +errors. +The comparison is based on C<lastModTime()> and (in the case of a +non-directory) the size of the file. + +=item addFile( $fileName [, $newName, $compressionLevel ] ) + +=item addFile( { filename => $fileName + [, zipName => $newName, compressionLevel => $compressionLevel } ] ) + +Append a member whose data comes from an external file, +returning the member or undef. The member will have its file +name set to the name of the external file, and its +desiredCompressionMethod set to COMPRESSION_DEFLATED. The +file attributes and last modification time will be set from +the file. +If the name given does not represent a readable plain file or +symbolic link, undef will be returned. C<$fileName> must be +in the format required for the local file system. +The optional C<$newName> argument sets the internal file name +to something different than the given $fileName. C<$newName>, +if given, must be in Zip name format (i.e. Unix). +The text mode bit will be set if the contents appears to be +text (as returned by the C<-T> perl operator). + + +I<NOTE> that you should not (generally) use absolute path names +in zip member names, as this will cause problems with some zip +tools as well as introduce a security hole and make the zip +harder to use. + +=item addDirectory( $directoryName [, $fileName ] ) + +=item addDirectory( { directoryName => $directoryName + [, zipName => $fileName ] } ) + + +Append a member created from the given directory name. The +directory name does not have to name an existing directory. +If the named directory exists, the file modification time and +permissions are set from the existing directory, otherwise +they are set to now and permissive default permissions. +C<$directoryName> must be in local file system format. +The optional second argument sets the name of the archive +member (which defaults to C<$directoryName>). If given, it +must be in Zip (Unix) format. +Returns the new member. + +=item addFileOrDirectory( $name [, $newName, $compressionLevel ] ) + +=item addFileOrDirectory( { name => $name [, zipName => $newName, + compressionLevel => $compressionLevel ] } ) + + +Append a member from the file or directory named $name. If +$newName is given, use it for the name of the new member. +Will add or remove trailing slashes from $newName as needed. +C<$name> must be in local file system format. +The optional second argument sets the name of the archive +member (which defaults to C<$name>). If given, it must be in +Zip (Unix) format. + +=item addString( $stringOrStringRef, $name, [$compressionLevel] ) + +=item addString( { string => $stringOrStringRef [, zipName => $name, + compressionLevel => $compressionLevel ] } ) + +Append a member created from the given string or string +reference. The name is given by the second argument. +Returns the new member. The last modification time will be +set to now, and the file attributes will be set to permissive +defaults. + + my $member = $zip->addString( 'This is a test', 'test.txt' ); + +=item contents( $memberOrMemberName [, $newContents ] ) + +=item contents( { memberOrZipName => $memberOrMemberName + [, contents => $newContents ] } ) + + +Returns the uncompressed data for a particular member, or +undef. + + print "xyz.txt contains " . $zip->contents( 'xyz.txt' ); + +Also can change the contents of a member: + + $zip->contents( 'xyz.txt', 'This is the new contents' ); + +If called expecting an array as the return value, it will include +the status as the second value in the array. + + ($content, $status) = $zip->contents( 'xyz.txt'); + +=back + +=head2 Zip Archive I/O operations + + +A Zip archive can be written to a file or file handle, or read from +one. + +=over 4 + +=item writeToFileNamed( $fileName ) + +=item writeToFileNamed( { fileName => $fileName } ) + +Write a zip archive to named file. Returns C<AZ_OK> on +success. + + my $status = $zip->writeToFileNamed( 'xx.zip' ); + die "error somewhere" if $status != AZ_OK; + +Note that if you use the same name as an existing zip file +that you read in, you will clobber ZipFileMembers. So +instead, write to a different file name, then delete the +original. +If you use the C<overwrite()> or C<overwriteAs()> methods, you can +re-write the original zip in this way. +C<$fileName> should be a valid file name on your system. + +=item writeToFileHandle( $fileHandle [, $seekable] ) + +Write a zip archive to a file handle. Return AZ_OK on +success. The optional second arg tells whether or not to try +to seek backwards to re-write headers. If not provided, it is +set if the Perl C<-f> test returns true. This could fail on +some operating systems, though. + + my $fh = IO::File->new( 'someFile.zip', 'w' ); + unless ( $zip->writeToFileHandle( $fh ) == AZ_OK ) { + # error handling + } + +If you pass a file handle that is not seekable (like if +you're writing to a pipe or a socket), pass a false second +argument: + + my $fh = IO::File->new( '| cat > somefile.zip', 'w' ); + $zip->writeToFileHandle( $fh, 0 ); # fh is not seekable + +If this method fails during the write of a member, that +member and all following it will return false from +C<wasWritten()>. See writeCentralDirectory() for a way to +deal with this. +If you want, you can write data to the file handle before +passing it to writeToFileHandle(); this could be used (for +instance) for making self-extracting archives. However, this +only works reliably when writing to a real file (as opposed +to STDOUT or some other possible non-file). + +See examples/selfex.pl for how to write a self-extracting +archive. + +=item writeCentralDirectory( $fileHandle [, $offset ] ) + +=item writeCentralDirectory( { fileHandle => $fileHandle + [, offset => $offset ] } ) + +Writes the central directory structure to the given file +handle. + +Returns AZ_OK on success. If given an $offset, will +seek to that point before writing. This can be used for +recovery in cases where writeToFileHandle or writeToFileNamed +returns an IO error because of running out of space on the +destination file. + +You can truncate the zip by seeking backwards and then writing the +directory: + + my $fh = IO::File->new( 'someFile.zip', 'w' ); + my $retval = $zip->writeToFileHandle( $fh ); + if ( $retval == AZ_IO_ERROR ) { + my @unwritten = grep { not $_->wasWritten() } $zip->members(); + if (@unwritten) { + $zip->removeMember( $member ) foreach my $member ( @unwritten ); + $zip->writeCentralDirectory( $fh, + $unwritten[0]->writeLocalHeaderRelativeOffset()); + } + } + +=item overwriteAs( $newName ) + +=item overwriteAs( { filename => $newName } ) + +Write the zip to the specified file, as safely as possible. +This is done by first writing to a temp file, then renaming +the original if it exists, then renaming the temp file, then +deleting the renamed original if it exists. Returns AZ_OK if +successful. + +=item overwrite() + +Write back to the original zip file. See overwriteAs() above. +If the zip was not ever read from a file, this generates an +error. + +=item read( $fileName ) + +=item read( { filename => $fileName } ) + +Read zipfile headers from a zip file, appending new members. +Returns C<AZ_OK> or error code. + + my $zipFile = Archive::Zip->new(); + my $status = $zipFile->read( '/some/FileName.zip' ); + +=item readFromFileHandle( $fileHandle, $filename ) + +=item readFromFileHandle( { fileHandle => $fileHandle, filename => $filename } ) + +Read zipfile headers from an already-opened file handle, +appending new members. Does not close the file handle. +Returns C<AZ_OK> or error code. Note that this requires a +seekable file handle; reading from a stream is not yet +supported, but using in-memory data is. + + my $fh = IO::File->new( '/some/FileName.zip', 'r' ); + my $zip1 = Archive::Zip->new(); + my $status = $zip1->readFromFileHandle( $fh ); + my $zip2 = Archive::Zip->new(); + $status = $zip2->readFromFileHandle( $fh ); + +Read zip using in-memory data (recursable): + + open my $fh, "<", "archive.zip" or die $!; + my $zip_data = do { local $.; <$fh> }; + my $zip = Archive::Zip->new; + open my $dh, "+<", \$zip_data; + $zip->readFromFileHandle ($dh); + +=back + +=head2 Zip Archive Tree operations + +These used to be in Archive::Zip::Tree but got moved into +Archive::Zip. They enable operation on an entire tree of members or +files. +A usage example: + + use Archive::Zip; + my $zip = Archive::Zip->new(); + + # add all readable files and directories below . as xyz/* + $zip->addTree( '.', 'xyz' ); + + # add all readable plain files below /abc as def/* + $zip->addTree( '/abc', 'def', sub { -f && -r } ); + + # add all .c files below /tmp as stuff/* + $zip->addTreeMatching( '/tmp', 'stuff', '\.c$' ); + + # add all .o files below /tmp as stuff/* if they aren't writable + $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } ); + + # add all .so files below /tmp that are smaller than 200 bytes as stuff/* + $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } ); + + # and write them into a file + $zip->writeToFileNamed('xxx.zip'); + + # now extract the same files into /tmpx + $zip->extractTree( 'stuff', '/tmpx' ); + +=over 4 + +=item $zip->addTree( $root, $dest [, $pred, $compressionLevel ] ) -- Add tree of files to a zip + +=item $zip->addTree( { root => $root, zipName => $dest [, select => $pred, + compressionLevel => $compressionLevel ] ) + +C<$root> is the root of the tree of files and directories to be +added. It is a valid directory name on your system. C<$dest> is +the name for the root in the zip file (undef or blank means +to use relative pathnames). It is a valid ZIP directory name +(that is, it uses forward slashes (/) for separating +directory components). C<$pred> is an optional subroutine +reference to select files: it is passed the name of the +prospective file or directory using C<$_>, and if it returns +true, the file or directory will be included. The default is +to add all readable files and directories. For instance, +using + + my $pred = sub { /\.txt/ }; + $zip->addTree( '.', '', $pred ); + +will add all the .txt files in and below the current +directory, using relative names, and making the names +identical in the zipfile: + + original name zip member name + ./xyz xyz + ./a/ a/ + ./a/b a/b + +To translate absolute to relative pathnames, just pass them +in: $zip->addTree( '/c/d', 'a' ); + + original name zip member name + /c/d/xyz a/xyz + /c/d/a/ a/a/ + /c/d/a/b a/a/b + +Returns AZ_OK on success. Note that this will not follow +symbolic links to directories. Note also that this does not +check for the validity of filenames. + +Note that you generally I<don't> want to make zip archive member names +absolute. + +=item $zip->addTreeMatching( $root, $dest, $pattern [, $pred, $compressionLevel ] ) + +=item $zip->addTreeMatching( { root => $root, zipName => $dest, pattern => + $pattern [, select => $pred, compressionLevel => $compressionLevel ] } ) + +$root is the root of the tree of files and directories to be +added $dest is the name for the root in the zip file (undef +means to use relative pathnames) $pattern is a (non-anchored) +regular expression for filenames to match $pred is an +optional subroutine reference to select files: it is passed +the name of the prospective file or directory in C<$_>, and +if it returns true, the file or directory will be included. +The default is to add all readable files and directories. To +add all files in and below the current directory whose names +end in C<.pl>, and make them extract into a subdirectory +named C<xyz>, do this: + + $zip->addTreeMatching( '.', 'xyz', '\.pl$' ) + +To add all I<writable> files in and below the directory named +C</abc> whose names end in C<.pl>, and make them extract into +a subdirectory named C<xyz>, do this: + + $zip->addTreeMatching( '/abc', 'xyz', '\.pl$', sub { -w } ) + +Returns AZ_OK on success. Note that this will not follow +symbolic links to directories. + +=item $zip->updateTree( $root [, $dest , $pred , $mirror, $compressionLevel ] ); + +=item $zip->updateTree( { root => $root [, zipName => $dest, select => $pred, + mirror => $mirror, compressionLevel => $compressionLevel ] } ); + +Update a zip file from a directory tree. + +C<updateTree()> takes the same arguments as C<addTree()>, but first +checks to see whether the file or directory already exists in the zip +file, and whether it has been changed. + +If the fourth argument C<$mirror> is true, then delete all my members +if corresponding files were not found. + +Returns an error code or AZ_OK if all is well. + +=item $zip->extractTree( [ $root, $dest, $volume } ] ) + +=item $zip->extractTree( [ { root => $root, zipName => $dest, volume => $volume } ] ) + +If you don't give any arguments at all, will extract all the +files in the zip with their original names. + +If you supply one argument for C<$root>, C<extractTree> will extract +all the members whose names start with C<$root> into the current +directory, stripping off C<$root> first. +C<$root> is in Zip (Unix) format. +For instance, + + $zip->extractTree( 'a' ); + +when applied to a zip containing the files: +a/x a/b/c ax/d/e d/e will extract: + +a/x as ./x + +a/b/c as ./b/c + +If you give two arguments, C<extractTree> extracts all the members +whose names start with C<$root>. It will translate C<$root> into +C<$dest> to construct the destination file name. +C<$root> and C<$dest> are in Zip (Unix) format. +For instance, + + $zip->extractTree( 'a', 'd/e' ); + +when applied to a zip containing the files: +a/x a/b/c ax/d/e d/e will extract: + +a/x to d/e/x + +a/b/c to d/e/b/c and ignore ax/d/e and d/e + +If you give three arguments, C<extractTree> extracts all the members +whose names start with C<$root>. It will translate C<$root> into +C<$dest> to construct the destination file name, and then it will +convert to local file system format, using C<$volume> as the name of +the destination volume. + +C<$root> and C<$dest> are in Zip (Unix) format. + +C<$volume> is in local file system format. + +For instance, under Windows, + + $zip->extractTree( 'a', 'd/e', 'f:' ); + +when applied to a zip containing the files: +a/x a/b/c ax/d/e d/e will extract: + +a/x to f:d/e/x + +a/b/c to f:d/e/b/c and ignore ax/d/e and d/e + +If you want absolute paths (the prior example used paths relative to +the current directory on the destination volume, you can specify these +in C<$dest>: + + $zip->extractTree( 'a', '/d/e', 'f:' ); + +when applied to a zip containing the files: +a/x a/b/c ax/d/e d/e will extract: + +a/x to f:\d\e\x + +a/b/c to f:\d\e\b\c and ignore ax/d/e and d/e + +Returns an error code or AZ_OK if everything worked OK. + +=back + +=head1 Archive::Zip Global Variables + +=over 4 + +=item $Archive::Zip::UNICODE + +This variable governs how Unicode file and directory names are added +to or extracted from an archive. If set, file and directory names are considered +to be UTF-8 encoded. This is I<EXPERIMENTAL AND BUGGY (there are some edge cases +on Win32)>. Please report problems. + + { + local $Archive::Zip::UNICODE = 1; + $zip->addFile('Déjà vu.txt'); + } + +=back + +=head1 MEMBER OPERATIONS + +=head2 Member Class Methods + +Several constructors allow you to construct members without adding +them to a zip archive. These work the same as the addFile(), +addDirectory(), and addString() zip instance methods described above, +but they don't add the new members to a zip. + +=over 4 + +=item Archive::Zip::Member->newFromString( $stringOrStringRef [, $fileName ] ) + +=item Archive::Zip::Member->newFromString( { string => $stringOrStringRef + [, zipName => $fileName ] ) + +Construct a new member from the given string. Returns undef +on error. + + my $member = Archive::Zip::Member->newFromString( 'This is a test', + +=item newFromFile( $fileName [, $zipName ] ) + +=item newFromFile( { filename => $fileName [, zipName => $zipName ] } ) + +Construct a new member from the given file. Returns undef on +error. + + my $member = Archive::Zip::Member->newFromFile( 'xyz.txt' ); + +=item newDirectoryNamed( $directoryName [, $zipname ] ) + +=item newDirectoryNamed( { directoryName => $directoryName + [, zipName => $zipname ] } ) + +Construct a new member from the given directory. +C<$directoryName> must be a valid name on your file system; it does not +have to exist. + +If given, C<$zipname> will be the name of the zip member; it must be a +valid Zip (Unix) name. If not given, it will be converted from +C<$directoryName>. + +Returns undef on error. + + my $member = Archive::Zip::Member->newDirectoryNamed( 'CVS/' ); + +=back + +=head2 Member Simple accessors + +These methods get (and/or set) member attribute values. + +=over 4 + +=item versionMadeBy() + +Gets the field from the member header. + +=item fileAttributeFormat( [ $format ] ) + +=item fileAttributeFormat( [ { format => $format ] } ) + +Gets or sets the field from the member header. These are +C<FA_*> values. + +=item versionNeededToExtract() + +Gets the field from the member header. + +=item bitFlag() + +Gets the general purpose bit field from the member header. +This is where the C<GPBF_*> bits live. + +=item compressionMethod() + +Returns the member compression method. This is the method +that is currently being used to compress the member data. +This will be COMPRESSION_STORED for added string or file +members, or any of the C<COMPRESSION_*> values for members +from a zip file. However, this module can only handle members +whose data is in COMPRESSION_STORED or COMPRESSION_DEFLATED +format. + +=item desiredCompressionMethod( [ $method ] ) + +=item desiredCompressionMethod( [ { compressionMethod => $method } ] ) + +Get or set the member's C<desiredCompressionMethod>. This is +the compression method that will be used when the member is +written. Returns prior desiredCompressionMethod. Only +COMPRESSION_DEFLATED or COMPRESSION_STORED are valid +arguments. Changing to COMPRESSION_STORED will change the +member desiredCompressionLevel to 0; changing to +COMPRESSION_DEFLATED will change the member +desiredCompressionLevel to COMPRESSION_LEVEL_DEFAULT. + +=item desiredCompressionLevel( [ $level ] ) + +=item desiredCompressionLevel( [ { compressionLevel => $level } ] ) + +Get or set the member's desiredCompressionLevel This is the +method that will be used to write. Returns prior +desiredCompressionLevel. Valid arguments are 0 through 9, +COMPRESSION_LEVEL_NONE, COMPRESSION_LEVEL_DEFAULT, +COMPRESSION_LEVEL_BEST_COMPRESSION, and +COMPRESSION_LEVEL_FASTEST. 0 or COMPRESSION_LEVEL_NONE will +change the desiredCompressionMethod to COMPRESSION_STORED. +All other arguments will change the desiredCompressionMethod +to COMPRESSION_DEFLATED. + +=item externalFileName() + +Return the member's external file name, if any, or undef. + +=item fileName() + +Get or set the member's internal filename. Returns the +(possibly new) filename. Names will have backslashes +converted to forward slashes, and will have multiple +consecutive slashes converted to single ones. + +=item lastModFileDateTime() + +Return the member's last modification date/time stamp in +MS-DOS format. + +=item lastModTime() + +Return the member's last modification date/time stamp, +converted to unix localtime format. + + print "Mod Time: " . scalar( localtime( $member->lastModTime() ) ); + +=item setLastModFileDateTimeFromUnix() + +Set the member's lastModFileDateTime from the given unix +time. + + $member->setLastModFileDateTimeFromUnix( time() ); + +=item internalFileAttributes() + +Return the internal file attributes field from the zip +header. This is only set for members read from a zip file. + +=item externalFileAttributes() + +Return member attributes as read from the ZIP file. Note that +these are NOT UNIX! + +=item unixFileAttributes( [ $newAttributes ] ) + +=item unixFileAttributes( [ { attributes => $newAttributes } ] ) + +Get or set the member's file attributes using UNIX file +attributes. Returns old attributes. + + my $oldAttribs = $member->unixFileAttributes( 0666 ); + +Note that the return value has more than just the file +permissions, so you will have to mask off the lowest bits for +comparisons. + +=item localExtraField( [ $newField ] ) + +=item localExtraField( [ { field => $newField } ] ) + +Gets or sets the extra field that was read from the local +header. This is not set for a member from a zip file until +after the member has been written out. The extra field must +be in the proper format. + +=item cdExtraField( [ $newField ] ) + +=item cdExtraField( [ { field => $newField } ] ) + +Gets or sets the extra field that was read from the central +directory header. The extra field must be in the proper +format. + +=item extraFields() + +Return both local and CD extra fields, concatenated. + +=item fileComment( [ $newComment ] ) + +=item fileComment( [ { comment => $newComment } ] ) + +Get or set the member's file comment. + +=item hasDataDescriptor() + +Get or set the data descriptor flag. If this is set, the +local header will not necessarily have the correct data +sizes. Instead, a small structure will be stored at the end +of the member data with these values. This should be +transparent in normal operation. + +=item crc32() + +Return the CRC-32 value for this member. This will not be set +for members that were constructed from strings or external +files until after the member has been written. + +=item crc32String() + +Return the CRC-32 value for this member as an 8 character +printable hex string. This will not be set for members that +were constructed from strings or external files until after +the member has been written. + +=item compressedSize() + +Return the compressed size for this member. This will not be +set for members that were constructed from strings or +external files until after the member has been written. + +=item uncompressedSize() + +Return the uncompressed size for this member. + +=item password( [ $password ] ) + +Returns the password for this member to be used on decryption. +If $password is given, it will set the password for the decryption. + +=item isEncrypted() + +Return true if this member is encrypted. The Archive::Zip +module does not currently support creation of encrypted +members. Decryption works more or less like this: + + my $zip = Archive::Zip->new; + $zip->read ("encrypted.zip"); + for my $m (map { $zip->memberNamed ($_) } $zip->memberNames) { + $m->password ("secret"); + $m->contents; # is "" when password was wrong + +That shows that the password has to be set per member, and not per +archive. This might change in the future. + +=item isTextFile( [ $flag ] ) + +=item isTextFile( [ { flag => $flag } ] ) + +Returns true if I am a text file. Also can set the status if +given an argument (then returns old state). Note that this +module does not currently do anything with this flag upon +extraction or storage. That is, bytes are stored in native +format whether or not they came from a text file. + +=item isBinaryFile() + +Returns true if I am a binary file. Also can set the status +if given an argument (then returns old state). Note that this +module does not currently do anything with this flag upon +extraction or storage. That is, bytes are stored in native +format whether or not they came from a text file. + +=item extractToFileNamed( $fileName ) + +=item extractToFileNamed( { name => $fileName } ) + +Extract me to a file with the given name. The file will be +created with default modes. Directories will be created as +needed. +The C<$fileName> argument should be a valid file name on your +file system. +Returns AZ_OK on success. + +=item isDirectory() + +Returns true if I am a directory. + +=item writeLocalHeaderRelativeOffset() + +Returns the file offset in bytes the last time I was written. + +=item wasWritten() + +Returns true if I was successfully written. Reset at the +beginning of a write attempt. + +=back + +=head2 Low-level member data reading + +It is possible to use lower-level routines to access member data +streams, rather than the extract* methods and contents(). For +instance, here is how to print the uncompressed contents of a member +in chunks using these methods: + + my ( $member, $status, $bufferRef ); + $member = $zip->memberNamed( 'xyz.txt' ); + $member->desiredCompressionMethod( COMPRESSION_STORED ); + $status = $member->rewindData(); + die "error $status" unless $status == AZ_OK; + while ( ! $member->readIsDone() ) + { + ( $bufferRef, $status ) = $member->readChunk(); + die "error $status" + if $status != AZ_OK && $status != AZ_STREAM_END; + # do something with $bufferRef: + print $$bufferRef; + } + $member->endRead(); + +=over 4 + +=item readChunk( [ $chunkSize ] ) + +=item readChunk( [ { chunkSize => $chunkSize } ] ) + +This reads the next chunk of given size from the member's +data stream and compresses or uncompresses it as necessary, +returning a reference to the bytes read and a status. If size +argument is not given, defaults to global set by +Archive::Zip::setChunkSize. Status is AZ_OK on success until +the last chunk, where it returns AZ_STREAM_END. Returns C<( +\$bytes, $status)>. + + my ( $outRef, $status ) = $self->readChunk(); + print $$outRef if $status != AZ_OK && $status != AZ_STREAM_END; + +=item rewindData() + +Rewind data and set up for reading data streams or writing +zip files. Can take options for C<inflateInit()> or +C<deflateInit()>, but this is not likely to be necessary. +Subclass overrides should call this method. Returns C<AZ_OK> +on success. + +=item endRead() + +Reset the read variables and free the inflater or deflater. +Must be called to close files, etc. Returns AZ_OK on success. + +=item readIsDone() + +Return true if the read has run out of data or encountered an error. + +=item contents() + +Return the entire uncompressed member data or undef in scalar +context. When called in array context, returns C<( $string, +$status )>; status will be AZ_OK on success: + + my $string = $member->contents(); + # or + my ( $string, $status ) = $member->contents(); + die "error $status" unless $status == AZ_OK; + +Can also be used to set the contents of a member (this may +change the class of the member): + + $member->contents( "this is my new contents" ); + +=item extractToFileHandle( $fh ) + +=item extractToFileHandle( { fileHandle => $fh } ) + +Extract (and uncompress, if necessary) the member's contents +to the given file handle. Return AZ_OK on success. + +=back + +=head1 Archive::Zip::FileMember methods + +The Archive::Zip::FileMember class extends Archive::Zip::Member. It is the +base class for both ZipFileMember and NewFileMember classes. This class adds +an C<externalFileName> and an C<fh> member to keep track of the external +file. + +=over 4 + +=item externalFileName() + +Return the member's external filename. + +=item fh() + +Return the member's read file handle. Automatically opens file if +necessary. + +=back + +=head1 Archive::Zip::ZipFileMember methods + +The Archive::Zip::ZipFileMember class represents members that have been read +from external zip files. + +=over 4 + +=item diskNumberStart() + +Returns the disk number that the member's local header resides in. +Should be 0. + +=item localHeaderRelativeOffset() + +Returns the offset into the zip file where the member's local header +is. + +=item dataOffset() + +Returns the offset from the beginning of the zip file to the member's +data. + +=back + +=head1 REQUIRED MODULES + +L<Archive::Zip> requires several other modules: + +L<Carp> + +L<Compress::Raw::Zlib> + +L<Cwd> + +L<File::Basename> + +L<File::Copy> + +L<File::Find> + +L<File::Path> + +L<File::Spec> + +L<IO::File> + +L<IO::Seekable> + +L<Time::Local> + +=head1 BUGS AND CAVEATS + +=head2 When not to use Archive::Zip + +If you are just going to be extracting zips (and/or other archives) you +are recommended to look at using L<Archive::Extract> instead, as it is much +easier to use and factors out archive-specific functionality. + +=head2 Try to avoid IO::Scalar + +One of the most common ways to use Archive::Zip is to generate Zip files +in-memory. Most people use L<IO::Scalar> for this purpose. + +Unfortunately, as of 1.11 this module no longer works with L<IO::Scalar> +as it incorrectly implements seeking. + +Anybody using L<IO::Scalar> should consider porting to L<IO::String>, +which is smaller, lighter, and is implemented to be perfectly compatible +with regular seekable filehandles. + +Support for L<IO::Scalar> most likely will B<not> be restored in the +future, as L<IO::Scalar> itself cannot change the way it is implemented +due to back-compatibility issues. + +=head2 Wrong password for encrypted members + +When an encrypted member is read using the wrong password, you currently +have to re-read the entire archive to try again with the correct password. + +=head1 TO DO + +* auto-choosing storing vs compression + +* extra field hooks (see notes.txt) + +* check for duplicates on addition/renaming? + +* Text file extraction (line end translation) + +* Reading zip files from non-seekable inputs + (Perhaps by proxying through IO::String?) + +* separate unused constants into separate module + +* cookbook style docs + +* Handle tainted paths correctly + +* Work on better compatibility with other IO:: modules + +* Support encryption + +* More user-friendly decryption + +=head1 SUPPORT + +Bugs should be reported via the CPAN bug tracker + +L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Archive-Zip> + +For other issues contact the maintainer + +=head1 AUTHOR + +Currently maintained by Fred Moyer <fred@redhotpenguin.com> + +Previously maintained by Adam Kennedy <adamk@cpan.org> + +Previously maintained by Steve Peters E<lt>steve@fisharerojo.orgE<gt>. + +File attributes code by Maurice Aubrey E<lt>maurice@lovelyfilth.comE<gt>. + +Originally by Ned Konz E<lt>nedkonz@cpan.orgE<gt>. + +=head1 COPYRIGHT + +Some parts copyright 2006 - 2012 Adam Kennedy. + +Some parts copyright 2005 Steve Peters. + +Original work copyright 2000 - 2004 Ned Konz. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 SEE ALSO + +Look at L<Archive::Zip::MemberRead> which is a wrapper that allows one to +read Zip archive members as if they were files. + +L<Compress::Raw::Zlib>, L<Archive::Tar>, L<Archive::Extract> + +=cut diff --git a/lib/Archive/Zip/Archive.pm b/lib/Archive/Zip/Archive.pm new file mode 100644 index 0000000..323de61 --- /dev/null +++ b/lib/Archive/Zip/Archive.pm @@ -0,0 +1,1020 @@ +package Archive::Zip::Archive; + +# Represents a generic ZIP archive + +use strict; +use File::Path; +use File::Find (); +use File::Spec (); +use File::Copy (); +use File::Basename; +use Cwd; + +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw( Archive::Zip ); + + if ($^O eq 'MSWin32') { + require Win32; + require Encode; + Encode->import(qw{ encode_utf8 decode_utf8 }); + } +} + +use Archive::Zip qw( + :CONSTANTS + :ERROR_CODES + :PKZIP_CONSTANTS + :UTILITY_METHODS +); + +our $UNICODE; + +# Note that this returns undef on read errors, else new zip object. + +sub new { + my $class = shift; + my $self = bless( + { + 'diskNumber' => 0, + 'diskNumberWithStartOfCentralDirectory' => 0, + 'numberOfCentralDirectoriesOnThisDisk' => + 0, # should be # of members + 'numberOfCentralDirectories' => 0, # should be # of members + 'centralDirectorySize' => 0, # must re-compute on write + 'centralDirectoryOffsetWRTStartingDiskNumber' => + 0, # must re-compute + 'writeEOCDOffset' => 0, + 'writeCentralDirectoryOffset' => 0, + 'zipfileComment' => '', + 'eocdOffset' => 0, + 'fileName' => '' + }, + $class + ); + $self->{'members'} = []; + my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; + if ($fileName) { + my $status = $self->read($fileName); + return $status == AZ_OK ? $self : undef; + } + return $self; +} + +sub storeSymbolicLink { + my $self = shift; + $self->{'storeSymbolicLink'} = shift; +} + +sub members { + @{shift->{'members'}}; +} + +sub numberOfMembers { + scalar(shift->members()); +} + +sub memberNames { + my $self = shift; + return map { $_->fileName() } $self->members(); +} + +# return ref to member with given name or undef +sub memberNamed { + my $self = shift; + my $fileName = (ref($_[0]) eq 'HASH') ? shift->{zipName} : shift; + foreach my $member ($self->members()) { + return $member if $member->fileName() eq $fileName; + } + return undef; +} + +sub membersMatching { + my $self = shift; + my $pattern = (ref($_[0]) eq 'HASH') ? shift->{regex} : shift; + return grep { $_->fileName() =~ /$pattern/ } $self->members(); +} + +sub diskNumber { + shift->{'diskNumber'}; +} + +sub diskNumberWithStartOfCentralDirectory { + shift->{'diskNumberWithStartOfCentralDirectory'}; +} + +sub numberOfCentralDirectoriesOnThisDisk { + shift->{'numberOfCentralDirectoriesOnThisDisk'}; +} + +sub numberOfCentralDirectories { + shift->{'numberOfCentralDirectories'}; +} + +sub centralDirectorySize { + shift->{'centralDirectorySize'}; +} + +sub centralDirectoryOffsetWRTStartingDiskNumber { + shift->{'centralDirectoryOffsetWRTStartingDiskNumber'}; +} + +sub zipfileComment { + my $self = shift; + my $comment = $self->{'zipfileComment'}; + if (@_) { + my $new_comment = (ref($_[0]) eq 'HASH') ? shift->{comment} : shift; + $self->{'zipfileComment'} = pack('C0a*', $new_comment); # avoid Unicode + } + return $comment; +} + +sub eocdOffset { + shift->{'eocdOffset'}; +} + +# Return the name of the file last read. +sub fileName { + shift->{'fileName'}; +} + +sub removeMember { + my $self = shift; + my $member = (ref($_[0]) eq 'HASH') ? shift->{memberOrZipName} : shift; + $member = $self->memberNamed($member) unless ref($member); + return undef unless $member; + my @newMembers = grep { $_ != $member } $self->members(); + $self->{'members'} = \@newMembers; + return $member; +} + +sub replaceMember { + my $self = shift; + + my ($oldMember, $newMember); + if (ref($_[0]) eq 'HASH') { + $oldMember = $_[0]->{memberOrZipName}; + $newMember = $_[0]->{newMember}; + } else { + ($oldMember, $newMember) = @_; + } + + $oldMember = $self->memberNamed($oldMember) unless ref($oldMember); + return undef unless $oldMember; + return undef unless $newMember; + my @newMembers = + map { ($_ == $oldMember) ? $newMember : $_ } $self->members(); + $self->{'members'} = \@newMembers; + return $oldMember; +} + +sub extractMember { + my $self = shift; + + my ($member, $name); + if (ref($_[0]) eq 'HASH') { + $member = $_[0]->{memberOrZipName}; + $name = $_[0]->{name}; + } else { + ($member, $name) = @_; + } + + $member = $self->memberNamed($member) unless ref($member); + return _error('member not found') unless $member; + my $originalSize = $member->compressedSize(); + my ($volumeName, $dirName, $fileName); + if (defined($name)) { + ($volumeName, $dirName, $fileName) = File::Spec->splitpath($name); + $dirName = File::Spec->catpath($volumeName, $dirName, ''); + } else { + $name = $member->fileName(); + ($dirName = $name) =~ s{[^/]*$}{}; + $dirName = Archive::Zip::_asLocalName($dirName); + $name = Archive::Zip::_asLocalName($name); + } + if ($dirName && !-d $dirName) { + mkpath($dirName); + return _ioError("can't create dir $dirName") if (!-d $dirName); + } + my $rc = $member->extractToFileNamed($name, @_); + + # TODO refactor this fix into extractToFileNamed() + $member->{'compressedSize'} = $originalSize; + return $rc; +} + +sub extractMemberWithoutPaths { + my $self = shift; + + my ($member, $name); + if (ref($_[0]) eq 'HASH') { + $member = $_[0]->{memberOrZipName}; + $name = $_[0]->{name}; + } else { + ($member, $name) = @_; + } + + $member = $self->memberNamed($member) unless ref($member); + return _error('member not found') unless $member; + my $originalSize = $member->compressedSize(); + return AZ_OK if $member->isDirectory(); + unless ($name) { + $name = $member->fileName(); + $name =~ s{.*/}{}; # strip off directories, if any + $name = Archive::Zip::_asLocalName($name); + } + my $rc = $member->extractToFileNamed($name, @_); + $member->{'compressedSize'} = $originalSize; + return $rc; +} + +sub addMember { + my $self = shift; + my $newMember = (ref($_[0]) eq 'HASH') ? shift->{member} : shift; + push(@{$self->{'members'}}, $newMember) if $newMember; + return $newMember; +} + +sub addFile { + my $self = shift; + + my ($fileName, $newName, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $fileName = $_[0]->{filename}; + $newName = $_[0]->{zipName}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($fileName, $newName, $compressionLevel) = @_; + } + + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $fileName = Win32::GetANSIPathName($fileName); + } + + my $newMember = Archive::Zip::Member->newFromFile($fileName, $newName); + $newMember->desiredCompressionLevel($compressionLevel); + if ($self->{'storeSymbolicLink'} && -l $fileName) { + my $newMember = + Archive::Zip::Member->newFromString(readlink $fileName, $newName); + + # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP + $newMember->{'externalFileAttributes'} = 0xA1FF0000; + $self->addMember($newMember); + } else { + $self->addMember($newMember); + } + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $newMember->{'fileName'} = + encode_utf8(Win32::GetLongPathName($fileName)); + } + return $newMember; +} + +sub addString { + my $self = shift; + + my ($stringOrStringRef, $name, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $stringOrStringRef = $_[0]->{string}; + $name = $_[0]->{zipName}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($stringOrStringRef, $name, $compressionLevel) = @_; + } + + my $newMember = + Archive::Zip::Member->newFromString($stringOrStringRef, $name); + $newMember->desiredCompressionLevel($compressionLevel); + return $self->addMember($newMember); +} + +sub addDirectory { + my $self = shift; + + my ($name, $newName); + if (ref($_[0]) eq 'HASH') { + $name = $_[0]->{directoryName}; + $newName = $_[0]->{zipName}; + } else { + ($name, $newName) = @_; + } + + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $name = Win32::GetANSIPathName($name); + } + + my $newMember = Archive::Zip::Member->newDirectoryNamed($name, $newName); + if ($self->{'storeSymbolicLink'} && -l $name) { + my $link = readlink $name; + ($newName =~ s{/$}{}) if $newName; # Strip trailing / + my $newMember = Archive::Zip::Member->newFromString($link, $newName); + + # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP + $newMember->{'externalFileAttributes'} = 0xA1FF0000; + $self->addMember($newMember); + } else { + $self->addMember($newMember); + } + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $newMember->{'fileName'} = encode_utf8(Win32::GetLongPathName($name)); + } + return $newMember; +} + +# add either a file or a directory. + +sub addFileOrDirectory { + my $self = shift; + + my ($name, $newName, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $name = $_[0]->{name}; + $newName = $_[0]->{zipName}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($name, $newName, $compressionLevel) = @_; + } + + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $name = Win32::GetANSIPathName($name); + } + + $name =~ s{/$}{}; + if ($newName) { + $newName =~ s{/$}{}; + } else { + $newName = $name; + } + if (-f $name) { + return $self->addFile($name, $newName, $compressionLevel); + } elsif (-d $name) { + return $self->addDirectory($name, $newName); + } else { + return _error("$name is neither a file nor a directory"); + } +} + +sub contents { + my $self = shift; + + my ($member, $newContents); + if (ref($_[0]) eq 'HASH') { + $member = $_[0]->{memberOrZipName}; + $newContents = $_[0]->{contents}; + } else { + ($member, $newContents) = @_; + } + + return _error('No member name given') unless $member; + $member = $self->memberNamed($member) unless ref($member); + return undef unless $member; + return $member->contents($newContents); +} + +sub writeToFileNamed { + my $self = shift; + my $fileName = + (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; # local FS format + foreach my $member ($self->members()) { + if ($member->_usesFileNamed($fileName)) { + return _error("$fileName is needed by member " + . $member->fileName() + . "; consider using overwrite() or overwriteAs() instead."); + } + } + my ($status, $fh) = _newFileHandle($fileName, 'w'); + return _ioError("Can't open $fileName for write") unless $status; + my $retval = $self->writeToFileHandle($fh, 1); + $fh->close(); + $fh = undef; + + return $retval; +} + +# It is possible to write data to the FH before calling this, +# perhaps to make a self-extracting archive. +sub writeToFileHandle { + my $self = shift; + + my ($fh, $fhIsSeekable); + if (ref($_[0]) eq 'HASH') { + $fh = $_[0]->{fileHandle}; + $fhIsSeekable = + exists($_[0]->{seek}) ? $_[0]->{seek} : _isSeekable($fh); + } else { + $fh = shift; + $fhIsSeekable = @_ ? shift : _isSeekable($fh); + } + + return _error('No filehandle given') unless $fh; + return _ioError('filehandle not open') unless $fh->opened(); + _binmode($fh); + + # Find out where the current position is. + my $offset = $fhIsSeekable ? $fh->tell() : 0; + $offset = 0 if $offset < 0; + + foreach my $member ($self->members()) { + my $retval = $member->_writeToFileHandle($fh, $fhIsSeekable, $offset); + $member->endRead(); + return $retval if $retval != AZ_OK; + $offset += $member->_localHeaderSize() + $member->_writeOffset(); + $offset += + $member->hasDataDescriptor() + ? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH + : 0; + + # changed this so it reflects the last successful position + $self->{'writeCentralDirectoryOffset'} = $offset; + } + return $self->writeCentralDirectory($fh); +} + +# Write zip back to the original file, +# as safely as possible. +# Returns AZ_OK if successful. +sub overwrite { + my $self = shift; + return $self->overwriteAs($self->{'fileName'}); +} + +# Write zip to the specified file, +# as safely as possible. +# Returns AZ_OK if successful. +sub overwriteAs { + my $self = shift; + my $zipName = (ref($_[0]) eq 'HASH') ? $_[0]->{filename} : shift; + return _error("no filename in overwriteAs()") unless defined($zipName); + + my ($fh, $tempName) = Archive::Zip::tempFile(); + return _error("Can't open temp file", $!) unless $fh; + + (my $backupName = $zipName) =~ s{(\.[^.]*)?$}{.zbk}; + + my $status = $self->writeToFileHandle($fh); + $fh->close(); + $fh = undef; + + if ($status != AZ_OK) { + unlink($tempName); + _printError("Can't write to $tempName"); + return $status; + } + + my $err; + + # rename the zip + if (-f $zipName && !rename($zipName, $backupName)) { + $err = $!; + unlink($tempName); + return _error("Can't rename $zipName as $backupName", $err); + } + + # move the temp to the original name (possibly copying) + unless (File::Copy::move($tempName, $zipName) + || File::Copy::copy($tempName, $zipName)) { + $err = $!; + rename($backupName, $zipName); + unlink($tempName); + return _error("Can't move $tempName to $zipName", $err); + } + + # unlink the backup + if (-f $backupName && !unlink($backupName)) { + $err = $!; + return _error("Can't unlink $backupName", $err); + } + + return AZ_OK; +} + +# Used only during writing +sub _writeCentralDirectoryOffset { + shift->{'writeCentralDirectoryOffset'}; +} + +sub _writeEOCDOffset { + shift->{'writeEOCDOffset'}; +} + +# Expects to have _writeEOCDOffset() set +sub _writeEndOfCentralDirectory { + my ($self, $fh) = @_; + + $self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING) + or return _ioError('writing EOCD Signature'); + my $zipfileCommentLength = length($self->zipfileComment()); + + my $header = pack( + END_OF_CENTRAL_DIRECTORY_FORMAT, + 0, # {'diskNumber'}, + 0, # {'diskNumberWithStartOfCentralDirectory'}, + $self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'}, + $self->numberOfMembers(), # {'numberOfCentralDirectories'}, + $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(), + $self->_writeCentralDirectoryOffset(), + $zipfileCommentLength + ); + $self->_print($fh, $header) + or return _ioError('writing EOCD header'); + if ($zipfileCommentLength) { + $self->_print($fh, $self->zipfileComment()) + or return _ioError('writing zipfile comment'); + } + return AZ_OK; +} + +# $offset can be specified to truncate a zip file. +sub writeCentralDirectory { + my $self = shift; + + my ($fh, $offset); + if (ref($_[0]) eq 'HASH') { + $fh = $_[0]->{fileHandle}; + $offset = $_[0]->{offset}; + } else { + ($fh, $offset) = @_; + } + + if (defined($offset)) { + $self->{'writeCentralDirectoryOffset'} = $offset; + $fh->seek($offset, IO::Seekable::SEEK_SET) + or return _ioError('seeking to write central directory'); + } else { + $offset = $self->_writeCentralDirectoryOffset(); + } + + foreach my $member ($self->members()) { + my $status = $member->_writeCentralDirectoryFileHeader($fh); + return $status if $status != AZ_OK; + $offset += $member->_centralDirectoryHeaderSize(); + $self->{'writeEOCDOffset'} = $offset; + } + return $self->_writeEndOfCentralDirectory($fh); +} + +sub read { + my $self = shift; + my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; + return _error('No filename given') unless $fileName; + my ($status, $fh) = _newFileHandle($fileName, 'r'); + return _ioError("opening $fileName for read") unless $status; + + $status = $self->readFromFileHandle($fh, $fileName); + return $status if $status != AZ_OK; + + $fh->close(); + $self->{'fileName'} = $fileName; + return AZ_OK; +} + +sub readFromFileHandle { + my $self = shift; + + my ($fh, $fileName); + if (ref($_[0]) eq 'HASH') { + $fh = $_[0]->{fileHandle}; + $fileName = $_[0]->{filename}; + } else { + ($fh, $fileName) = @_; + } + + $fileName = $fh unless defined($fileName); + return _error('No filehandle given') unless $fh; + return _ioError('filehandle not open') unless $fh->opened(); + + _binmode($fh); + $self->{'fileName'} = "$fh"; + + # TODO: how to support non-seekable zips? + return _error('file not seekable') + unless _isSeekable($fh); + + $fh->seek(0, 0); # rewind the file + + my $status = $self->_findEndOfCentralDirectory($fh); + return $status if $status != AZ_OK; + + my $eocdPosition = $fh->tell(); + + $status = $self->_readEndOfCentralDirectory($fh); + return $status if $status != AZ_OK; + + $fh->seek($eocdPosition - $self->centralDirectorySize(), + IO::Seekable::SEEK_SET) + or return _ioError("Can't seek $fileName"); + + # Try to detect garbage at beginning of archives + # This should be 0 + $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here + - $self->centralDirectoryOffsetWRTStartingDiskNumber(); + + for (; ;) { + my $newMember = + Archive::Zip::Member->_newFromZipFile($fh, $fileName, + $self->eocdOffset()); + my $signature; + ($status, $signature) = _readSignature($fh, $fileName); + return $status if $status != AZ_OK; + last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE; + $status = $newMember->_readCentralDirectoryFileHeader(); + return $status if $status != AZ_OK; + $status = $newMember->endRead(); + return $status if $status != AZ_OK; + $newMember->_becomeDirectoryIfNecessary(); + push(@{$self->{'members'}}, $newMember); + } + + return AZ_OK; +} + +# Read EOCD, starting from position before signature. +# Return AZ_OK on success. +sub _readEndOfCentralDirectory { + my $self = shift; + my $fh = shift; + + # Skip past signature + $fh->seek(SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR) + or return _ioError("Can't seek past EOCD signature"); + + my $header = ''; + my $bytesRead = $fh->read($header, END_OF_CENTRAL_DIRECTORY_LENGTH); + if ($bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH) { + return _ioError("reading end of central directory"); + } + + my $zipfileCommentLength; + ( + $self->{'diskNumber'}, + $self->{'diskNumberWithStartOfCentralDirectory'}, + $self->{'numberOfCentralDirectoriesOnThisDisk'}, + $self->{'numberOfCentralDirectories'}, + $self->{'centralDirectorySize'}, + $self->{'centralDirectoryOffsetWRTStartingDiskNumber'}, + $zipfileCommentLength + ) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header); + + if ($self->{'diskNumber'} == 0xFFFF || + $self->{'diskNumberWithStartOfCentralDirectory'} == 0xFFFF || + $self->{'numberOfCentralDirectoriesOnThisDisk'} == 0xFFFF || + $self->{'numberOfCentralDirectories'} == 0xFFFF || + $self->{'centralDirectorySize'} == 0xFFFFFFFF || + $self->{'centralDirectoryOffsetWRTStartingDiskNumber'} == 0xFFFFFFFF) { + return _formatError("zip64 not supported" . Dumper($self)); + } +use Data::Dumper; + if ($zipfileCommentLength) { + my $zipfileComment = ''; + $bytesRead = $fh->read($zipfileComment, $zipfileCommentLength); + if ($bytesRead != $zipfileCommentLength) { + return _ioError("reading zipfile comment"); + } + $self->{'zipfileComment'} = $zipfileComment; + } + + return AZ_OK; +} + +# Seek in my file to the end, then read backwards until we find the +# signature of the central directory record. Leave the file positioned right +# before the signature. Returns AZ_OK if success. +sub _findEndOfCentralDirectory { + my $self = shift; + my $fh = shift; + my $data = ''; + $fh->seek(0, IO::Seekable::SEEK_END) + or return _ioError("seeking to end"); + + my $fileLength = $fh->tell(); + if ($fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4) { + return _formatError("file is too short"); + } + + my $seekOffset = 0; + my $pos = -1; + for (; ;) { + $seekOffset += 512; + $seekOffset = $fileLength if ($seekOffset > $fileLength); + $fh->seek(-$seekOffset, IO::Seekable::SEEK_END) + or return _ioError("seek failed"); + my $bytesRead = $fh->read($data, $seekOffset); + if ($bytesRead != $seekOffset) { + return _ioError("read failed"); + } + $pos = rindex($data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING); + last + if ( $pos >= 0 + or $seekOffset == $fileLength + or $seekOffset >= $Archive::Zip::ChunkSize); + } + + if ($pos >= 0) { + $fh->seek($pos - $seekOffset, IO::Seekable::SEEK_CUR) + or return _ioError("seeking to EOCD"); + return AZ_OK; + } else { + return _formatError("can't find EOCD signature"); + } +} + +# Used to avoid taint problems when chdir'ing. +# Not intended to increase security in any way; just intended to shut up the -T +# complaints. If your Cwd module is giving you unreliable returns from cwd() +# you have bigger problems than this. +sub _untaintDir { + my $dir = shift; + $dir =~ m/\A(.+)\z/s; + return $1; +} + +sub addTree { + my $self = shift; + + my ($root, $dest, $pred, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $root = $_[0]->{root}; + $dest = $_[0]->{zipName}; + $pred = $_[0]->{select}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($root, $dest, $pred, $compressionLevel) = @_; + } + + return _error("root arg missing in call to addTree()") + unless defined($root); + $dest = '' unless defined($dest); + $pred = sub { -r } + unless defined($pred); + + my @files; + my $startDir = _untaintDir(cwd()); + + return _error('undef returned by _untaintDir on cwd ', cwd()) + unless $startDir; + + # This avoids chdir'ing in Find, in a way compatible with older + # versions of File::Find. + my $wanted = sub { + local $main::_ = $File::Find::name; + my $dir = _untaintDir($File::Find::dir); + chdir($startDir); + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + push(@files, Win32::GetANSIPathName($File::Find::name)) if (&$pred); + $dir = Win32::GetANSIPathName($dir); + } else { + push(@files, $File::Find::name) if (&$pred); + } + chdir($dir); + }; + + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $root = Win32::GetANSIPathName($root); + } + File::Find::find($wanted, $root); + + my $rootZipName = _asZipDirName($root, 1); # with trailing slash + my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; + + $dest = _asZipDirName($dest, 1); # with trailing slash + + foreach my $fileName (@files) { + my $isDir; + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $isDir = -d Win32::GetANSIPathName($fileName); + } else { + $isDir = -d $fileName; + } + + # normalize, remove leading ./ + my $archiveName = _asZipDirName($fileName, $isDir); + if ($archiveName eq $rootZipName) { $archiveName = $dest } + else { $archiveName =~ s{$pattern}{$dest} } + next if $archiveName =~ m{^\.?/?$}; # skip current dir + my $member = + $isDir + ? $self->addDirectory($fileName, $archiveName) + : $self->addFile($fileName, $archiveName); + $member->desiredCompressionLevel($compressionLevel); + + return _error("add $fileName failed in addTree()") if !$member; + } + return AZ_OK; +} + +sub addTreeMatching { + my $self = shift; + + my ($root, $dest, $pattern, $pred, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $root = $_[0]->{root}; + $dest = $_[0]->{zipName}; + $pattern = $_[0]->{pattern}; + $pred = $_[0]->{select}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($root, $dest, $pattern, $pred, $compressionLevel) = @_; + } + + return _error("root arg missing in call to addTreeMatching()") + unless defined($root); + $dest = '' unless defined($dest); + return _error("pattern missing in call to addTreeMatching()") + unless defined($pattern); + my $matcher = + $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r }; + return $self->addTree($root, $dest, $matcher, $compressionLevel); +} + +# $zip->extractTree( $root, $dest [, $volume] ); +# +# $root and $dest are Unix-style. +# $volume is in local FS format. +# +sub extractTree { + my $self = shift; + + my ($root, $dest, $volume); + if (ref($_[0]) eq 'HASH') { + $root = $_[0]->{root}; + $dest = $_[0]->{zipName}; + $volume = $_[0]->{volume}; + } else { + ($root, $dest, $volume) = @_; + } + + $root = '' unless defined($root); + if (defined $dest) { + if ($dest !~ m{/$}) { + $dest .= '/'; + } + } else { + $dest = './'; + } + + my $pattern = "^\Q$root"; + my @members = $self->membersMatching($pattern); + + foreach my $member (@members) { + my $fileName = $member->fileName(); # in Unix format + $fileName =~ s{$pattern}{$dest}; # in Unix format + # convert to platform format: + $fileName = Archive::Zip::_asLocalName($fileName, $volume); + my $status = $member->extractToFileNamed($fileName); + return $status if $status != AZ_OK; + } + return AZ_OK; +} + +# $zip->updateMember( $memberOrName, $fileName ); +# Returns (possibly updated) member, if any; undef on errors. + +sub updateMember { + my $self = shift; + + my ($oldMember, $fileName); + if (ref($_[0]) eq 'HASH') { + $oldMember = $_[0]->{memberOrZipName}; + $fileName = $_[0]->{name}; + } else { + ($oldMember, $fileName) = @_; + } + + if (!defined($fileName)) { + _error("updateMember(): missing fileName argument"); + return undef; + } + + my @newStat = stat($fileName); + if (!@newStat) { + _ioError("Can't stat $fileName"); + return undef; + } + + my $isDir = -d _; + + my $memberName; + + if (ref($oldMember)) { + $memberName = $oldMember->fileName(); + } else { + $oldMember = $self->memberNamed($memberName = $oldMember) + || $self->memberNamed($memberName = + _asZipDirName($oldMember, $isDir)); + } + + unless (defined($oldMember) + && $oldMember->lastModTime() == $newStat[9] + && $oldMember->isDirectory() == $isDir + && ($isDir || ($oldMember->uncompressedSize() == $newStat[7]))) { + + # create the new member + my $newMember = + $isDir + ? Archive::Zip::Member->newDirectoryNamed($fileName, $memberName) + : Archive::Zip::Member->newFromFile($fileName, $memberName); + + unless (defined($newMember)) { + _error("creation of member $fileName failed in updateMember()"); + return undef; + } + + # replace old member or append new one + if (defined($oldMember)) { + $self->replaceMember($oldMember, $newMember); + } else { + $self->addMember($newMember); + } + + return $newMember; + } + + return $oldMember; +} + +# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] ); +# +# This takes the same arguments as addTree, but first checks to see +# whether the file or directory already exists in the zip file. +# +# If the fourth argument $mirror is true, then delete all my members +# if corresponding files were not found. + +sub updateTree { + my $self = shift; + + my ($root, $dest, $pred, $mirror, $compressionLevel); + if (ref($_[0]) eq 'HASH') { + $root = $_[0]->{root}; + $dest = $_[0]->{zipName}; + $pred = $_[0]->{select}; + $mirror = $_[0]->{mirror}; + $compressionLevel = $_[0]->{compressionLevel}; + } else { + ($root, $dest, $pred, $mirror, $compressionLevel) = @_; + } + + return _error("root arg missing in call to updateTree()") + unless defined($root); + $dest = '' unless defined($dest); + $pred = sub { -r } + unless defined($pred); + + $dest = _asZipDirName($dest, 1); + my $rootZipName = _asZipDirName($root, 1); # with trailing slash + my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; + + my @files; + my $startDir = _untaintDir(cwd()); + + return _error('undef returned by _untaintDir on cwd ', cwd()) + unless $startDir; + + # This avoids chdir'ing in Find, in a way compatible with older + # versions of File::Find. + my $wanted = sub { + local $main::_ = $File::Find::name; + my $dir = _untaintDir($File::Find::dir); + chdir($startDir); + push(@files, $File::Find::name) if (&$pred); + chdir($dir); + }; + + File::Find::find($wanted, $root); + + # Now @files has all the files that I could potentially be adding to + # the zip. Only add the ones that are necessary. + # For each file (updated or not), add its member name to @done. + my %done; + foreach my $fileName (@files) { + my @newStat = stat($fileName); + my $isDir = -d _; + + # normalize, remove leading ./ + my $memberName = _asZipDirName($fileName, $isDir); + if ($memberName eq $rootZipName) { $memberName = $dest } + else { $memberName =~ s{$pattern}{$dest} } + next if $memberName =~ m{^\.?/?$}; # skip current dir + + $done{$memberName} = 1; + my $changedMember = $self->updateMember($memberName, $fileName); + $changedMember->desiredCompressionLevel($compressionLevel); + return _error("updateTree failed to update $fileName") + unless ref($changedMember); + } + + # @done now has the archive names corresponding to all the found files. + # If we're mirroring, delete all those members that aren't in @done. + if ($mirror) { + foreach my $member ($self->members()) { + $self->removeMember($member) + unless $done{$member->fileName()}; + } + } + + return AZ_OK; +} + +1; diff --git a/lib/Archive/Zip/BufferedFileHandle.pm b/lib/Archive/Zip/BufferedFileHandle.pm new file mode 100644 index 0000000..7abc35d --- /dev/null +++ b/lib/Archive/Zip/BufferedFileHandle.pm @@ -0,0 +1,131 @@ +package Archive::Zip::BufferedFileHandle; + +# File handle that uses a string internally and can seek +# This is given as a demo for getting a zip file written +# to a string. +# I probably should just use IO::Scalar instead. +# Ned Konz, March 2000 + +use strict; +use IO::File; +use Carp; + +use vars qw{$VERSION}; + +BEGIN { + $VERSION = '1.49'; + $VERSION = eval $VERSION; +} + +sub new { + my $class = shift || __PACKAGE__; + $class = ref($class) || $class; + my $self = bless( + { + content => '', + position => 0, + size => 0 + }, + $class + ); + return $self; +} + +# Utility method to read entire file +sub readFromFile { + my $self = shift; + my $fileName = shift; + my $fh = IO::File->new($fileName, "r"); + CORE::binmode($fh); + if (!$fh) { + Carp::carp("Can't open $fileName: $!\n"); + return undef; + } + local $/ = undef; + $self->{content} = <$fh>; + $self->{size} = length($self->{content}); + return $self; +} + +sub contents { + my $self = shift; + if (@_) { + $self->{content} = shift; + $self->{size} = length($self->{content}); + } + return $self->{content}; +} + +sub binmode { 1 } + +sub close { 1 } + +sub opened { 1 } + +sub eof { + my $self = shift; + return $self->{position} >= $self->{size}; +} + +sub seek { + my $self = shift; + my $pos = shift; + my $whence = shift; + + # SEEK_SET + if ($whence == 0) { $self->{position} = $pos; } + + # SEEK_CUR + elsif ($whence == 1) { $self->{position} += $pos; } + + # SEEK_END + elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; } + else { return 0; } + + return 1; +} + +sub tell { return shift->{position}; } + +# Copy my data to given buffer +sub read { + my $self = shift; + my $buf = \($_[0]); + shift; + my $len = shift; + my $offset = shift || 0; + + $$buf = '' if not defined($$buf); + my $bytesRead = + ($self->{position} + $len > $self->{size}) + ? ($self->{size} - $self->{position}) + : $len; + substr($$buf, $offset, $bytesRead) = + substr($self->{content}, $self->{position}, $bytesRead); + $self->{position} += $bytesRead; + return $bytesRead; +} + +# Copy given buffer to me +sub write { + my $self = shift; + my $buf = \($_[0]); + shift; + my $len = shift; + my $offset = shift || 0; + + $$buf = '' if not defined($$buf); + my $bufLen = length($$buf); + my $bytesWritten = + ($offset + $len > $bufLen) + ? $bufLen - $offset + : $len; + substr($self->{content}, $self->{position}, $bytesWritten) = + substr($$buf, $offset, $bytesWritten); + $self->{size} = length($self->{content}); + return $bytesWritten; +} + +sub clearerr() { 1 } + +1; diff --git a/lib/Archive/Zip/DirectoryMember.pm b/lib/Archive/Zip/DirectoryMember.pm new file mode 100644 index 0000000..640306b --- /dev/null +++ b/lib/Archive/Zip/DirectoryMember.pm @@ -0,0 +1,80 @@ +package Archive::Zip::DirectoryMember; + +use strict; +use File::Path; + +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw( Archive::Zip::Member ); +} + +use Archive::Zip qw( + :ERROR_CODES + :UTILITY_METHODS +); + +sub _newNamed { + my $class = shift; + my $fileName = shift; # FS name + my $newName = shift; # Zip name + $newName = _asZipDirName($fileName) unless $newName; + my $self = $class->new(@_); + $self->{'externalFileName'} = $fileName; + $self->fileName($newName); + + if (-e $fileName) { + + # -e does NOT do a full stat, so we need to do one now + if (-d _ ) { + my @stat = stat(_); + $self->unixFileAttributes($stat[2]); + my $mod_t = $stat[9]; + if ($^O eq 'MSWin32' and !$mod_t) { + $mod_t = time(); + } + $self->setLastModFileDateTimeFromUnix($mod_t); + + } else { # hmm.. trying to add a non-directory? + _error($fileName, ' exists but is not a directory'); + return undef; + } + } else { + $self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS); + $self->setLastModFileDateTimeFromUnix(time()); + } + return $self; +} + +sub externalFileName { + shift->{'externalFileName'}; +} + +sub isDirectory { + return 1; +} + +sub extractToFileNamed { + my $self = shift; + my $name = shift; # local FS name + my $attribs = $self->unixFileAttributes() & 07777; + mkpath($name, 0, $attribs); # croaks on error + utime($self->lastModTime(), $self->lastModTime(), $name); + return AZ_OK; +} + +sub fileName { + my $self = shift; + my $newName = shift; + $newName =~ s{/?$}{/} if defined($newName); + return $self->SUPER::fileName($newName); +} + +# So people don't get too confused. This way it looks like the problem +# is in their code... +sub contents { + return wantarray ? (undef, AZ_OK) : undef; +} + +1; diff --git a/lib/Archive/Zip/FAQ.pod b/lib/Archive/Zip/FAQ.pod new file mode 100644 index 0000000..d03f883 --- /dev/null +++ b/lib/Archive/Zip/FAQ.pod @@ -0,0 +1,344 @@ +=head1 NAME
+
+Archive::Zip::FAQ - Answers to a few frequently asked questions about Archive::Zip
+
+=head1 DESCRIPTION
+
+It seems that I keep answering the same questions over and over again. I
+assume that this is because my documentation is deficient, rather than that
+people don't read the documentation.
+
+So this FAQ is an attempt to cut down on the number of personal answers I have
+to give. At least I can now say "You I<did> read the FAQ, right?".
+
+The questions are not in any particular order. The answers assume the current
+version of Archive::Zip; some of the answers depend on newly added/fixed
+functionality.
+
+=head1 Install problems on RedHat 8 or 9 with Perl 5.8.0
+
+B<Q:> Archive::Zip won't install on my RedHat 9 system! It's broke!
+
+B<A:> This has become something of a FAQ.
+Basically, RedHat broke some versions of Perl by setting LANG to UTF8.
+They apparently have a fixed version out as an update.
+
+You might try running CPAN or creating your Makefile after exporting the LANG
+environment variable as
+
+C<LANG=C>
+
+L<https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682>
+
+=head1 Why is my zip file so big?
+
+B<Q:> My zip file is actually bigger than what I stored in it! Why?
+
+B<A:> Some things to make sure of:
+
+=over 4
+
+=item Make sure that you are requesting COMPRESSION_DEFLATED if you are storing strings.
+
+$member->desiredCompressionMethod( COMPRESSION_DEFLATED );
+
+=item Don't make lots of little files if you can help it.
+
+Since zip computes the compression tables for each member, small
+members without much entropy won't compress well. Instead, if you've
+got lots of repeated strings in your data, try to combine them into
+one big member.
+
+=item Make sure that you are requesting COMPRESSION_STORED if you are storing things that are already compressed.
+
+If you're storing a .zip, .jpg, .mp3, or other compressed file in a zip,
+then don't compress them again. They'll get bigger.
+
+=back
+
+=head1 Sample code?
+
+B<Q:> Can you send me code to do (whatever)?
+
+B<A:> Have you looked in the C<examples/> directory yet? It contains:
+
+=over 4
+
+=item examples/calcSizes.pl -- How to find out how big a Zip file will be before writing it
+
+=item examples/copy.pl -- Copies one Zip file to another
+
+=item examples/extract.pl -- extract file(s) from a Zip
+
+=item examples/mailZip.pl -- make and mail a zip file
+
+=item examples/mfh.pl -- demo for use of MockFileHandle
+
+=item examples/readScalar.pl -- shows how to use IO::Scalar as the source of a Zip read
+
+=item examples/selfex.pl -- a brief example of a self-extracting Zip
+
+=item examples/unzipAll.pl -- uses Archive::Zip::Tree to unzip an entire Zip
+
+=item examples/updateZip.pl -- shows how to read/modify/write a Zip
+
+=item examples/updateTree.pl -- shows how to update a Zip in place
+
+=item examples/writeScalar.pl -- shows how to use IO::Scalar as the destination of a Zip write
+
+=item examples/writeScalar2.pl -- shows how to use IO::String as the destination of a Zip write
+
+=item examples/zip.pl -- Constructs a Zip file
+
+=item examples/zipcheck.pl -- One way to check a Zip file for validity
+
+=item examples/zipinfo.pl -- Prints out information about a Zip archive file
+
+=item examples/zipGrep.pl -- Searches for text in Zip files
+
+=item examples/ziptest.pl -- Lists a Zip file and checks member CRCs
+
+=item examples/ziprecent.pl -- Puts recent files into a zipfile
+
+=item examples/ziptest.pl -- Another way to check a Zip file for validity
+
+=back
+
+=head1 Can't Read/modify/write same Zip file
+
+B<Q:> Why can't I open a Zip file, add a member, and write it back? I get an
+error message when I try.
+
+B<A:> Because Archive::Zip doesn't (and can't, generally) read file contents into memory,
+the original Zip file is required to stay around until the writing of the new
+file is completed.
+
+The best way to do this is to write the Zip to a temporary file and then
+rename the temporary file to have the old name (possibly after deleting the
+old one).
+
+Archive::Zip v1.02 added the archive methods C<overwrite()> and
+C<overwriteAs()> to do this simply and carefully.
+
+See C<examples/updateZip.pl> for an example of this technique.
+
+=head1 File creation time not set
+
+B<Q:> Upon extracting files, I see that their modification (and access) times are
+set to the time in the Zip archive. However, their creation time is not set to
+the same time. Why?
+
+B<A:> Mostly because Perl doesn't give cross-platform access to I<creation time>.
+Indeed, many systems (like Unix) don't support such a concept.
+However, if yours does, you can easily set it. Get the modification time from
+the member using C<lastModTime()>.
+
+=head1 Can't use Archive::Zip on gzip files
+
+B<Q:> Can I use Archive::Zip to extract Unix gzip files?
+
+B<A:> No.
+
+There is a distinction between Unix gzip files, and Zip archives that
+also can use the gzip compression.
+
+Depending on the format of the gzip file, you can use L<Compress::Raw::Zlib>, or
+L<Archive::Tar> to decompress it (and de-archive it in the case of Tar files).
+
+You can unzip PKZIP/WinZip/etc/ archives using Archive::Zip (that's what
+it's for) as long as any compressed members are compressed using
+Deflate compression.
+
+=head1 Add a directory/tree to a Zip
+
+B<Q:> How can I add a directory (or tree) full of files to a Zip?
+
+B<A:> You can use the Archive::Zip::addTree*() methods:
+
+ use Archive::Zip;
+ my $zip = Archive::Zip->new();
+ # add all readable files and directories below . as xyz/*
+ $zip->addTree( '.', 'xyz' );
+ # add all readable plain files below /abc as def/*
+ $zip->addTree( '/abc', 'def', sub { -f && -r } );
+ # add all .c files below /tmp as stuff/*
+ $zip->addTreeMatching( '/tmp', 'stuff', '\.c$' );
+ # add all .o files below /tmp as stuff/* if they aren't writable
+ $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } );
+ # add all .so files below /tmp that are smaller than 200 bytes as stuff/*
+ $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } );
+ # and write them into a file
+ $zip->writeToFileNamed('xxx.zip');
+
+=head1 Extract a directory/tree
+
+B<Q:> How can I extract some (or all) files from a Zip into a different
+directory?
+
+B<A:> You can use the Archive::Zip::extractTree() method:
+??? ||
+
+ # now extract the same files into /tmpx
+ $zip->extractTree( 'stuff', '/tmpx' );
+
+=head1 Update a directory/tree
+
+B<Q:> How can I update a Zip from a directory tree, adding or replacing only
+the newer files?
+
+B<A:> You can use the Archive::Zip::updateTree() method that was added in version 1.09.
+
+=head1 Zip times might be off by 1 second
+
+B<Q:> It bothers me greatly that my file times are wrong by one second about half
+the time. Why don't you do something about it?
+
+B<A:> Get over it. This is a result of the Zip format storing times in DOS
+format, which has a resolution of only two seconds.
+
+=head1 Zip times don't include time zone information
+
+B<Q:> My file times don't respect time zones. What gives?
+
+B<A:> If this is important to you, please submit patches to read the various
+Extra Fields that encode times with time zones. I'm just using the DOS
+Date/Time, which doesn't have a time zone.
+
+=head1 How do I make a self-extracting Zip
+
+B<Q:> I want to make a self-extracting Zip file. Can I do this?
+
+B<A:> Yes. You can write a self-extracting archive stub (that is, a version of
+unzip) to the output filehandle that you pass to writeToFileHandle(). See
+examples/selfex.pl for how to write a self-extracting archive.
+
+However, you should understand that this will only work on one kind of
+platform (the one for which the stub was compiled).
+
+=head1 How can I deal with Zips with prepended garbage (i.e. from Sircam)
+
+B<Q:> How can I tell if a Zip has been damaged by adding garbage to the
+beginning or inside the file?
+
+B<A:> I added code for this for the Amavis virus scanner. You can query archives
+for their 'eocdOffset' property, which should be 0:
+
+ if ($zip->eocdOffset > 0)
+ { warn($zip->eocdOffset . " bytes of garbage at beginning or within Zip") }
+
+When members are extracted, this offset will be used to adjust the start of
+the member if necessary.
+
+=head1 Can't extract Shrunk files
+
+B<Q:> I'm trying to extract a file out of a Zip produced by PKZIP, and keep
+getting this error message:
+
+ error: Unsupported compression combination: read 6, write 0
+
+B<A:> You can't uncompress this archive member. Archive::Zip only supports uncompressed
+members, and compressed members that are compressed using the compression
+supported by Compress::Raw::Zlib. That means only Deflated and Stored members.
+
+Your file is compressed using the Shrink format, which is not supported by
+Compress::Raw::Zlib.
+
+You could, perhaps, use a command-line UnZip program (like the Info-Zip
+one) to extract this.
+
+=head1 Can't do decryption
+
+B<Q:> How do I decrypt encrypted Zip members?
+
+B<A:> With some other program or library. Archive::Zip doesn't support decryption,
+and probably never will (unless I<you> write it).
+
+=head1 How to test file integrity?
+
+B<Q:> How can Archive::Zip can test the validity of a Zip file?
+
+B<A:> If you try to decompress the file, the gzip streams will report errors
+if you have garbage. Most of the time.
+
+If you try to open the file and a central directory structure can't be
+found, an error will be reported.
+
+When a file is being read, if we can't find a proper PK.. signature in
+the right places we report a format error.
+
+If there is added garbage at the beginning of a Zip file (as inserted
+by some viruses), you can find out about it, but Archive::Zip will ignore it,
+and you can still use the archive. When it gets written back out the
+added stuff will be gone.
+
+There are two ready-to-use utilities in the examples directory that can
+be used to test file integrity, or that you can use as examples
+for your own code:
+
+=over 4
+
+=item examples/zipcheck.pl shows how to use an attempted extraction to test a file.
+
+=item examples/ziptest.pl shows how to test CRCs in a file.
+
+=back
+
+=head1 Duplicate files in Zip?
+
+B<Q:> Archive::Zip let me put the same file in my Zip twice! Why don't you prevent this?
+
+B<A:> As far as I can tell, this is not disallowed by the Zip spec. If you
+think it's a bad idea, check for it yourself:
+
+ $zip->addFile($someFile, $someName) unless $zip->memberNamed($someName);
+
+I can even imagine cases where this might be useful (for instance, multiple
+versions of files).
+
+=head1 File ownership/permissions/ACLS/etc
+
+B<Q:> Why doesn't Archive::Zip deal with file ownership, ACLs, etc.?
+
+B<A:> There is no standard way to represent these in the Zip file format. If
+you want to send me code to properly handle the various extra fields that
+have been used to represent these through the years, I'll look at it.
+
+=head1 I can't compile but ActiveState only has an old version of Archive::Zip
+
+B<Q:> I've only installed modules using ActiveState's PPM program and
+repository. But they have a much older version of Archive::Zip than is in CPAN. Will
+you send me a newer PPM?
+
+B<A:> Probably not, unless I get lots of extra time. But there's no reason you
+can't install the version from CPAN. Archive::Zip is pure Perl, so all you need is
+NMAKE, which you can get for free from Microsoft (see the FAQ in the
+ActiveState documentation for details on how to install CPAN modules).
+
+=head1 My JPEGs (or MP3's) don't compress when I put them into Zips!
+
+B<Q:> How come my JPEGs and MP3's don't compress much when I put them into Zips?
+
+B<A:> Because they're already compressed.
+
+=head1 Under Windows, things lock up/get damaged
+
+B<Q:> I'm using Windows. When I try to use Archive::Zip, my machine locks up/makes
+funny sounds/displays a BSOD/corrupts data. How can I fix this?
+
+B<A:> First, try the newest version of Compress::Raw::Zlib. I know of
+Windows-related problems prior to v1.14 of that library.
+
+=head1 Zip contents in a scalar
+
+B<Q:> I want to read a Zip file from (or write one to) a scalar variable instead
+of a file. How can I do this?
+
+B<A:> Use C<IO::String> and the C<readFromFileHandle()> and
+C<writeToFileHandle()> methods.
+See C<examples/readScalar.pl> and C<examples/writeScalar.pl>.
+
+=head1 Reading from streams
+
+B<Q:> How do I read from a stream (like for the Info-Zip C<funzip> program)?
+
+B<A:> This is not currently supported, though writing to a stream is.
diff --git a/lib/Archive/Zip/FileMember.pm b/lib/Archive/Zip/FileMember.pm new file mode 100644 index 0000000..5f1066e --- /dev/null +++ b/lib/Archive/Zip/FileMember.pm @@ -0,0 +1,64 @@ +package Archive::Zip::FileMember; + +use strict; +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw ( Archive::Zip::Member ); +} + +use Archive::Zip qw( + :UTILITY_METHODS +); + +sub externalFileName { + shift->{'externalFileName'}; +} + +# Return true if I depend on the named file +sub _usesFileNamed { + my $self = shift; + my $fileName = shift; + my $xfn = $self->externalFileName(); + return undef if ref($xfn); + return $xfn eq $fileName; +} + +sub fh { + my $self = shift; + $self->_openFile() + if !defined($self->{'fh'}) || !$self->{'fh'}->opened(); + return $self->{'fh'}; +} + +# opens my file handle from my file name +sub _openFile { + my $self = shift; + my ($status, $fh) = _newFileHandle($self->externalFileName(), 'r'); + if (!$status) { + _ioError("Can't open", $self->externalFileName()); + return undef; + } + $self->{'fh'} = $fh; + _binmode($fh); + return $fh; +} + +# Make sure I close my file handle +sub endRead { + my $self = shift; + undef $self->{'fh'}; # _closeFile(); + return $self->SUPER::endRead(@_); +} + +sub _become { + my $self = shift; + my $newClass = shift; + return $self if ref($self) eq $newClass; + delete($self->{'externalFileName'}); + delete($self->{'fh'}); + return $self->SUPER::_become($newClass); +} + +1; diff --git a/lib/Archive/Zip/Member.pm b/lib/Archive/Zip/Member.pm new file mode 100644 index 0000000..0026aa6 --- /dev/null +++ b/lib/Archive/Zip/Member.pm @@ -0,0 +1,1247 @@ +package Archive::Zip::Member; + +# A generic member of an archive + +use strict; +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw( Archive::Zip ); + + if ($^O eq 'MSWin32') { + require Win32; + require Encode; + Encode->import(qw{ decode_utf8 }); + } +} + +use Archive::Zip qw( + :CONSTANTS + :MISC_CONSTANTS + :ERROR_CODES + :PKZIP_CONSTANTS + :UTILITY_METHODS +); + +use Time::Local (); +use Compress::Raw::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS ); +use File::Path; +use File::Basename; + +# Unix perms for default creation of files/dirs. +use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755; +use constant DEFAULT_FILE_PERMISSIONS => 0100666; +use constant DIRECTORY_ATTRIB => 040000; +use constant FILE_ATTRIB => 0100000; + +# Returns self if successful, else undef +# Assumes that fh is positioned at beginning of central directory file header. +# Leaves fh positioned immediately after file header or EOCD signature. +sub _newFromZipFile { + my $class = shift; + my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_); + return $self; +} + +sub newFromString { + my $class = shift; + + my ($stringOrStringRef, $fileName); + if (ref($_[0]) eq 'HASH') { + $stringOrStringRef = $_[0]->{string}; + $fileName = $_[0]->{zipName}; + } else { + ($stringOrStringRef, $fileName) = @_; + } + + my $self = + Archive::Zip::StringMember->_newFromString($stringOrStringRef, $fileName); + return $self; +} + +sub newFromFile { + my $class = shift; + + my ($fileName, $zipName); + if (ref($_[0]) eq 'HASH') { + $fileName = $_[0]->{fileName}; + $zipName = $_[0]->{zipName}; + } else { + ($fileName, $zipName) = @_; + } + + my $self = + Archive::Zip::NewFileMember->_newFromFileNamed($fileName, $zipName); + return $self; +} + +sub newDirectoryNamed { + my $class = shift; + + my ($directoryName, $newName); + if (ref($_[0]) eq 'HASH') { + $directoryName = $_[0]->{directoryName}; + $newName = $_[0]->{zipName}; + } else { + ($directoryName, $newName) = @_; + } + + my $self = + Archive::Zip::DirectoryMember->_newNamed($directoryName, $newName); + return $self; +} + +sub new { + my $class = shift; + my $self = { + 'lastModFileDateTime' => 0, + 'fileAttributeFormat' => FA_UNIX, + 'versionMadeBy' => 20, + 'versionNeededToExtract' => 20, + 'bitFlag' => ($Archive::Zip::UNICODE ? 0x0800 : 0), + 'compressionMethod' => COMPRESSION_STORED, + 'desiredCompressionMethod' => COMPRESSION_STORED, + 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE, + 'internalFileAttributes' => 0, + 'externalFileAttributes' => 0, # set later + 'fileName' => '', + 'cdExtraField' => '', + 'localExtraField' => '', + 'fileComment' => '', + 'crc32' => 0, + 'compressedSize' => 0, + 'uncompressedSize' => 0, + 'isSymbolicLink' => 0, + 'password' => undef, # password for encrypted data + 'crc32c' => -1, # crc for decrypted data + @_ + }; + bless($self, $class); + $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS); + return $self; +} + +sub _becomeDirectoryIfNecessary { + my $self = shift; + $self->_become('Archive::Zip::DirectoryMember') + if $self->isDirectory(); + return $self; +} + +# Morph into given class (do whatever cleanup I need to do) +sub _become { + return bless($_[0], $_[1]); +} + +sub versionMadeBy { + shift->{'versionMadeBy'}; +} + +sub fileAttributeFormat { + my $self = shift; + + if (@_) { + $self->{fileAttributeFormat} = + (ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0]; + } else { + return $self->{fileAttributeFormat}; + } +} + +sub versionNeededToExtract { + shift->{'versionNeededToExtract'}; +} + +sub bitFlag { + my $self = shift; + +# Set General Purpose Bit Flags according to the desiredCompressionLevel setting + if ( $self->desiredCompressionLevel == 1 + || $self->desiredCompressionLevel == 2) { + $self->{'bitFlag'} |= DEFLATING_COMPRESSION_FAST; + } elsif ($self->desiredCompressionLevel == 3 + || $self->desiredCompressionLevel == 4 + || $self->desiredCompressionLevel == 5 + || $self->desiredCompressionLevel == 6 + || $self->desiredCompressionLevel == 7) { + $self->{'bitFlag'} |= DEFLATING_COMPRESSION_NORMAL; + } elsif ($self->desiredCompressionLevel == 8 + || $self->desiredCompressionLevel == 9) { + $self->{'bitFlag'} |= DEFLATING_COMPRESSION_MAXIMUM; + } + + if ($Archive::Zip::UNICODE) { + $self->{'bitFlag'} |= 0x0800; + } + $self->{'bitFlag'}; +} + +sub password { + my $self = shift; + $self->{'password'} = shift if @_; + $self->{'password'}; +} + +sub compressionMethod { + shift->{'compressionMethod'}; +} + +sub desiredCompressionMethod { + my $self = shift; + my $newDesiredCompressionMethod = + (ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift; + my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'}; + if (defined($newDesiredCompressionMethod)) { + $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod; + if ($newDesiredCompressionMethod == COMPRESSION_STORED) { + $self->{'desiredCompressionLevel'} = 0; + $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK + if $self->uncompressedSize() == 0; + } elsif ($oldDesiredCompressionMethod == COMPRESSION_STORED) { + $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT; + } + } + return $oldDesiredCompressionMethod; +} + +sub desiredCompressionLevel { + my $self = shift; + my $newDesiredCompressionLevel = + (ref($_[0]) eq 'HASH') ? shift->{compressionLevel} : shift; + my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'}; + if (defined($newDesiredCompressionLevel)) { + $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel; + $self->{'desiredCompressionMethod'} = ( + $newDesiredCompressionLevel + ? COMPRESSION_DEFLATED + : COMPRESSION_STORED + ); + } + return $oldDesiredCompressionLevel; +} + +sub fileName { + my $self = shift; + my $newName = shift; + if (defined $newName) { + $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems + $self->{'fileName'} = $newName; + } + return $self->{'fileName'}; +} + +sub lastModFileDateTime { + my $modTime = shift->{'lastModFileDateTime'}; + $modTime =~ m/^(\d+)$/; # untaint + return $1; +} + +sub lastModTime { + my $self = shift; + return _dosToUnixTime($self->lastModFileDateTime()); +} + +sub setLastModFileDateTimeFromUnix { + my $self = shift; + my $time_t = shift; + $self->{'lastModFileDateTime'} = _unixToDosTime($time_t); +} + +sub internalFileAttributes { + shift->{'internalFileAttributes'}; +} + +sub externalFileAttributes { + shift->{'externalFileAttributes'}; +} + +# Convert UNIX permissions into proper value for zip file +# Usable as a function or a method +sub _mapPermissionsFromUnix { + my $self = shift; + my $mode = shift; + my $attribs = $mode << 16; + + # Microsoft Windows Explorer needs this bit set for directories + if ($mode & DIRECTORY_ATTRIB) { + $attribs |= 16; + } + + return $attribs; + + # TODO: map more MS-DOS perms +} + +# Convert ZIP permissions into Unix ones +# +# This was taken from Info-ZIP group's portable UnZip +# zipfile-extraction program, version 5.50. +# http://www.info-zip.org/pub/infozip/ +# +# See the mapattr() function in unix/unix.c +# See the attribute format constants in unzpriv.h +# +# XXX Note that there's one situation that is not implemented +# yet that depends on the "extra field." +sub _mapPermissionsToUnix { + my $self = shift; + + my $format = $self->{'fileAttributeFormat'}; + my $attribs = $self->{'externalFileAttributes'}; + + my $mode = 0; + + if ($format == FA_AMIGA) { + $attribs = $attribs >> 17 & 7; # Amiga RWE bits + $mode = $attribs << 6 | $attribs << 3 | $attribs; + return $mode; + } + + if ($format == FA_THEOS) { + $attribs &= 0xF1FFFFFF; + if (($attribs & 0xF0000000) != 0x40000000) { + $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits + } else { + $attribs &= 0x41FFFFFF; # leave directory bit as set + } + } + + if ( $format == FA_UNIX + || $format == FA_VAX_VMS + || $format == FA_ACORN + || $format == FA_ATARI_ST + || $format == FA_BEOS + || $format == FA_QDOS + || $format == FA_TANDEM) { + $mode = $attribs >> 16; + return $mode if $mode != 0 or not $self->localExtraField; + + # warn("local extra field is: ", $self->localExtraField, "\n"); + + # XXX This condition is not implemented + # I'm just including the comments from the info-zip section for now. + + # Some (non-Info-ZIP) implementations of Zip for Unix and + # VMS (and probably others ??) leave 0 in the upper 16-bit + # part of the external_file_attributes field. Instead, they + # store file permission attributes in some extra field. + # As a work-around, we search for the presence of one of + # these extra fields and fall back to the MSDOS compatible + # part of external_file_attributes if one of the known + # e.f. types has been detected. + # Later, we might implement extraction of the permission + # bits from the VMS extra field. But for now, the work-around + # should be sufficient to provide "readable" extracted files. + # (For ASI Unix e.f., an experimental remap from the e.f. + # mode value IS already provided!) + } + + # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the + # Unix attributes in the upper 16 bits of the external attributes + # field, just like Info-ZIP's Zip for Unix. We try to use that + # value, after a check for consistency with the MSDOS attribute + # bits (see below). + if ($format == FA_MSDOS) { + $mode = $attribs >> 16; + } + + # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20 + $attribs = !($attribs & 1) << 1 | ($attribs & 0x10) >> 4; + + # keep previous $mode setting when its "owner" + # part appears to be consistent with DOS attribute flags! + return $mode if ($mode & 0700) == (0400 | $attribs << 6); + $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs; + return $mode; +} + +sub unixFileAttributes { + my $self = shift; + my $oldPerms = $self->_mapPermissionsToUnix; + + my $perms; + if (@_) { + $perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0]; + + if ($self->isDirectory) { + $perms &= ~FILE_ATTRIB; + $perms |= DIRECTORY_ATTRIB; + } else { + $perms &= ~DIRECTORY_ATTRIB; + $perms |= FILE_ATTRIB; + } + $self->{externalFileAttributes} = + $self->_mapPermissionsFromUnix($perms); + } + + return $oldPerms; +} + +sub localExtraField { + my $self = shift; + + if (@_) { + $self->{localExtraField} = + (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; + } else { + return $self->{localExtraField}; + } +} + +sub cdExtraField { + my $self = shift; + + if (@_) { + $self->{cdExtraField} = (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; + } else { + return $self->{cdExtraField}; + } +} + +sub extraFields { + my $self = shift; + return $self->localExtraField() . $self->cdExtraField(); +} + +sub fileComment { + my $self = shift; + + if (@_) { + $self->{fileComment} = + (ref($_[0]) eq 'HASH') + ? pack('C0a*', $_[0]->{comment}) + : pack('C0a*', $_[0]); + } else { + return $self->{fileComment}; + } +} + +sub hasDataDescriptor { + my $self = shift; + if (@_) { + my $shouldHave = shift; + if ($shouldHave) { + $self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK; + } else { + $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK; + } + } + return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK; +} + +sub crc32 { + shift->{'crc32'}; +} + +sub crc32String { + sprintf("%08x", shift->{'crc32'}); +} + +sub compressedSize { + shift->{'compressedSize'}; +} + +sub uncompressedSize { + shift->{'uncompressedSize'}; +} + +sub isEncrypted { + shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK; +} + +sub isTextFile { + my $self = shift; + my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; + if (@_) { + my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift; + $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; + $self->{'internalFileAttributes'} |= + ($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE); + } + return $bit == IFA_TEXT_FILE; +} + +sub isBinaryFile { + my $self = shift; + my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; + if (@_) { + my $flag = shift; + $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; + $self->{'internalFileAttributes'} |= + ($flag ? IFA_BINARY_FILE : IFA_TEXT_FILE); + } + return $bit == IFA_BINARY_FILE; +} + +sub extractToFileNamed { + my $self = shift; + + # local FS name + my $name = (ref($_[0]) eq 'HASH') ? $_[0]->{name} : $_[0]; + $self->{'isSymbolicLink'} = 0; + + # Check if the file / directory is a symbolic link or not + if ($self->{'externalFileAttributes'} == 0xA1FF0000) { + $self->{'isSymbolicLink'} = 1; + $self->{'newName'} = $name; + my ($status, $fh) = _newFileHandle($name, 'r'); + my $retval = $self->extractToFileHandle($fh); + $fh->close(); + } else { + + #return _writeSymbolicLink($self, $name) if $self->isSymbolicLink(); + + my ($status, $fh); + if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { + $name = decode_utf8(Win32::GetFullPathName($name)); + mkpath_win32($name); + Win32::CreateFile($name); + ($status, $fh) = _newFileHandle(Win32::GetANSIPathName($name), 'w'); + } else { + mkpath(dirname($name)); # croaks on error + ($status, $fh) = _newFileHandle($name, 'w'); + } + return _ioError("Can't open file $name for write") unless $status; + my $retval = $self->extractToFileHandle($fh); + $fh->close(); + chmod($self->unixFileAttributes(), $name) + or return _error("Can't chmod() ${name}: $!"); + utime($self->lastModTime(), $self->lastModTime(), $name); + return $retval; + } +} + +sub mkpath_win32 { + my $path = shift; + use File::Spec; + + my ($volume, @path) = File::Spec->splitdir($path); + $path = File::Spec->catfile($volume, shift @path); + pop @path; + while (@path) { + $path = File::Spec->catfile($path, shift @path); + Win32::CreateDirectory($path); + } +} + +sub _writeSymbolicLink { + my $self = shift; + my $name = shift; + my $chunkSize = $Archive::Zip::ChunkSize; + + #my ( $outRef, undef ) = $self->readChunk($chunkSize); + my $fh; + my $retval = $self->extractToFileHandle($fh); + my ($outRef, undef) = $self->readChunk(100); +} + +sub isSymbolicLink { + my $self = shift; + if ($self->{'externalFileAttributes'} == 0xA1FF0000) { + $self->{'isSymbolicLink'} = 1; + } else { + return 0; + } + 1; +} + +sub isDirectory { + return 0; +} + +sub externalFileName { + return undef; +} + +# The following are used when copying data +sub _writeOffset { + shift->{'writeOffset'}; +} + +sub _readOffset { + shift->{'readOffset'}; +} + +sub writeLocalHeaderRelativeOffset { + shift->{'writeLocalHeaderRelativeOffset'}; +} + +sub wasWritten { shift->{'wasWritten'} } + +sub _dataEnded { + shift->{'dataEnded'}; +} + +sub _readDataRemaining { + shift->{'readDataRemaining'}; +} + +sub _inflater { + shift->{'inflater'}; +} + +sub _deflater { + shift->{'deflater'}; +} + +# Return the total size of my local header +sub _localHeaderSize { + my $self = shift; + { + use bytes; + return SIGNATURE_LENGTH + + LOCAL_FILE_HEADER_LENGTH + + length($self->fileName()) + + length($self->localExtraField()); + } +} + +# Return the total size of my CD header +sub _centralDirectoryHeaderSize { + my $self = shift; + { + use bytes; + return SIGNATURE_LENGTH + + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH + + length($self->fileName()) + + length($self->cdExtraField()) + + length($self->fileComment()); + } +} + +# DOS date/time format +# 0-4 (5) Second divided by 2 +# 5-10 (6) Minute (0-59) +# 11-15 (5) Hour (0-23 on a 24-hour clock) +# 16-20 (5) Day of the month (1-31) +# 21-24 (4) Month (1 = January, 2 = February, etc.) +# 25-31 (7) Year offset from 1980 (add 1980 to get actual year) + +# Convert DOS date/time format to unix time_t format +# NOT AN OBJECT METHOD! +sub _dosToUnixTime { + my $dt = shift; + return time() unless defined($dt); + + 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); + + # catch errors + my $time_t = + eval { Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year); }; + return time() if ($@); + return $time_t; +} + +# Note, this is not exactly UTC 1980, it's 1980 + 12 hours and 1 +# minute so that nothing timezoney can muck us up. +my $safe_epoch = 315576060; + +# convert a unix time to DOS date/time +# NOT AN OBJECT METHOD! +sub _unixToDosTime { + my $time_t = shift; + unless ($time_t) { + _error("Tried to add member with zero or undef value for time"); + $time_t = $safe_epoch; + } + if ($time_t < $safe_epoch) { + _ioError("Unsupported date before 1980 encountered, moving to 1980"); + $time_t = $safe_epoch; + } + my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time_t); + my $dt = 0; + $dt += ($sec >> 1); + $dt += ($min << 5); + $dt += ($hour << 11); + $dt += ($mday << 16); + $dt += (($mon + 1) << 21); + $dt += (($year - 80) << 25); + return $dt; +} + +sub head { + my ($self, $mode) = (@_, 0); + + use bytes; + return pack LOCAL_FILE_HEADER_FORMAT, + $self->versionNeededToExtract(), + $self->{'bitFlag'}, + $self->desiredCompressionMethod(), + $self->lastModFileDateTime(), + $self->hasDataDescriptor() + ? (0,0,0) # crc, compr & uncompr all zero if data descriptor present + : ( + $self->crc32(), + $mode + ? $self->_writeOffset() # compressed size + : $self->compressedSize(), # may need to be re-written later + $self->uncompressedSize(), + ), + length($self->fileName()), + length($self->localExtraField()); +} + +# Write my local header to a file handle. +# Stores the offset to the start of the header in my +# writeLocalHeaderRelativeOffset member. +# Returns AZ_OK on success. +sub _writeLocalFileHeader { + my $self = shift; + my $fh = shift; + + my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE); + $self->_print($fh, $signatureData) + or return _ioError("writing local header signature"); + + my $header = $self->head(1); + + $self->_print($fh, $header) or return _ioError("writing local header"); + + # Check for a valid filename or a filename equal to a literal `0' + if ($self->fileName() || $self->fileName eq '0') { + $self->_print($fh, $self->fileName()) + or return _ioError("writing local header filename"); + } + if ($self->localExtraField()) { + $self->_print($fh, $self->localExtraField()) + or return _ioError("writing local extra field"); + } + + return AZ_OK; +} + +sub _writeCentralDirectoryFileHeader { + my $self = shift; + my $fh = shift; + + my $sigData = + pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE); + $self->_print($fh, $sigData) + or return _ioError("writing central directory header signature"); + + my ($fileNameLength, $extraFieldLength, $fileCommentLength); + { + use bytes; + $fileNameLength = length($self->fileName()); + $extraFieldLength = length($self->cdExtraField()); + $fileCommentLength = length($self->fileComment()); + } + + my $header = pack( + CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, + $self->versionMadeBy(), + $self->fileAttributeFormat(), + $self->versionNeededToExtract(), + $self->bitFlag(), + $self->desiredCompressionMethod(), + $self->lastModFileDateTime(), + $self->crc32(), # these three fields should have been updated + $self->_writeOffset(), # by writing the data stream out + $self->uncompressedSize(), # + $fileNameLength, + $extraFieldLength, + $fileCommentLength, + 0, # {'diskNumberStart'}, + $self->internalFileAttributes(), + $self->externalFileAttributes(), + $self->writeLocalHeaderRelativeOffset()); + + $self->_print($fh, $header) + or return _ioError("writing central directory header"); + if ($fileNameLength) { + $self->_print($fh, $self->fileName()) + or return _ioError("writing central directory header signature"); + } + if ($extraFieldLength) { + $self->_print($fh, $self->cdExtraField()) + or return _ioError("writing central directory extra field"); + } + if ($fileCommentLength) { + $self->_print($fh, $self->fileComment()) + or return _ioError("writing central directory file comment"); + } + + return AZ_OK; +} + +# This writes a data descriptor to the given file handle. +# Assumes that crc32, writeOffset, and uncompressedSize are +# set correctly (they should be after a write). +# Further, the local file header should have the +# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set. +sub _writeDataDescriptor { + my $self = shift; + my $fh = shift; + my $header = pack( + SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT, + DATA_DESCRIPTOR_SIGNATURE, + $self->crc32(), + $self->_writeOffset(), # compressed size + $self->uncompressedSize()); + + $self->_print($fh, $header) + or return _ioError("writing data descriptor"); + return AZ_OK; +} + +# Re-writes the local file header with new crc32 and compressedSize fields. +# To be called after writing the data stream. +# Assumes that filename and extraField sizes didn't change since last written. +sub _refreshLocalFileHeader { + my $self = shift; + my $fh = shift; + + my $here = $fh->tell(); + $fh->seek($self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH, + IO::Seekable::SEEK_SET) + or return _ioError("seeking to rewrite local header"); + + my $header = $self->head(1); + + $self->_print($fh, $header) + or return _ioError("re-writing local header"); + $fh->seek($here, IO::Seekable::SEEK_SET) + or return _ioError("seeking after rewrite of local header"); + + return AZ_OK; +} + +sub readChunk { + my $self = shift; + my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0]; + + if ($self->readIsDone()) { + $self->endRead(); + my $dummy = ''; + return (\$dummy, AZ_STREAM_END); + } + + $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize); + $chunkSize = $self->_readDataRemaining() + if $chunkSize > $self->_readDataRemaining(); + + my $buffer = ''; + my $outputRef; + my ($bytesRead, $status) = $self->_readRawChunk(\$buffer, $chunkSize); + return (\$buffer, $status) unless $status == AZ_OK; + + $buffer && $self->isEncrypted and $buffer = $self->_decode($buffer); + $self->{'readDataRemaining'} -= $bytesRead; + $self->{'readOffset'} += $bytesRead; + + if ($self->compressionMethod() == COMPRESSION_STORED) { + $self->{'crc32'} = $self->computeCRC32($buffer, $self->{'crc32'}); + } + + ($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer); + $self->{'writeOffset'} += length($$outputRef); + + $self->endRead() + if $self->readIsDone(); + + return ($outputRef, $status); +} + +# Read the next raw chunk of my data. Subclasses MUST implement. +# my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize ); +sub _readRawChunk { + my $self = shift; + return $self->_subclassResponsibility(); +} + +# A place holder to catch rewindData errors if someone ignores +# the error code. +sub _noChunk { + my $self = shift; + return (\undef, _error("trying to copy chunk when init failed")); +} + +# Basically a no-op so that I can have a consistent interface. +# ( $outputRef, $status) = $self->_copyChunk( \$buffer ); +sub _copyChunk { + my ($self, $dataRef) = @_; + return ($dataRef, AZ_OK); +} + +# ( $outputRef, $status) = $self->_deflateChunk( \$buffer ); +sub _deflateChunk { + my ($self, $buffer) = @_; + my ($status) = $self->_deflater()->deflate($buffer, my $out); + + if ($self->_readDataRemaining() == 0) { + my $extraOutput; + ($status) = $self->_deflater()->flush($extraOutput); + $out .= $extraOutput; + $self->endRead(); + return (\$out, AZ_STREAM_END); + } elsif ($status == Z_OK) { + return (\$out, AZ_OK); + } else { + $self->endRead(); + my $retval = _error('deflate error', $status); + my $dummy = ''; + return (\$dummy, $retval); + } +} + +# ( $outputRef, $status) = $self->_inflateChunk( \$buffer ); +sub _inflateChunk { + my ($self, $buffer) = @_; + my ($status) = $self->_inflater()->inflate($buffer, my $out); + my $retval; + $self->endRead() unless $status == Z_OK; + if ($status == Z_OK || $status == Z_STREAM_END) { + $retval = ($status == Z_STREAM_END) ? AZ_STREAM_END : AZ_OK; + return (\$out, $retval); + } else { + $retval = _error('inflate error', $status); + my $dummy = ''; + return (\$dummy, $retval); + } +} + +sub rewindData { + my $self = shift; + my $status; + + # set to trap init errors + $self->{'chunkHandler'} = $self->can('_noChunk'); + + # Work around WinZip bug with 0-length DEFLATED files + $self->desiredCompressionMethod(COMPRESSION_STORED) + if $self->uncompressedSize() == 0; + + # assume that we're going to read the whole file, and compute the CRC anew. + $self->{'crc32'} = 0 + if ($self->compressionMethod() == COMPRESSION_STORED); + + # These are the only combinations of methods we deal with right now. + if ( $self->compressionMethod() == COMPRESSION_STORED + and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED) { + ($self->{'deflater'}, $status) = Compress::Raw::Zlib::Deflate->new( + '-Level' => $self->desiredCompressionLevel(), + '-WindowBits' => -MAX_WBITS(), # necessary magic + '-Bufsize' => $Archive::Zip::ChunkSize, + @_ + ); # pass additional options + return _error('deflateInit error:', $status) + unless $status == Z_OK; + $self->{'chunkHandler'} = $self->can('_deflateChunk'); + } elsif ($self->compressionMethod() == COMPRESSION_DEFLATED + and $self->desiredCompressionMethod() == COMPRESSION_STORED) { + ($self->{'inflater'}, $status) = Compress::Raw::Zlib::Inflate->new( + '-WindowBits' => -MAX_WBITS(), # necessary magic + '-Bufsize' => $Archive::Zip::ChunkSize, + @_ + ); # pass additional options + return _error('inflateInit error:', $status) + unless $status == Z_OK; + $self->{'chunkHandler'} = $self->can('_inflateChunk'); + } elsif ($self->compressionMethod() == $self->desiredCompressionMethod()) { + $self->{'chunkHandler'} = $self->can('_copyChunk'); + } else { + return _error( + sprintf( + "Unsupported compression combination: read %d, write %d", + $self->compressionMethod(), + $self->desiredCompressionMethod())); + } + + $self->{'readDataRemaining'} = + ($self->compressionMethod() == COMPRESSION_STORED) + ? $self->uncompressedSize() + : $self->compressedSize(); + $self->{'dataEnded'} = 0; + $self->{'readOffset'} = 0; + + return AZ_OK; +} + +sub endRead { + my $self = shift; + delete $self->{'inflater'}; + delete $self->{'deflater'}; + $self->{'dataEnded'} = 1; + $self->{'readDataRemaining'} = 0; + return AZ_OK; +} + +sub readIsDone { + my $self = shift; + return ($self->_dataEnded() or !$self->_readDataRemaining()); +} + +sub contents { + my $self = shift; + my $newContents = shift; + + if (defined($newContents)) { + + # change our type and call the subclass contents method. + $self->_become('Archive::Zip::StringMember'); + return $self->contents(pack('C0a*', $newContents)); # in case of Unicode + } else { + my $oldCompression = + $self->desiredCompressionMethod(COMPRESSION_STORED); + my $status = $self->rewindData(@_); + if ($status != AZ_OK) { + $self->endRead(); + return $status; + } + my $retval = ''; + while ($status == AZ_OK) { + my $ref; + ($ref, $status) = $self->readChunk($self->_readDataRemaining()); + + # did we get it in one chunk? + if (length($$ref) == $self->uncompressedSize()) { + $retval = $$ref; + } else { + $retval .= $$ref + } + } + $self->desiredCompressionMethod($oldCompression); + $self->endRead(); + $status = AZ_OK if $status == AZ_STREAM_END; + $retval = undef unless $status == AZ_OK; + return wantarray ? ($retval, $status) : $retval; + } +} + +sub extractToFileHandle { + my $self = shift; + my $fh = (ref($_[0]) eq 'HASH') ? shift->{fileHandle} : shift; + _binmode($fh); + my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED); + my $status = $self->rewindData(@_); + $status = $self->_writeData($fh) if $status == AZ_OK; + $self->desiredCompressionMethod($oldCompression); + $self->endRead(); + return $status; +} + +# write local header and data stream to file handle +sub _writeToFileHandle { + my $self = shift; + my $fh = shift; + my $fhIsSeekable = shift; + my $offset = shift; + + return _error("no member name given for $self") + if $self->fileName() eq ''; + + $self->{'writeLocalHeaderRelativeOffset'} = $offset; + $self->{'wasWritten'} = 0; + + # Determine if I need to write a data descriptor + # I need to do this if I can't refresh the header + # and I don't know compressed size or crc32 fields. + my $headerFieldsUnknown = ( + ($self->uncompressedSize() > 0) + and ($self->compressionMethod() == COMPRESSION_STORED + or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED)); + + my $shouldWriteDataDescriptor = + ($headerFieldsUnknown and not $fhIsSeekable); + + $self->hasDataDescriptor(1) + if ($shouldWriteDataDescriptor); + + $self->{'writeOffset'} = 0; + + my $status = $self->rewindData(); + ($status = $self->_writeLocalFileHeader($fh)) + if $status == AZ_OK; + ($status = $self->_writeData($fh)) + if $status == AZ_OK; + if ($status == AZ_OK) { + $self->{'wasWritten'} = 1; + if ($self->hasDataDescriptor()) { + $status = $self->_writeDataDescriptor($fh); + } elsif ($headerFieldsUnknown) { + $status = $self->_refreshLocalFileHeader($fh); + } + } + + return $status; +} + +# Copy my (possibly compressed) data to given file handle. +# Returns C<AZ_OK> on success +sub _writeData { + my $self = shift; + my $writeFh = shift; + +# If symbolic link, just create one if the operating system is Linux, Unix, BSD or VMS +# TODO: Add checks for other operating systems + if ($self->{'isSymbolicLink'} == 1 && $^O eq 'linux') { + my $chunkSize = $Archive::Zip::ChunkSize; + my ($outRef, $status) = $self->readChunk($chunkSize); + symlink $$outRef, $self->{'newName'}; + } else { + return AZ_OK if ($self->uncompressedSize() == 0); + my $status; + my $chunkSize = $Archive::Zip::ChunkSize; + while ($self->_readDataRemaining() > 0) { + my $outRef; + ($outRef, $status) = $self->readChunk($chunkSize); + return $status if ($status != AZ_OK and $status != AZ_STREAM_END); + + if (length($$outRef) > 0) { + $self->_print($writeFh, $$outRef) + or return _ioError("write error during copy"); + } + + last if $status == AZ_STREAM_END; + } + } + return AZ_OK; +} + +# Return true if I depend on the named file +sub _usesFileNamed { + return 0; +} + +# ############################################################################## +# +# Decrypt section +# +# H.Merijn Brand (Tux) 2011-06-28 +# +# ############################################################################## + +# This code is derived from the crypt source of unzip-6.0 dated 05 Jan 2007 +# Its license states: +# +# --8<--- +# Copyright (c) 1990-2007 Info-ZIP. All rights reserved. + +# See the accompanying file LICENSE, version 2005-Feb-10 or later +# (the contents of which are also included in (un)zip.h) for terms of use. +# If, for some reason, all these files are missing, the Info-ZIP license +# also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html +# +# crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h] + +# The main encryption/decryption source code for Info-Zip software was +# originally written in Europe. To the best of our knowledge, it can +# be freely distributed in both source and object forms from any country, +# including the USA under License Exception TSU of the U.S. Export +# Administration Regulations (section 740.13(e)) of 6 June 2002. + +# NOTE on copyright history: +# Previous versions of this source package (up to version 2.8) were +# not copyrighted and put in the public domain. If you cannot comply +# with the Info-Zip LICENSE, you may want to look for one of those +# public domain versions. +# +# This encryption code is a direct transcription of the algorithm from +# Roger Schlafly, described by Phil Katz in the file appnote.txt. This +# file (appnote.txt) is distributed with the PKZIP program (even in the +# version without encryption capabilities). +# -->8--- + +# As of January 2000, US export regulations were amended to allow export +# of free encryption source code from the US. As of June 2002, these +# regulations were further relaxed to allow export of encryption binaries +# associated with free encryption source code. The Zip 2.31, UnZip 5.52 +# and Wiz 5.02 archives now include full crypto source code. As of the +# Zip 2.31 release, all official binaries include encryption support; the +# former "zcr" archives ceased to exist. +# (Note that restrictions may still exist in other countries, of course.) + +# For now, we just support the decrypt stuff +# All below methods are supposed to be private + +# use Data::Peek; + +my @keys; +my @crct = do { + my $xor = 0xedb88320; + my @crc = (0) x 1024; + + # generate a crc for every 8-bit value + foreach my $n (0 .. 255) { + my $c = $n; + $c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8; + $crc[$n] = _revbe($c); + } + + # generate crc for each value followed by one, two, and three zeros */ + foreach my $n (0 .. 255) { + my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff; + $crc[$_ * 256 + $n] = $c for 1 .. 3; + } + map { _revbe($crc[$_]) } 0 .. 1023; +}; + +sub _crc32 { + my ($c, $b) = @_; + return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8)); +} # _crc32 + +sub _revbe { + my $w = shift; + return (($w >> 24) + + (($w >> 8) & 0xff00) + + (($w & 0xff00) << 8) + + (($w & 0xff) << 24)); +} # _revbe + +sub _update_keys { + use integer; + my $c = shift; # signed int + $keys[0] = _crc32($keys[0], $c); + $keys[1] = (($keys[1] + ($keys[0] & 0xff)) * 0x08088405 + 1) & 0xffffffff; + my $keyshift = $keys[1] >> 24; + $keys[2] = _crc32($keys[2], $keyshift); +} # _update_keys + +sub _zdecode ($) { + my $c = shift; + my $t = ($keys[2] & 0xffff) | 2; + _update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff)); + return $c; +} # _zdecode + +sub _decode { + my $self = shift; + my $buff = shift; + + $self->isEncrypted or return $buff; + + my $pass = $self->password; + defined $pass or return ""; + + @keys = (0x12345678, 0x23456789, 0x34567890); + _update_keys($_) for unpack "C*", $pass; + + # DDumper { uk => [ @keys ] }; + + my $head = substr $buff, 0, 12, ""; + my @head = map { _zdecode($_) } unpack "C*", $head; + my $x = + $self->{externalFileAttributes} + ? ($self->{lastModFileDateTime} >> 8) & 0xff + : $self->{crc32} >> 24; + $head[-1] == $x or return ""; # Password fail + + # Worth checking ... + $self->{crc32c} = (unpack LOCAL_FILE_HEADER_FORMAT, pack "C*", @head)[3]; + + # DHexDump ($buff); + $buff = pack "C*" => map { _zdecode($_) } unpack "C*" => $buff; + + # DHexDump ($buff); + return $buff; +} # _decode + +1; diff --git a/lib/Archive/Zip/MemberRead.pm b/lib/Archive/Zip/MemberRead.pm new file mode 100644 index 0000000..e0f0b14 --- /dev/null +++ b/lib/Archive/Zip/MemberRead.pm @@ -0,0 +1,348 @@ +package Archive::Zip::MemberRead; + +=head1 NAME + +Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files. + +=cut + +=head1 SYNOPSIS + + use Archive::Zip; + use Archive::Zip::MemberRead; + $zip = Archive::Zip->new("file.zip"); + $fh = Archive::Zip::MemberRead->new($zip, "subdir/abc.txt"); + while (defined($line = $fh->getline())) + { + print $fh->input_line_number . "#: $line\n"; + } + + $read = $fh->read($buffer, 32*1024); + print "Read $read bytes as :$buffer:\n"; + +=head1 DESCRIPTION + +The Archive::Zip::MemberRead module lets you read Zip archive member data +just like you read data from files. + +=head1 METHODS + +=over 4 + +=cut + +use strict; + +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); + +use vars qw{$VERSION}; + +my $nl; + +BEGIN { + $VERSION = '1.49'; + $VERSION = eval $VERSION; + +# Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy. + $nl = $^O eq 'MSWin32' ? "\r\n" : "\n"; +} + +=item Archive::Zip::Member::readFileHandle() + +You can get a C<Archive::Zip::MemberRead> from an archive member by +calling C<readFileHandle()>: + + my $member = $zip->memberNamed('abc/def.c'); + my $fh = $member->readFileHandle(); + while (defined($line = $fh->getline())) + { + # ... + } + $fh->close(); + +=cut + +sub Archive::Zip::Member::readFileHandle { + return Archive::Zip::MemberRead->new(shift()); +} + +=item Archive::Zip::MemberRead->new($zip, $fileName) + +=item Archive::Zip::MemberRead->new($zip, $member) + +=item Archive::Zip::MemberRead->new($member) + +Construct a new Archive::Zip::MemberRead on the specified member. + + my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c') + +=cut + +sub new { + my ($class, $zip, $file) = @_; + my ($self, $member); + + if ($zip && $file) # zip and filename, or zip and member + { + $member = ref($file) ? $file : $zip->memberNamed($file); + } elsif ($zip && !$file && ref($zip)) # just member + { + $member = $zip; + } else { + die( + 'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member' + ); + } + + $self = {}; + bless($self, $class); + $self->set_member($member); + return $self; +} + +sub set_member { + my ($self, $member) = @_; + + $self->{member} = $member; + $self->set_compression(COMPRESSION_STORED); + $self->rewind(); +} + +sub set_compression { + my ($self, $compression) = @_; + $self->{member}->desiredCompressionMethod($compression) if $self->{member}; +} + +=item setLineEnd(expr) + +Set the line end character to use. This is set to \n by default +except on Windows systems where it is set to \r\n. You will +only need to set this on systems which are not Windows or Unix +based and require a line end different from \n. +This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)> + +=cut + +sub setLineEnd { + shift; + $nl = shift; +} + +=item rewind() + +Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again +starting at the beginning. + +=cut + +sub rewind { + my $self = shift; + + $self->_reset_vars(); + $self->{member}->rewindData() if $self->{member}; +} + +sub _reset_vars { + my $self = shift; + + $self->{line_no} = 0; + $self->{at_end} = 0; + + delete $self->{buffer}; +} + +=item input_record_separator(expr) + +If the argument is given, input_record_separator for this +instance is set to it. The current setting (which may be +the global $/) is always returned. + +=cut + +sub input_record_separator { + my $self = shift; + if (@_) { + $self->{sep} = shift; + $self->{sep_re} = + _sep_as_re($self->{sep}); # Cache the RE as an optimization + } + return exists $self->{sep} ? $self->{sep} : $/; +} + +# Return the input_record_separator in use as an RE fragment +# Note that if we have a per-instance input_record_separator +# we can just return the already converted value. Otherwise, +# the conversion must be done on $/ every time since we cannot +# know whether it has changed or not. +sub _sep_re { + my $self = shift; + + # Important to phrase this way: sep's value may be undef. + return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/); +} + +# Convert the input record separator into an RE and return it. +sub _sep_as_re { + my $sep = shift; + if (defined $sep) { + if ($sep eq '') { + return "(?:$nl){2,}"; + } else { + $sep =~ s/\n/$nl/og; + return quotemeta $sep; + } + } else { + return undef; + } +} + +=item input_line_number() + +Returns the current line number, but only if you're using C<getline()>. +Using C<read()> will not update the line number. + +=cut + +sub input_line_number { + my $self = shift; + return $self->{line_no}; +} + +=item close() + +Closes the given file handle. + +=cut + +sub close { + my $self = shift; + + $self->_reset_vars(); + $self->{member}->endRead(); +} + +=item buffer_size([ $size ]) + +Gets or sets the buffer size used for reads. +Default is the chunk size used by Archive::Zip. + +=cut + +sub buffer_size { + my ($self, $size) = @_; + + if (!$size) { + return $self->{chunkSize} || Archive::Zip::chunkSize(); + } else { + $self->{chunkSize} = $size; + } +} + +=item getline() + +Returns the next line from the currently open member. +Makes sense only for text files. +A read error is considered fatal enough to die. +Returns undef on eof. All subsequent calls would return undef, +unless a rewind() is called. +Note: The line returned has the input_record_separator (default: newline) removed. + +=item getline( { preserve_line_ending => 1 } ) + +Returns the next line including the line ending. + +=cut + +sub getline { + my ($self, $argref) = @_; + + my $size = $self->buffer_size(); + my $sep = $self->_sep_re(); + + my $preserve_line_ending; + if (ref $argref eq 'HASH') { + $preserve_line_ending = $argref->{'preserve_line_ending'}; + $sep =~ s/\\([^A-Za-z_0-9])+/$1/g; + } + + for (; ;) { + if ( $sep + && defined($self->{buffer}) + && $self->{buffer} =~ s/^(.*?)$sep//s) { + my $line = $1; + $self->{line_no}++; + if ($preserve_line_ending) { + return $line . $sep; + } else { + return $line; + } + } elsif ($self->{at_end}) { + $self->{line_no}++ if $self->{buffer}; + return delete $self->{buffer}; + } + my ($temp, $status) = $self->{member}->readChunk($size); + if ($status != AZ_OK && $status != AZ_STREAM_END) { + die "ERROR: Error reading chunk from archive - $status"; + } + $self->{at_end} = $status == AZ_STREAM_END; + $self->{buffer} .= $$temp; + } +} + +=item read($buffer, $num_bytes_to_read) + +Simulates a normal C<read()> system call. +Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>: + + $fh = Archive::Zip::MemberRead->new($zip, "sreeji/secrets.bin"); + while (1) + { + $read = $fh->read($buffer, 1024); + die "FATAL ERROR reading my secrets !\n" if (!defined($read)); + last if (!$read); + # Do processing. + .... + } + +=cut + +# +# All these $_ are required to emulate read(). +# +sub read { + my $self = $_[0]; + my $size = $_[2]; + my ($temp, $status, $ret); + + ($temp, $status) = $self->{member}->readChunk($size); + if ($status != AZ_OK && $status != AZ_STREAM_END) { + $_[1] = undef; + $ret = undef; + } else { + $_[1] = $$temp; + $ret = length($$temp); + } + return $ret; +} + +1; + +=back + +=head1 AUTHOR + +Sreeji K. Das E<lt>sreeji_k@yahoo.comE<gt> + +See L<Archive::Zip> by Ned Konz without which this module does not make +any sense! + +Minor mods by Ned Konz. + +=head1 COPYRIGHT + +Copyright 2002 Sreeji K. Das. + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Archive/Zip/MockFileHandle.pm b/lib/Archive/Zip/MockFileHandle.pm new file mode 100644 index 0000000..8065f95 --- /dev/null +++ b/lib/Archive/Zip/MockFileHandle.pm @@ -0,0 +1,69 @@ +package Archive::Zip::MockFileHandle; + +# Output file handle that calls a custom write routine +# Ned Konz, March 2000 +# This is provided to help with writing zip files +# when you have to process them a chunk at a time. + +use strict; + +use vars qw{$VERSION}; + +BEGIN { + $VERSION = '1.49'; + $VERSION = eval $VERSION; +} + +sub new { + my $class = shift || __PACKAGE__; + $class = ref($class) || $class; + my $self = bless( + { + 'position' => 0, + 'size' => 0 + }, + $class + ); + return $self; +} + +sub eof { + my $self = shift; + return $self->{'position'} >= $self->{'size'}; +} + +# Copy given buffer to me +sub print { + my $self = shift; + my $bytes = join('', @_); + my $bytesWritten = $self->writeHook($bytes); + if ($self->{'position'} + $bytesWritten > $self->{'size'}) { + $self->{'size'} = $self->{'position'} + $bytesWritten; + } + $self->{'position'} += $bytesWritten; + return $bytesWritten; +} + +# Called on each write. +# Override in subclasses. +# Return number of bytes written (0 on error). +sub writeHook { + my $self = shift; + my $bytes = shift; + return length($bytes); +} + +sub binmode { 1 } + +sub close { 1 } + +sub clearerr { 1 } + +# I'm write-only! +sub read { 0 } + +sub tell { return shift->{'position'} } + +sub opened { 1 } + +1; diff --git a/lib/Archive/Zip/NewFileMember.pm b/lib/Archive/Zip/NewFileMember.pm new file mode 100644 index 0000000..928d489 --- /dev/null +++ b/lib/Archive/Zip/NewFileMember.pm @@ -0,0 +1,77 @@ +package Archive::Zip::NewFileMember; + +use strict; +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw ( Archive::Zip::FileMember ); +} + +use Archive::Zip qw( + :CONSTANTS + :ERROR_CODES + :UTILITY_METHODS +); + +# Given a file name, set up for eventual writing. +sub _newFromFileNamed { + my $class = shift; + my $fileName = shift; # local FS format + my $newName = shift; + $newName = _asZipDirName($fileName) unless defined($newName); + return undef unless (stat($fileName) && -r _ && !-d _ ); + my $self = $class->new(@_); + $self->{'fileName'} = $newName; + $self->{'externalFileName'} = $fileName; + $self->{'compressionMethod'} = COMPRESSION_STORED; + my @stat = stat(_); + $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7]; + $self->desiredCompressionMethod( + ($self->compressedSize() > 0) + ? COMPRESSION_DEFLATED + : COMPRESSION_STORED + ); + $self->unixFileAttributes($stat[2]); + $self->setLastModFileDateTimeFromUnix($stat[9]); + $self->isTextFile(-T _ ); + return $self; +} + +sub rewindData { + my $self = shift; + + my $status = $self->SUPER::rewindData(@_); + return $status unless $status == AZ_OK; + + return AZ_IO_ERROR unless $self->fh(); + $self->fh()->clearerr(); + $self->fh()->seek(0, IO::Seekable::SEEK_SET) + or return _ioError("rewinding", $self->externalFileName()); + return AZ_OK; +} + +# Return bytes read. Note that first parameter is a ref to a buffer. +# my $data; +# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); +sub _readRawChunk { + my ($self, $dataRef, $chunkSize) = @_; + return (0, AZ_OK) unless $chunkSize; + my $bytesRead = $self->fh()->read($$dataRef, $chunkSize) + or return (0, _ioError("reading data")); + return ($bytesRead, AZ_OK); +} + +# If I already exist, extraction is a no-op. +sub extractToFileNamed { + my $self = shift; + my $name = shift; # local FS name + if (File::Spec->rel2abs($name) eq + File::Spec->rel2abs($self->externalFileName()) and -r $name) { + return AZ_OK; + } else { + return $self->SUPER::extractToFileNamed($name, @_); + } +} + +1; diff --git a/lib/Archive/Zip/StringMember.pm b/lib/Archive/Zip/StringMember.pm new file mode 100644 index 0000000..50e74c6 --- /dev/null +++ b/lib/Archive/Zip/StringMember.pm @@ -0,0 +1,64 @@ +package Archive::Zip::StringMember; + +use strict; +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw( Archive::Zip::Member ); +} + +use Archive::Zip qw( + :CONSTANTS + :ERROR_CODES +); + +# Create a new string member. Default is COMPRESSION_STORED. +# Can take a ref to a string as well. +sub _newFromString { + my $class = shift; + my $string = shift; + my $name = shift; + my $self = $class->new(@_); + $self->contents($string); + $self->fileName($name) if defined($name); + + # Set the file date to now + $self->setLastModFileDateTimeFromUnix(time()); + $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS); + return $self; +} + +sub _become { + my $self = shift; + my $newClass = shift; + return $self if ref($self) eq $newClass; + delete($self->{'contents'}); + return $self->SUPER::_become($newClass); +} + +# Get or set my contents. Note that we do not call the superclass +# version of this, because it calls us. +sub contents { + my $self = shift; + my $string = shift; + if (defined($string)) { + $self->{'contents'} = + pack('C0a*', (ref($string) eq 'SCALAR') ? $$string : $string); + $self->{'uncompressedSize'} = $self->{'compressedSize'} = + length($self->{'contents'}); + $self->{'compressionMethod'} = COMPRESSION_STORED; + } + return $self->{'contents'}; +} + +# Return bytes read. Note that first parameter is a ref to a buffer. +# my $data; +# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); +sub _readRawChunk { + my ($self, $dataRef, $chunkSize) = @_; + $$dataRef = substr($self->contents(), $self->_readOffset(), $chunkSize); + return (length($$dataRef), AZ_OK); +} + +1; diff --git a/lib/Archive/Zip/Tree.pm b/lib/Archive/Zip/Tree.pm new file mode 100644 index 0000000..303a057 --- /dev/null +++ b/lib/Archive/Zip/Tree.pm @@ -0,0 +1,48 @@ +package Archive::Zip::Tree; + +use strict; +use vars qw{$VERSION}; + +BEGIN { + $VERSION = '1.49'; +} + +use Archive::Zip; + +warn( + "Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip." +) if $^W; + +1; + +__END__ + +=head1 NAME + +Archive::Zip::Tree - (DEPRECATED) methods for adding/extracting trees using Archive::Zip + +=head1 DESCRIPTION + +This module is deprecated, because all its methods were moved into the main +Archive::Zip module. + +It is included in the distribution merely to avoid breaking old code. + +See L<Archive::Zip>. + +=head1 AUTHOR + +Ned Konz, perl@bike-nomad.com + +=head1 COPYRIGHT + +Copyright (c) 2000-2002 Ned Konz. All rights reserved. This program is free +software; you can redistribute it and/or modify it under the same terms +as Perl itself. + +=head1 SEE ALSO + +L<Archive::Zip> + +=cut + diff --git a/lib/Archive/Zip/ZipFileMember.pm b/lib/Archive/Zip/ZipFileMember.pm new file mode 100644 index 0000000..cd4c875 --- /dev/null +++ b/lib/Archive/Zip/ZipFileMember.pm @@ -0,0 +1,416 @@ +package Archive::Zip::ZipFileMember; + +use strict; +use vars qw( $VERSION @ISA ); + +BEGIN { + $VERSION = '1.49'; + @ISA = qw ( Archive::Zip::FileMember ); +} + +use Archive::Zip qw( + :CONSTANTS + :ERROR_CODES + :PKZIP_CONSTANTS + :UTILITY_METHODS +); + +# Create a new Archive::Zip::ZipFileMember +# given a filename and optional open file handle +# +sub _newFromZipFile { + my $class = shift; + my $fh = shift; + my $externalFileName = shift; + my $possibleEocdOffset = shift; # normally 0 + + my $self = $class->new( + 'crc32' => 0, + 'diskNumberStart' => 0, + 'localHeaderRelativeOffset' => 0, + 'dataOffset' => 0, # localHeaderRelativeOffset + header length + @_ + ); + $self->{'externalFileName'} = $externalFileName; + $self->{'fh'} = $fh; + $self->{'possibleEocdOffset'} = $possibleEocdOffset; + return $self; +} + +sub isDirectory { + my $self = shift; + return (substr($self->fileName, -1, 1) eq '/' + and $self->uncompressedSize == 0); +} + +# Seek to the beginning of the local header, just past the signature. +# Verify that the local header signature is in fact correct. +# Update the localHeaderRelativeOffset if necessary by adding the possibleEocdOffset. +# Returns status. + +sub _seekToLocalHeader { + my $self = shift; + my $where = shift; # optional + my $previousWhere = shift; # optional + + $where = $self->localHeaderRelativeOffset() unless defined($where); + + # avoid loop on certain corrupt files (from Julian Field) + return _formatError("corrupt zip file") + if defined($previousWhere) && $where == $previousWhere; + + my $status; + my $signature; + + $status = $self->fh()->seek($where, IO::Seekable::SEEK_SET); + return _ioError("seeking to local header") unless $status; + + ($status, $signature) = + _readSignature($self->fh(), $self->externalFileName(), + LOCAL_FILE_HEADER_SIGNATURE); + return $status if $status == AZ_IO_ERROR; + + # retry with EOCD offset if any was given. + if ($status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'}) { + $status = $self->_seekToLocalHeader( + $self->localHeaderRelativeOffset() + $self->{'possibleEocdOffset'}, + $where + ); + if ($status == AZ_OK) { + $self->{'localHeaderRelativeOffset'} += + $self->{'possibleEocdOffset'}; + $self->{'possibleEocdOffset'} = 0; + } + } + + return $status; +} + +# Because I'm going to delete the file handle, read the local file +# header if the file handle is seekable. If it is not, I assume that +# I've already read the local header. +# Return ( $status, $self ) + +sub _become { + my $self = shift; + my $newClass = shift; + return $self if ref($self) eq $newClass; + + my $status = AZ_OK; + + if (_isSeekable($self->fh())) { + my $here = $self->fh()->tell(); + $status = $self->_seekToLocalHeader(); + $status = $self->_readLocalFileHeader() if $status == AZ_OK; + $self->fh()->seek($here, IO::Seekable::SEEK_SET); + return $status unless $status == AZ_OK; + } + + delete($self->{'eocdCrc32'}); + delete($self->{'diskNumberStart'}); + delete($self->{'localHeaderRelativeOffset'}); + delete($self->{'dataOffset'}); + + return $self->SUPER::_become($newClass); +} + +sub diskNumberStart { + shift->{'diskNumberStart'}; +} + +sub localHeaderRelativeOffset { + shift->{'localHeaderRelativeOffset'}; +} + +sub dataOffset { + shift->{'dataOffset'}; +} + +# Skip local file header, updating only extra field stuff. +# Assumes that fh is positioned before signature. +sub _skipLocalFileHeader { + my $self = shift; + my $header; + my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH); + if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) { + return _ioError("reading local file header"); + } + my $fileNameLength; + my $extraFieldLength; + my $bitFlag; + ( + undef, # $self->{'versionNeededToExtract'}, + $bitFlag, + undef, # $self->{'compressionMethod'}, + undef, # $self->{'lastModFileDateTime'}, + undef, # $crc32, + undef, # $compressedSize, + undef, # $uncompressedSize, + $fileNameLength, + $extraFieldLength + ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header); + + if ($fileNameLength) { + $self->fh()->seek($fileNameLength, IO::Seekable::SEEK_CUR) + or return _ioError("skipping local file name"); + } + + if ($extraFieldLength) { + $bytesRead = + $self->fh()->read($self->{'localExtraField'}, $extraFieldLength); + if ($bytesRead != $extraFieldLength) { + return _ioError("reading local extra field"); + } + } + + $self->{'dataOffset'} = $self->fh()->tell(); + + if ($bitFlag & GPBF_HAS_DATA_DESCRIPTOR_MASK) { + + # Read the crc32, compressedSize, and uncompressedSize from the + # extended data descriptor, which directly follows the compressed data. + # + # Skip over the compressed file data (assumes that EOCD compressedSize + # was correct) + $self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR) + or return _ioError("seeking to extended local header"); + + # these values should be set correctly from before. + my $oldCrc32 = $self->{'eocdCrc32'}; + my $oldCompressedSize = $self->{'compressedSize'}; + my $oldUncompressedSize = $self->{'uncompressedSize'}; + + my $status = $self->_readDataDescriptor(); + return $status unless $status == AZ_OK; + + # The buffer withe encrypted data is prefixed with a new + # encrypted 12 byte header. The size only changes when + # the buffer is also compressed + $self->isEncrypted && $oldUncompressedSize > $self->{uncompressedSize} + and $oldUncompressedSize -= DATA_DESCRIPTOR_LENGTH; + + return _formatError( + "CRC or size mismatch while skipping data descriptor") + if ( $oldCrc32 != $self->{'crc32'} + || $oldUncompressedSize != $self->{'uncompressedSize'}); + + $self->{'crc32'} = 0 + if $self->compressionMethod() == COMPRESSION_STORED ; + } + + return AZ_OK; +} + +# Read from a local file header into myself. Returns AZ_OK if successful. +# Assumes that fh is positioned after signature. +# Note that crc32, compressedSize, and uncompressedSize will be 0 if +# GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag. + +sub _readLocalFileHeader { + my $self = shift; + my $header; + my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH); + if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) { + return _ioError("reading local file header"); + } + my $fileNameLength; + my $crc32; + my $compressedSize; + my $uncompressedSize; + my $extraFieldLength; + ( + $self->{'versionNeededToExtract'}, $self->{'bitFlag'}, + $self->{'compressionMethod'}, $self->{'lastModFileDateTime'}, + $crc32, $compressedSize, + $uncompressedSize, $fileNameLength, + $extraFieldLength + ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header); + + if ($fileNameLength) { + my $fileName; + $bytesRead = $self->fh()->read($fileName, $fileNameLength); + if ($bytesRead != $fileNameLength) { + return _ioError("reading local file name"); + } + $self->fileName($fileName); + } + + if ($extraFieldLength) { + $bytesRead = + $self->fh()->read($self->{'localExtraField'}, $extraFieldLength); + if ($bytesRead != $extraFieldLength) { + return _ioError("reading local extra field"); + } + } + + $self->{'dataOffset'} = $self->fh()->tell(); + + if ($self->hasDataDescriptor()) { + + # Read the crc32, compressedSize, and uncompressedSize from the + # extended data descriptor. + # Skip over the compressed file data (assumes that EOCD compressedSize + # was correct) + $self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR) + or return _ioError("seeking to extended local header"); + + my $status = $self->_readDataDescriptor(); + return $status unless $status == AZ_OK; + } else { + return _formatError( + "CRC or size mismatch after reading data descriptor") + if ( $self->{'crc32'} != $crc32 + || $self->{'uncompressedSize'} != $uncompressedSize); + } + + return AZ_OK; +} + +# This will read the data descriptor, which is after the end of compressed file +# data in members that have GPBF_HAS_DATA_DESCRIPTOR_MASK set in their bitFlag. +# The only reliable way to find these is to rely on the EOCD compressedSize. +# Assumes that file is positioned immediately after the compressed data. +# Returns status; sets crc32, compressedSize, and uncompressedSize. +sub _readDataDescriptor { + my $self = shift; + my $signatureData; + my $header; + my $crc32; + my $compressedSize; + my $uncompressedSize; + + my $bytesRead = $self->fh()->read($signatureData, SIGNATURE_LENGTH); + return _ioError("reading header signature") + if $bytesRead != SIGNATURE_LENGTH; + my $signature = unpack(SIGNATURE_FORMAT, $signatureData); + + # unfortunately, the signature appears to be optional. + if ($signature == DATA_DESCRIPTOR_SIGNATURE + && ($signature != $self->{'crc32'})) { + $bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH); + return _ioError("reading data descriptor") + if $bytesRead != DATA_DESCRIPTOR_LENGTH; + + ($crc32, $compressedSize, $uncompressedSize) = + unpack(DATA_DESCRIPTOR_FORMAT, $header); + } else { + $bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH_NO_SIG); + return _ioError("reading data descriptor") + if $bytesRead != DATA_DESCRIPTOR_LENGTH_NO_SIG; + + $crc32 = $signature; + ($compressedSize, $uncompressedSize) = + unpack(DATA_DESCRIPTOR_FORMAT_NO_SIG, $header); + } + + $self->{'eocdCrc32'} = $self->{'crc32'} + unless defined($self->{'eocdCrc32'}); + $self->{'crc32'} = $crc32; + $self->{'compressedSize'} = $compressedSize; + $self->{'uncompressedSize'} = $uncompressedSize; + + return AZ_OK; +} + +# Read a Central Directory header. Return AZ_OK on success. +# Assumes that fh is positioned right after the signature. + +sub _readCentralDirectoryFileHeader { + my $self = shift; + my $fh = $self->fh(); + my $header = ''; + my $bytesRead = $fh->read($header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH); + if ($bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH) { + return _ioError("reading central dir header"); + } + my ($fileNameLength, $extraFieldLength, $fileCommentLength); + ( + $self->{'versionMadeBy'}, + $self->{'fileAttributeFormat'}, + $self->{'versionNeededToExtract'}, + $self->{'bitFlag'}, + $self->{'compressionMethod'}, + $self->{'lastModFileDateTime'}, + $self->{'crc32'}, + $self->{'compressedSize'}, + $self->{'uncompressedSize'}, + $fileNameLength, + $extraFieldLength, + $fileCommentLength, + $self->{'diskNumberStart'}, + $self->{'internalFileAttributes'}, + $self->{'externalFileAttributes'}, + $self->{'localHeaderRelativeOffset'} + ) = unpack(CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header); + + $self->{'eocdCrc32'} = $self->{'crc32'}; + + if ($fileNameLength) { + $bytesRead = $fh->read($self->{'fileName'}, $fileNameLength); + if ($bytesRead != $fileNameLength) { + _ioError("reading central dir filename"); + } + } + if ($extraFieldLength) { + $bytesRead = $fh->read($self->{'cdExtraField'}, $extraFieldLength); + if ($bytesRead != $extraFieldLength) { + return _ioError("reading central dir extra field"); + } + } + if ($fileCommentLength) { + $bytesRead = $fh->read($self->{'fileComment'}, $fileCommentLength); + if ($bytesRead != $fileCommentLength) { + return _ioError("reading central dir file comment"); + } + } + + # NK 10/21/04: added to avoid problems with manipulated headers + if ( $self->{'uncompressedSize'} != $self->{'compressedSize'} + and $self->{'compressionMethod'} == COMPRESSION_STORED) { + $self->{'uncompressedSize'} = $self->{'compressedSize'}; + } + + $self->desiredCompressionMethod($self->compressionMethod()); + + return AZ_OK; +} + +sub rewindData { + my $self = shift; + + my $status = $self->SUPER::rewindData(@_); + return $status unless $status == AZ_OK; + + return AZ_IO_ERROR unless $self->fh(); + + $self->fh()->clearerr(); + + # Seek to local file header. + # The only reason that I'm doing this this way is that the extraField + # length seems to be different between the CD header and the LF header. + $status = $self->_seekToLocalHeader(); + return $status unless $status == AZ_OK; + + # skip local file header + $status = $self->_skipLocalFileHeader(); + return $status unless $status == AZ_OK; + + # Seek to beginning of file data + $self->fh()->seek($self->dataOffset(), IO::Seekable::SEEK_SET) + or return _ioError("seeking to beginning of file data"); + + return AZ_OK; +} + +# Return bytes read. Note that first parameter is a ref to a buffer. +# my $data; +# my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); +sub _readRawChunk { + my ($self, $dataRef, $chunkSize) = @_; + return (0, AZ_OK) unless $chunkSize; + my $bytesRead = $self->fh()->read($$dataRef, $chunkSize) + or return (0, _ioError("reading data")); + return ($bytesRead, AZ_OK); +} + +1; diff --git a/script/crc32 b/script/crc32 new file mode 100644 index 0000000..39ce0ab --- /dev/null +++ b/script/crc32 @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +# Computes and prints to stdout the CRC-32 values of the given files + +use 5.006; +use strict; +use lib qw( blib/lib lib ); +use Archive::Zip; +use FileHandle; + +use vars qw( $VERSION ); +BEGIN { + $VERSION = '1.31_04'; +} + +my $totalFiles = scalar(@ARGV); +foreach my $file (@ARGV) { + if ( -d $file ) { + warn "$0: ${file}: Is a directory\n"; + next; + } + my $fh = FileHandle->new(); + if ( !$fh->open( $file, 'r' ) ) { + warn "$0: $!\n"; + next; + } + binmode($fh); + my $buffer; + my $bytesRead; + my $crc = 0; + while ( $bytesRead = $fh->read( $buffer, 32768 ) ) { + $crc = Archive::Zip::computeCRC32( $buffer, $crc ); + } + printf( "%08x", $crc ); + print("\t$file") if ( $totalFiles > 1 ); + print("\n"); +} diff --git a/t/01_compile.t b/t/01_compile.t new file mode 100644 index 0000000..707dd2f --- /dev/null +++ b/t/01_compile.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More tests => 2; + +use_ok('Archive::Zip'); +use_ok('Archive::Zip::MemberRead'); diff --git a/t/02_main.t b/t/02_main.t new file mode 100644 index 0000000..dc7ad17 --- /dev/null +++ b/t/02_main.t @@ -0,0 +1,592 @@ +#!/usr/bin/perl + +# Main testing for Archive::Zip + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); +use FileHandle; +use File::Path; +use File::Spec; + +use Test::More tests => 141; + +use t::common; + +##################################################################### +# Testing Utility Functions + +#--------- check CRC +is(TESTSTRINGCRC, 0xac373f32, 'Testing CRC matches expected'); + +# Bad times die +SCOPE: { + my @errors = (); + local $Archive::Zip::ErrorHandler = sub { push @errors, @_ }; + eval { Archive::Zip::Member::_unixToDosTime(0) }; + ok($errors[0] =~ /Tried to add member with zero or undef/, + 'Got expected _unixToDosTime error'); +} + +#--------- check time conversion + +foreach my $unix_time ( + 315576062, 315576064, 315580000, 315600000, + 316000000, 320000000, 400000000, 500000000, + 600000000, 700000000, 800000000, 900000000, + 1000000000, 1100000000, 1200000000, int(time() / 2) * 2, + ) { + my $dos_time = Archive::Zip::Member::_unixToDosTime($unix_time); + my $round_trip = Archive::Zip::Member::_dosToUnixTime($dos_time); + is($unix_time, $round_trip, 'Got expected DOS DateTime value'); +} + +##################################################################### +# Testing Archives + +#--------- empty file +# new # Archive::Zip +# new # Archive::Zip::Archive +my $zip = Archive::Zip->new(); +isa_ok($zip, 'Archive::Zip'); + +# members # Archive::Zip::Archive +my @members = $zip->members; +is(scalar(@members), 0, '->members is 0'); + +# numberOfMembers # Archive::Zip::Archive +my $numberOfMembers = $zip->numberOfMembers(); +is($numberOfMembers, 0, '->numberofMembers is 0'); + +# writeToFileNamed # Archive::Zip::Archive +my $status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK, '->writeToFileNames ok'); + +my $zipout; +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + if ($^O eq 'MSWin32') { + print STDERR + "\n# You might see an expected 'zipfile is empty' warning now.\n"; + } + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + + skip("test zip doesn't work", 1) if $testZipDoesntWork; + + skip("freebsd's unzip doesn't care about empty zips", 1) + if $^O eq 'freebsd'; + + ok($status != 0); +} + +# unzip -t returns error code=1 for warning on empty + +#--------- add a directory +my $memberName = TESTDIR . '/'; +my $dirName = TESTDIR; + +# addDirectory # Archive::Zip::Archive +# new # Archive::Zip::Member +my $member = $zip->addDirectory($memberName); +ok(defined($member)); +is($member->fileName(), $memberName); + +# On some (Windows systems) the modification time is +# corrupted. Save this to check late. +my $dir_time = $member->lastModFileDateTime(); + +# members # Archive::Zip::Archive +@members = $zip->members(); +is(scalar(@members), 1); +is($members[0], $member); + +# numberOfMembers # Archive::Zip::Archive +$numberOfMembers = $zip->numberOfMembers(); +is($numberOfMembers, 1); + +# writeToFileNamed # Archive::Zip::Archive +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +# Does the modification time get corrupted? +is(($zip->members)[0]->lastModFileDateTime(), $dir_time); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- extract the directory by name +rmtree([TESTDIR], 0, 0); +$status = $zip->extractMember($memberName); +is($status, AZ_OK); +ok(-d $dirName); + +#--------- extract the directory by identity +ok(rmdir($dirName)); # it's still empty +$status = $zip->extractMember($member); +is($status, AZ_OK); +ok(-d $dirName); + +#--------- add a string member, uncompressed +$memberName = TESTDIR . '/string.txt'; + +# addString # Archive::Zip::Archive +# newFromString # Archive::Zip::Member +$member = $zip->addString(TESTSTRING, $memberName); +ok(defined($member)); + +is($member->fileName(), $memberName); + +# members # Archive::Zip::Archive +@members = $zip->members(); +is(scalar(@members), 2); +is($members[1], $member); + +# numberOfMembers # Archive::Zip::Archive +$numberOfMembers = $zip->numberOfMembers(); +is($numberOfMembers, 2); + +# writeToFileNamed # Archive::Zip::Archive +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +is($member->crc32(), TESTSTRINGCRC); + +is($member->crc32String(), sprintf("%08x", TESTSTRINGCRC)); + +#--------- extract it by name +$status = $zip->extractMember($memberName); +is($status, AZ_OK); +ok(-f $memberName); +is(fileCRC($memberName), TESTSTRINGCRC); + +#--------- now compress it and re-test +my $oldCompressionMethod = + $member->desiredCompressionMethod(COMPRESSION_DEFLATED); +is($oldCompressionMethod, COMPRESSION_STORED, 'old compression method OK'); + +# writeToFileNamed # Archive::Zip::Archive +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK, 'writeToFileNamed returns AZ_OK'); +is($member->crc32(), TESTSTRINGCRC); +is($member->uncompressedSize(), TESTSTRINGLENGTH); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- extract it by name +$status = $zip->extractMember($memberName); +is($status, AZ_OK); +ok(-f $memberName); +is(fileCRC($memberName), TESTSTRINGCRC); + +#--------- add a file member, compressed +ok(rename($memberName, TESTDIR . '/file.txt')); +$memberName = TESTDIR . '/file.txt'; + +# addFile # Archive::Zip::Archive +# newFromFile # Archive::Zip::Member +$member = $zip->addFile($memberName); +ok(defined($member)); + +is($member->desiredCompressionMethod(), COMPRESSION_DEFLATED); + +# writeToFileNamed # Archive::Zip::Archive +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); +is($member->crc32(), TESTSTRINGCRC); +is($member->uncompressedSize(), TESTSTRINGLENGTH); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- extract it by name (note we have to rename it first +#--------- or we will clobber the original file +my $newName = $memberName; +$newName =~ s/\.txt/2.txt/; +$status = $zip->extractMember($memberName, $newName); +is($status, AZ_OK); +ok(-f $newName); +is(fileCRC($newName), TESTSTRINGCRC); + +#--------- now make it uncompressed and re-test +$oldCompressionMethod = $member->desiredCompressionMethod(COMPRESSION_STORED); + +is($oldCompressionMethod, COMPRESSION_DEFLATED); + +# writeToFileNamed # Archive::Zip::Archive +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); +is($member->crc32(), TESTSTRINGCRC); +is($member->uncompressedSize(), TESTSTRINGLENGTH); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- extract it by name +$status = $zip->extractMember($memberName, $newName); +is($status, AZ_OK); +ok(-f $newName); +is(fileCRC($newName), TESTSTRINGCRC); + +# Now, the contents of OUTPUTZIP are: +# Length Method Size Ratio Date Time CRC-32 Name +#-------- ------ ------- ----- ---- ---- ------ ---- +# 0 Stored 0 0% 03-17-00 11:16 00000000 testDir/ +# 300 Defl:N 146 51% 03-17-00 11:16 ac373f32 testDir/string.txt +# 300 Stored 300 0% 03-17-00 11:16 ac373f32 testDir/file.txt +#-------- ------- --- ------- +# 600 446 26% 3 files + +# members # Archive::Zip::Archive +@members = $zip->members(); +is(scalar(@members), 3); +is($members[2], $member); + +# memberNames # Archive::Zip::Archive +my @memberNames = $zip->memberNames(); +is(scalar(@memberNames), 3); +is($memberNames[2], $memberName); + +# memberNamed # Archive::Zip::Archive +is($zip->memberNamed($memberName), $member); + +# membersMatching # Archive::Zip::Archive +@members = $zip->membersMatching('file'); +is(scalar(@members), 1); +is($members[0], $member); + +@members = $zip->membersMatching('.txt$'); +is(scalar(@members), 2); +is($members[1], $member); + +#--------- remove the string member and test the file +# removeMember # Archive::Zip::Archive +$member = $zip->removeMember($members[0]); +is($member, $members[0]); + +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- add the string member at the end and test the file +# addMember # Archive::Zip::Archive +$zip->addMember($member); +@members = $zip->members(); + +is(scalar(@members), 3); +is($members[2], $member); + +# memberNames # Archive::Zip::Archive +@memberNames = $zip->memberNames(); +is(scalar(@memberNames), 3); +is($memberNames[1], $memberName); + +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- remove the file member +$member = $zip->removeMember($members[1]); +is($member, $members[1]); +is($zip->numberOfMembers(), 2); + +#--------- replace the string member with the file member +# replaceMember # Archive::Zip::Archive +$member = $zip->replaceMember($members[2], $member); +is($member, $members[2]); +is($zip->numberOfMembers(), 2); + +#--------- re-add the string member +$zip->addMember($member); +is($zip->numberOfMembers(), 3); + +@members = $zip->members(); +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- add compressed file +$member = $zip->addFile(File::Spec->catfile(TESTDIR, 'file.txt')); +ok(defined($member)); +$member->desiredCompressionMethod(COMPRESSION_DEFLATED); +$member->fileName(TESTDIR . '/fileC.txt'); + +#--------- add uncompressed string +$member = $zip->addString(TESTSTRING, TESTDIR . '/stringU.txt'); +ok(defined($member)); +$member->desiredCompressionMethod(COMPRESSION_STORED); + +# Now, the file looks like this: +# Length Method Size Ratio Date Time CRC-32 Name +#-------- ------ ------- ----- ---- ---- ------ ---- +# 0 Stored 0 0% 03-17-00 12:30 00000000 testDir/ +# 300 Stored 300 0% 03-17-00 12:30 ac373f32 testDir/file.txt +# 300 Defl:N 146 51% 03-17-00 12:30 ac373f32 testDir/string.txt +# 300 Stored 300 0% 03-17-00 12:30 ac373f32 testDir/stringU.txt +# 300 Defl:N 146 51% 03-17-00 12:30 ac373f32 testDir/fileC.txt +#-------- ------- --- ------- +# 1200 892 26% 5 files + +@members = $zip->members(); +$numberOfMembers = $zip->numberOfMembers(); +is($numberOfMembers, 5); + +#--------- make sure the contents of the stored file member are OK. +# contents # Archive::Zip::Archive +is($zip->contents($members[1]), TESTSTRING); + +# contents # Archive::Zip::Member +is($members[1]->contents(), TESTSTRING); + +#--------- make sure the contents of the compressed string member are OK. +is($members[2]->contents(), TESTSTRING); + +#--------- make sure the contents of the stored string member are OK. +is($members[3]->contents(), TESTSTRING); + +#--------- make sure the contents of the compressed file member are OK. +is($members[4]->contents(), TESTSTRING); + +#--------- write to INPUTZIP +$status = $zip->writeToFileNamed(INPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(INPUTZIP); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- read from INPUTZIP (appending its entries) +# read # Archive::Zip::Archive +$status = $zip->read(INPUTZIP); +is($status, AZ_OK); +is($zip->numberOfMembers(), 10); + +#--------- clean up duplicate names +@members = $zip->members(); +$member = $zip->removeMember($members[5]); +is($member->fileName(), TESTDIR . '/'); + +SCOPE: { + for my $i (6 .. 9) { + $memberName = $members[$i]->fileName(); + $memberName =~ s/\.txt/2.txt/; + $members[$i]->fileName($memberName); + } +} +is(scalar($zip->membersMatching('2.txt')), 4); + +#--------- write zip out and test it. +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- Make sure that we haven't renamed files (this happened!) +is(scalar($zip->membersMatching('2\.txt$')), 4); + +#--------- Now try extracting everyone +@members = $zip->members(); +is($zip->extractMember($members[0]), AZ_OK); #DM +is($zip->extractMember($members[1]), AZ_OK); #NFM +is($zip->extractMember($members[2]), AZ_OK); +is($zip->extractMember($members[3]), AZ_OK); #NFM +is($zip->extractMember($members[4]), AZ_OK); +is($zip->extractMember($members[5]), AZ_OK); +is($zip->extractMember($members[6]), AZ_OK); +is($zip->extractMember($members[7]), AZ_OK); +is($zip->extractMember($members[8]), AZ_OK); + +#--------- count dirs +{ + my @dirs = grep { $_->isDirectory() } @members; + is(scalar(@dirs), 1); + is($dirs[0], $members[0]); +} + +#--------- count binary and text files +{ + my @binaryFiles = grep { $_->isBinaryFile() } @members; + my @textFiles = grep { $_->isTextFile() } @members; + is(scalar(@binaryFiles), 5); + is(scalar(@textFiles), 4); +} + +#--------- Try writing zip file to file handle +{ + my $fh; + if ($catWorks) { + unlink(OUTPUTZIP); + $fh = FileHandle->new(CATPIPE . OUTPUTZIP); + binmode($fh); + } + SKIP: { + skip('cat does not work on this platform', 1) unless $catWorks; + ok($fh); + } + + # $status = $zip->writeToFileHandle($fh, 0) if ($catWorks); + $status = $zip->writeToFileHandle($fh) if ($catWorks); + SKIP: { + skip('cat does not work on this platform', 1) unless $catWorks; + is($status, AZ_OK); + } + $fh->close() if ($catWorks); + SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + is($status, 0); + } +} + +#--------- Change the contents of a string member +is(ref($members[2]), 'Archive::Zip::StringMember'); +$members[2]->contents("This is my new contents\n"); + +#--------- write zip out and test it. +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- Change the contents of a file member +is(ref($members[1]), 'Archive::Zip::NewFileMember'); +$members[1]->contents("This is my new contents\n"); + +#--------- write zip out and test it. +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- Change the contents of a zip member + +is(ref($members[7]), 'Archive::Zip::ZipFileMember'); +$members[7]->contents("This is my new contents\n"); + +#--------- write zip out and test it. +$status = $zip->writeToFileNamed(OUTPUTZIP); +is($status, AZ_OK); + +SKIP: { + skip("No 'unzip' program to test against", 1) unless HAVEUNZIP; + ($status, $zipout) = testZip(); + + # STDERR->print("status= $status, out=$zipout\n"); + skip("test zip doesn't work", 1) if $testZipDoesntWork; + is($status, 0); +} + +#--------- now clean up +# END { system("rm -rf " . TESTDIR . " " . OUTPUTZIP . " " . INPUTZIP) } + +#--------------------- STILL UNTESTED IN THIS SCRIPT --------------------- + +# sub setChunkSize # Archive::Zip +# sub _formatError # Archive::Zip +# sub _error # Archive::Zip +# sub _subclassResponsibility # Archive::Zip +# sub diskNumber # Archive::Zip::Archive +# sub diskNumberWithStartOfCentralDirectory # Archive::Zip::Archive +# sub numberOfCentralDirectoriesOnThisDisk # Archive::Zip::Archive +# sub numberOfCentralDirectories # Archive::Zip::Archive +# sub centralDirectoryOffsetWRTStartingDiskNumber # Archive::Zip::Archive +# sub extraField # Archive::Zip::Member +# sub isEncrypted # Archive::Zip::Member +# sub isTextFile # Archive::Zip::Member +# sub isBinaryFile # Archive::Zip::Member +# sub isDirectory # Archive::Zip::Member +# sub lastModTime # Archive::Zip::Member +# sub _writeDataDescriptor # Archive::Zip::Member +# sub isDirectory # Archive::Zip::DirectoryMember +# sub _becomeDirectory # Archive::Zip::DirectoryMember +# sub diskNumberStart # Archive::Zip::ZipFileMember diff --git a/t/03_ex.t b/t/03_ex.t new file mode 100644 index 0000000..84a8c71 --- /dev/null +++ b/t/03_ex.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); +use File::Spec; +use IO::File; + +use Test::More tests => 17; +use t::common; + +sub runPerlCommand { + my $libs = join(' -I', @INC); + my $cmd = "\"$^X\" \"-I$libs\" -w \"" . join('" "', @_) . '"'; + my $output = `$cmd`; + return wantarray ? ($?, $output) : $?; +} + +use constant FILENAME => File::Spec->catpath('', TESTDIR, 'testing.txt'); +use constant ZFILENAME => TESTDIR . "/testing.txt"; # name in zip + +my $zip = Archive::Zip->new(); +isa_ok($zip, 'Archive::Zip'); +$zip->addString(TESTSTRING, FILENAME); +$zip->writeToFileNamed(INPUTZIP); + +my ($status, $output); +my $fh = IO::File->new("test.log", "w"); +isa_ok($fh, 'IO::File'); + +is(runPerlCommand('examples/copy.pl', INPUTZIP, OUTPUTZIP), 0); + +is(runPerlCommand('examples/extract.pl', OUTPUTZIP, ZFILENAME), 0); + +is(runPerlCommand('examples/mfh.pl', INPUTZIP), 0); + +is(runPerlCommand('examples/zip.pl', OUTPUTZIP, INPUTZIP, FILENAME), 0); + +($status, $output) = runPerlCommand('examples/zipinfo.pl', INPUTZIP); +is($status, 0); +$fh->print("zipinfo output:\n"); +$fh->print($output); + +($status, $output) = runPerlCommand('examples/ziptest.pl', INPUTZIP); +is($status, 0); +$fh->print("ziptest output:\n"); +$fh->print($output); + +($status, $output) = runPerlCommand('examples/zipGrep.pl', '100', INPUTZIP); +is($status, 0); +is($output, ZFILENAME . ":100\n"); + +# calcSizes.pl +# creates test.zip, may be sensitive to /dev/null + +# removed because requires IO::Scalar +# ok( runPerlCommand('examples/readScalar.pl'), 0 ); + +unlink(OUTPUTZIP); +is(runPerlCommand('examples/selfex.pl', OUTPUTZIP, FILENAME), 0); +unlink(FILENAME); +is(runPerlCommand(OUTPUTZIP), 0); +my $fn = File::Spec->catpath('', File::Spec->catdir('extracted', TESTDIR), + 'testing.txt'); +is(-f $fn, 1, "$fn exists"); + +# unzipAll.pl +# updateZip.pl +# writeScalar.pl +# zipcheck.pl +# ziprecent.pl + +unlink(OUTPUTZIP); +is(runPerlCommand('examples/updateTree.pl', OUTPUTZIP, TESTDIR), + 0, "updateTree.pl create"); +is(-f OUTPUTZIP, 1, "zip created"); +is(runPerlCommand('examples/updateTree.pl', OUTPUTZIP, TESTDIR), + 0, "updateTree.pl update"); +is(-f OUTPUTZIP, 1, "zip updated"); +unlink(OUTPUTZIP); diff --git a/t/04_readmember.t b/t/04_readmember.t new file mode 100644 index 0000000..8b204e9 --- /dev/null +++ b/t/04_readmember.t @@ -0,0 +1,62 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); +use Archive::Zip::MemberRead; + +use Test::More tests => 10; +use t::common; + +use constant FILENAME => File::Spec->catfile(TESTDIR, 'member_read.zip'); + +my ($zip, $member, $fh, @data); +$zip = new Archive::Zip; +isa_ok($zip, 'Archive::Zip'); +@data = ('Line 1', 'Line 2', '', 'Line 3', 'Line 4'); + +$zip->addString(join("\n", @data), 'string.txt'); +$zip->writeToFileNamed(FILENAME); + +$member = $zip->memberNamed('string.txt'); +$fh = $member->readFileHandle(); +ok($fh); + +my ($line, $not_ok, $ret, $buffer); +while (defined($line = $fh->getline())) { + $not_ok = 1 if ($line ne $data[$fh->input_line_number() - 1]); +} +SKIP: { + if ($^O eq 'MSWin32') { + skip("Ignoring failing test on Win32", 1); + } + ok(!$not_ok); +} + +my $member_read = Archive::Zip::MemberRead->new($zip, 'string.txt'); +$line = $member_read->getline({'preserve_line_ending' => 1}); +is($line, "Line 1\n", 'Preserve line ending'); +$line = $member_read->getline({'preserve_line_ending' => 0}); +is($line, "Line 2", 'Do not preserve line ending'); + +$fh->rewind(); +$ret = $fh->read($buffer, length($data[0])); +ok($ret == length($data[0])); +ok($buffer eq $data[0]); +$fh->close(); + +# +# Different usages +# +$fh = new Archive::Zip::MemberRead($zip, 'string.txt'); +ok($fh); + +$fh = new Archive::Zip::MemberRead($zip, $zip->memberNamed('string.txt')); +ok($fh); + +$fh = new Archive::Zip::MemberRead($zip->memberNamed('string.txt')); +ok($fh); diff --git a/t/05_tree.t b/t/05_tree.t new file mode 100644 index 0000000..91bc3f5 --- /dev/null +++ b/t/05_tree.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use strict; + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); +use FileHandle; +use File::Spec; + +use Test::More tests => 6; +use t::common; + +use constant FILENAME => File::Spec->catfile(TESTDIR, 'testing.txt'); + +my $zip; +my @memberNames; + +sub makeZip { + my ($src, $dest, $pred) = @_; + $zip = Archive::Zip->new(); + $zip->addTree($src, $dest, $pred); + @memberNames = $zip->memberNames(); +} + +sub makeZipAndLookFor { + my ($src, $dest, $pred, $lookFor) = @_; + makeZip($src, $dest, $pred); + ok(@memberNames); + ok((grep { $_ eq $lookFor } @memberNames) == 1) + or print STDERR "Can't find $lookFor in (" + . join(",", @memberNames) . ")\n"; +} + +my ($testFileVolume, $testFileDirs, $testFileName) = File::Spec->splitpath($0); + +makeZipAndLookFor('.', '', sub { print "file $_\n"; -f && /\.t$/ }, + 't/02_main.t'); +makeZipAndLookFor('.', 'e/', sub { -f && /\.t$/ }, 'e/t/02_main.t'); +makeZipAndLookFor('./t', '', sub { -f && /\.t$/ }, '02_main.t'); diff --git a/t/06_update.t b/t/06_update.t new file mode 100644 index 0000000..31b09d3 --- /dev/null +++ b/t/06_update.t @@ -0,0 +1,73 @@ +#!/usr/bin/perl + +# Test Archive::Zip updating + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use File::Spec (); +use IO::File (); +use File::Find (); +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); + +use Test::More tests => 12; +use t::common; + +my ($testFileVolume, $testFileDirs, $testFileName) = File::Spec->splitpath($0); + +my $zip = Archive::Zip->new(); +my $testDir = File::Spec->catpath($testFileVolume, $testFileDirs, ''); + +my $numberOfMembers = 0; +my @memberNames; + +sub countMembers { + unless ($_ eq '.') { push(@memberNames, $_); $numberOfMembers++; } +} +File::Find::find(\&countMembers, $testDir); +is($numberOfMembers > 1, 1, 'not enough members to test'); + +# an initial updateTree() should act like an addTree() +is($zip->updateTree($testDir), AZ_OK, 'initial updateTree failed'); +is(scalar($zip->members()), + $numberOfMembers, 'wrong number of members after create'); + +my $firstFile = $memberNames[0]; +my $firstMember = ($zip->members())[0]; + +is($firstFile, $firstMember->fileName(), 'member name wrong'); + +# add a file to the directory +$testFileName = File::Spec->catpath($testFileVolume, $testFileDirs, 'xxxxxx'); +my $fh = IO::File->new($testFileName, 'w'); +$fh->print('xxxx'); +undef($fh); +is(-f $testFileName, 1, "creating $testFileName failed"); + +# Then update it. It should be added. +is($zip->updateTree($testDir), AZ_OK, 'updateTree failed'); +is( + scalar($zip->members()), + $numberOfMembers + 1, + 'wrong number of members after update' +); + +# Delete the file. +unlink($testFileName); +is(-f $testFileName, undef, "deleting $testFileName failed"); + +# updating without the mirror option should keep the members +is($zip->updateTree($testDir), AZ_OK, 'updateTree failed'); +is( + scalar($zip->members()), + $numberOfMembers + 1, + 'wrong number of members after update' +); + +# now try again with the mirror option; should delete the last file. +is($zip->updateTree($testDir, undef, undef, 1), AZ_OK, 'updateTree failed'); +is(scalar($zip->members()), + $numberOfMembers, 'wrong number of members after mirror'); diff --git a/t/07_filenames_of_0.t b/t/07_filenames_of_0.t new file mode 100644 index 0000000..5a9c4c1 --- /dev/null +++ b/t/07_filenames_of_0.t @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +# These are regression tests for: +# http://rt.cpan.org/Public/Bug/Display.html?id=27463 +# http://rt.cpan.org/Public/Bug/Display.html?id=76780 +# +# It tests that one can add files to the archive whose filenames are "0". + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More tests => 3; +use Archive::Zip; + +use File::Path; +use File::Spec; + +use t::common; + +mkpath([File::Spec->catdir(TESTDIR, 'folder')]); + +my $zero_file = File::Spec->catfile(TESTDIR, 'folder', "0"); +open(O, ">$zero_file"); +print O "File 0\n"; +close(O); + +my $one_file = File::Spec->catfile(TESTDIR, 'folder', '1'); +open(O, ">$one_file"); +print O "File 1\n"; +close(O); + +my $archive = Archive::Zip->new; + +$archive->addTree(File::Spec->catfile(TESTDIR, 'folder'), 'folder',); + +# TEST +ok( + scalar(grep { $_ eq "folder/0" } $archive->memberNames()), + "Checking that a file called '0' was added properly" +); + +rmtree([File::Spec->catdir(TESTDIR, 'folder')]); + +# Cannot create member called "0" with addString +{ + # Create member "0" with addString + my $archive = Archive::Zip->new; + my $string_member = $archive->addString(TESTSTRING => 0); + $archive->writeToFileNamed(OUTPUTZIP); +} + +{ + + # Read member "0" + my $archive = Archive::Zip->new; + is($archive->read(OUTPUTZIP), Archive::Zip::AZ_OK); + ok(scalar(grep { $_ eq "0" } $archive->memberNames()), + "Checking that a file called '0' was added properly by addString"); +} +unlink(OUTPUTZIP); diff --git a/t/08_readmember_record_sep.t b/t/08_readmember_record_sep.t new file mode 100644 index 0000000..5522dfd --- /dev/null +++ b/t/08_readmember_record_sep.t @@ -0,0 +1,139 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); +use Archive::Zip::MemberRead; +use File::Spec; + +use Test::More; + +BEGIN { + if ($^O eq 'MSWin32') { + plan(skip_all => 'Ignoring failing tests on Win32'); + } else { + plan(tests => 13); + } +} +use t::common; + +SCOPE: { + my $filename = File::Spec->catfile(TESTDIR, "member_read_xml_like1.zip"); + my $zip = new Archive::Zip; + + # TEST + isa_ok($zip, "Archive::Zip", "Testing that \$zip is an Archive::Zip"); + + my $data = <<"EOF"; +One Line +Two Lines +</tag> +Three Lines +Four Lines +Five Lines +</tag> +Quant +Bant +</tag> +Zapta +EOF + + $zip->addString($data, "string.txt"); + $zip->writeToFileNamed($filename); + + { + # Testing for normal line-based reading. + my $member = $zip->memberNamed("string.txt"); + my $fh = $member->readFileHandle(); + + # TEST + ok($fh, "Filehandle is valid"); + + # TEST + is($fh->getline(), "One Line", + "Testing the first line in a normal read."); + + # TEST + is($fh->getline(), "Two Lines", + "Testing the second line in a normal read."); + } + + { + # Testing for setting the input record separator of the Perl + # global variable. + + local $/ = "</tag>\n"; + + my $member = $zip->memberNamed("string.txt"); + my $fh = $member->readFileHandle(); + + # TEST + ok($fh, "Filehandle is valid"); + + # TEST + is( + $fh->getline(), + "One Line\nTwo Lines\n", + "Testing the first \"line\" when \$/ is set." + ); + + # TEST + is( + $fh->getline(), + "Three Lines\nFour Lines\nFive Lines\n", + "Testing the second \"line\" when \$/ is set." + ); + } + + { + # Testing for setting input_record_separator in the filehandle. + + my $member = $zip->memberNamed("string.txt"); + my $fh = $member->readFileHandle(); + + # TEST + ok($fh, "Filehandle is valid"); + + $fh->input_record_separator("</tag>\n"); + + # TEST + is( + $fh->getline(), + "One Line\nTwo Lines\n", + "Testing the first line when input_record_separator is set." + ); + + # TEST + is( + $fh->getline(), + "Three Lines\nFour Lines\nFive Lines\n", + "Testing the second line when input_record_separator is set." + ); + } + { + # Test setting both input_record_separator in the filehandle + # and in Perl. + + local $/ = "</t"; + + my $member = $zip->memberNamed("string.txt"); + my $fh = $member->readFileHandle(); + + # TEST + ok($fh, "Filehandle is valid"); + + $fh->input_record_separator(" "); + + # TEST + is($fh->getline(), "One", + "Testing the first \"line\" in a both set read"); + + # TEST + is($fh->getline(), "Line\nTwo", + "Testing the second \"line\" in a both set read."); + } +} diff --git a/t/09_output_record_sep.t b/t/09_output_record_sep.t new file mode 100644 index 0000000..d7331b2 --- /dev/null +++ b/t/09_output_record_sep.t @@ -0,0 +1,127 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 6; +use File::Spec (); +use File::Spec::Unix (); +use Archive::Zip qw( :ERROR_CODES ); + +my $expected_fn = + File::Spec->catfile(File::Spec->curdir, "t", "badjpeg", "expected.jpg"); +my $expected_zip = + File::Spec::Unix->catfile(File::Spec::Unix->curdir, "t", "badjpeg", + "expected.jpg",); + +my $got_fn = "got.jpg"; +my $archive_fn = "out.zip"; +my ($before, $after); + +sub slurp_file { + my $filename = shift; + open my $fh, "<$filename" + or die 'Can not open file'; + my $contents; + binmode($fh); + SCOPE: { + local $/; + $contents = <$fh>; + } + close $fh; + return $contents; +} + +sub binary_is { + my ($got, $expected, $msg) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $verdict = ($got eq $expected); + ok($verdict, $msg); + if (!$verdict) { + my $len; + if (length($got) > length($expected)) { + $len = length($expected); + diag("got is longer than expected"); + } elsif (length($got) < length($expected)) { + $len = length($got); + diag("expected is longer than got"); + } else { + $len = length($got); + } + + BYTE_LOOP: + for my $byte_idx (0 .. ($len - 1)) { + my $got_byte = substr($got, $byte_idx, 1); + my $expected_byte = substr($expected, $byte_idx, 1); + if ($got_byte ne $expected_byte) { + diag( + sprintf( + "Byte %i differ: got == 0x%.2x, expected == 0x%.2x", + $byte_idx, ord($got_byte), ord($expected_byte))); + last BYTE_LOOP; + } + } + } +} + +sub run_tests { + my $id = shift; + my $msg_it = sub { + my $msg_raw = shift; + return "$id - $msg_raw"; + }; + + # Read the contents of the good file into the variable. + $before = slurp_file($expected_fn); + + # Zip the file. + SCOPE: { + my $zip = Archive::Zip->new(); + $zip->addFile($expected_fn); + $zip->extractMember($expected_zip, $got_fn); + $after = slurp_file($got_fn); + + unlink $got_fn; + + # TEST:$n=$n+1 + binary_is($after, $before, + $msg_it->("Content of file after extraction"), + ); + + my $status = $zip->writeToFileNamed($archive_fn); + + # TEST:$n=$n+1 + cmp_ok($status, '==', AZ_OK, $msg_it->('Zip was written fine')); + } + + # Read back the file from the archive. + SCOPE: { + my $zip2; + $zip2 = Archive::Zip->new($archive_fn); + + $zip2->extractMember($expected_zip, $got_fn); + + $after = slurp_file($got_fn); + + unlink $got_fn; + unlink $archive_fn; + + # TEST:$n=$n+1 + binary_is($after, $before, + $msg_it->('Read back the file from the archive'), + ); + } +} + +# Run the tests once with $\ undef. +run_tests("Normal"); + +# Run them once while setting $\. +SCOPE: { + local $\ = "\n"; + run_tests(q{$\ is \n}); +} diff --git a/t/10_chmod.t b/t/10_chmod.t new file mode 100644 index 0000000..711beef --- /dev/null +++ b/t/10_chmod.t @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Test::More; +use File::Spec; +use File::Path; +use Archive::Zip; + +use t::common; + +sub get_perm { + my $filename = shift; + + return (((stat($filename))[2]) & 07777); +} + +sub test_if_chmod_is_working { + my $test_dir = File::Spec->rel2abs(File::Spec->catdir(TESTDIR, "chtest")); + + my $test_file = File::Spec->catfile($test_dir, "test.file"); + + mkdir($test_dir, 0755); + + open my $out, ">$test_file"; + print {$out} "Foobar."; + close($out); + + my $test_perm = sub { + my $perm = shift; + + chmod($perm, $test_file); + + return (get_perm($test_file) == $perm); + }; + + my $verdict = $test_perm->(0444) && $test_perm->(0666); + + # Clean up + rmtree($test_dir); + + return $verdict; +} + +if (!test_if_chmod_is_working()) { + plan skip_all => "chmod() is not working on this machine."; +} else { + plan tests => 1; +} + +my $zip = Archive::Zip->new(); + +$zip->read(File::Spec->catfile(File::Spec->curdir(), "t", "data", "chmod.zip")); + +my $test_dir = File::Spec->catdir(File::Spec->curdir(), "testdir", "chtest"); + +mkdir($test_dir, 0777); + +my $test_file = File::Spec->catfile($test_dir, "test_file"); + +$zip->memberNamed("test_dir/test_file")->extractToFileNamed($test_file); + +# TEST +is(get_perm($test_file), 0444, "File permission is OK."); + +# Clean up. +rmtree($test_dir); + diff --git a/t/11_explorer.t b/t/11_explorer.t new file mode 100644 index 0000000..7f3053a --- /dev/null +++ b/t/11_explorer.t @@ -0,0 +1,23 @@ +#!/use/bin/perl + +# Check Windows Explorer compatible directories + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 4; +use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); + +my $zip = Archive::Zip->new; +isa_ok($zip, 'Archive::Zip'); +my $member = $zip->addDirectory('foo/'); +ok(defined($member), 'Created a member'); +is($member->fileName, 'foo/', '->fileName ok'); +ok( + $member->externalFileAttributes & 16, + 'Directory has directory bit set as expected by Windows Explorer', +); diff --git a/t/12_bug_47223.t b/t/12_bug_47223.t new file mode 100644 index 0000000..685a57d --- /dev/null +++ b/t/12_bug_47223.t @@ -0,0 +1,34 @@ +#!/use/bin/perl + +# Check Windows Explorer compatible directories + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More; +use Archive::Zip; +use File::Temp; +use File::Spec; + +if ($^O eq 'MSWin32') { + plan(tests => 1); +} else { + plan(skip_all => 'Only required on Win32.'); +} + +my $dist = Win32::GetShortPathName( + File::Spec->rel2abs(File::Spec->catfile(qw(t data winzip.zip)))); +my $tmpdirname = File::Spec->catdir(File::Spec->tmpdir, "parXXXXX"); +my $tmpdir = File::Temp::mkdtemp($tmpdirname) + or die "Could not create temporary directory from template '$tmpdirname': $!"; +my $path = $tmpdir; +$path = File::Spec->catdir($tmpdir, 'test'); + +my $zip = Archive::Zip->new(); + +$zip->read($dist); +ok(eval { $zip->extractTree('', "$path/"); 1; }); diff --git a/t/13_bug_46303.t b/t/13_bug_46303.t new file mode 100644 index 0000000..b5a685a --- /dev/null +++ b/t/13_bug_46303.t @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} +use Archive::Zip qw( :ERROR_CODES ); +use Test::More tests => 4; + +my $zip = Archive::Zip->new(); +isa_ok($zip, 'Archive::Zip'); +is($zip->read('t/data/perl.zip'), AZ_OK, 'Read file'); + +is($zip->extractTree(undef, 'extracted/xTree'), AZ_OK, 'Extracted archive'); +ok(-d 'extracted/xTree/foo', 'Checked directory'); diff --git a/t/14_leading_separator.t b/t/14_leading_separator.t new file mode 100644 index 0000000..209b4db --- /dev/null +++ b/t/14_leading_separator.t @@ -0,0 +1,48 @@ +#!perl + +# Test the bug-fix for the following bug: +# Buggy behaviour: +# Adding file or directory by absolute path results in leading separator +# being stored in member name. +# Expected behaviour: +# Discard leading separator +# Bug report: http://tech.groups.yahoo.com/group/perl-beginner/message/27085 + +use strict; + +BEGIN { + $^W = 1; +} + +use Test::More tests => 1; +use Archive::Zip; + +use Cwd (); +use File::Spec (); + +use t::common; + +my $file_relative_path = File::Spec->catfile(TESTDIR, 'file.txt'); +open FH, ">$file_relative_path"; +close FH; +my $file_absolute_path = File::Spec->rel2abs($file_relative_path); + +my $az = Archive::Zip->new(); +$az->addFile($file_absolute_path); + +if ($^O eq 'MSWin32') { + + # remove volume from absolute file path + my (undef, $directory_path, $current_directory) = + File::Spec->splitpath(Cwd::getcwd(), $file_relative_path); + $file_absolute_path = + File::Spec->catfile($directory_path, $current_directory, + $file_relative_path); + + $file_absolute_path =~ s{\\}{/}g; # convert to Unix separators +} + +# expect path without leading separator +(my $expected_member_name = $file_absolute_path) =~ s{^/}{}; +my ($member_name) = $az->memberNames(); +is($member_name, $expected_member_name, 'no leading separator'); diff --git a/t/15_decrypt.t b/t/15_decrypt.t new file mode 100644 index 0000000..fa980d4 --- /dev/null +++ b/t/15_decrypt.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN { $| = 1; } + +use Archive::Zip qw( :ERROR_CODES ); +use Test::More; + +foreach my $pass (qw( wrong test )) { + my $zip = Archive::Zip->new(); + isa_ok($zip, "Archive::Zip"); + + is($zip->read("t/data/crypt.zip"), AZ_OK, "Read file"); + + ok(my @mn = $zip->memberNames, "get memberNames"); + is_deeply(\@mn, ["decrypt.txt"], "memberNames"); + + ok(my $m = $zip->memberNamed($mn[0]), "find member"); + isa_ok($m, "Archive::Zip::Member"); + + is($m->password($pass), $pass, "set password"); + is($m->password(), $pass, "get password"); + is( + $m->contents, + $pass eq "test" + ? "encryption test\n" + : "", + "Decoded buffer" + ); +} + +done_testing; diff --git a/t/16_decrypt.t b/t/16_decrypt.t new file mode 100644 index 0000000..2e5f32f --- /dev/null +++ b/t/16_decrypt.t @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +BEGIN { $| = 1; } + +use Archive::Zip qw( :ERROR_CODES ); +use Test::More; + +my $zip = Archive::Zip->new(); +isa_ok($zip, "Archive::Zip"); +is($zip->read("t/data/crypcomp.zip"), AZ_OK, "Read file"); + +ok(my @mn = $zip->memberNames, "get memberNames"); +is_deeply(\@mn, ["test"], "memberNames"); +ok(my $m = $zip->memberNamed($mn[0]), "find member"); +isa_ok($m, "Archive::Zip::Member"); + +is($m->password("test"), "test", "correct password"); +is($m->contents, "encryption test\n" x 100, "Decoded buffer"); + +done_testing; diff --git a/t/17_101092.t b/t/17_101092.t new file mode 100644 index 0000000..2b2983b --- /dev/null +++ b/t/17_101092.t @@ -0,0 +1,34 @@ +#!/use/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 2; +use t::common; + +# RT #101092: Creation of non-standard streamed zip file + +# Test that reading a zip file that contains a streamed member, then writing +# it without modification will set the local header fields for crc, compressed +# length & uncompressed length all to zero. + +# streamed.zip can be created with the following one-liner: +# +# perl -MIO::Compress::Zip=zip -e 'zip \"abc" => "streamed.zip", Name => "fred", Stream => 1, Method =>8' + +my $infile = "t/data/streamed.zip"; +my $outfile = OUTPUTZIP; +passthrough($infile, $outfile); + +my $before = readFile($infile); +my $after = readFile($outfile); + +my ($status, $reason) = testZip($outfile); +is $status, 0 + or warn("ziptest said: $reason\n"); +ok $before eq $after; + diff --git a/t/18_bug_92205.t b/t/18_bug_92205.t new file mode 100644 index 0000000..e1c1470 --- /dev/null +++ b/t/18_bug_92205.t @@ -0,0 +1,117 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 32; +use t::common; +use Archive::Zip qw( :CONSTANTS ); + + +# RT #92205: CRC error when re-writing Zip created by LibreOffice + +# Archive::Zip was blowing up when processing member +# 'Configurations2/accelerator/current.xml' from the LibreOffice file. +# +# 'current.xml' is a zero length file that has been compressed AND uses +# streaming. That means the uncompressed length is zero but the compressed +# length is greater than 0. +# +# The fix for issue #101092 added code that forced both the uncompressed & +# compressed lengths to be zero if either was zero. That caused this issue. + + +# This set of test checks that a zero length zip member will ALWAYS be +# mapped to a zero length Stored member, regardless of the compression +# method used or the use of streaming. +# +# +# Input files all contain a single zero length member. +# Streaming & Compression Method are set as follows. +# +# File Streamed Method +# =============================================== +# emptydef.zip No Deflate +# emptydefstr.zip Yes Deflate +# emptystore.zip No Store +# emptystorestr.zip Yes Store +# +# See t/data/mkzip.pl for the code used to create these zip files. + + +my @empty = map { "t/data/$_.zip" } + qw( emptydef emptydefstr emptystore emptystorestr ); + +# Implicit tests - check that stored gets used when no compression method +# has been set. +for my $infile (@empty) +{ + my $expectedout = "t/data/emptystore.zip"; + my $outfile = OUTPUTZIP; + + passthrough($infile, $outfile, sub { + my $member = shift ; + $member->setLastModFileDateTimeFromUnix($member->lastModTime()); + }); + + my $expected = readFile($expectedout); + my $after = readFile($outfile); + + my ($status, $reason) = testZip($outfile); + is $status, 0, "testZip ok after $infile to $outfile" + or warn("ziptest said: $reason\n"); + ok $expected eq $after, "$expectedout eq $outfile"; +} + + + +# Explicitly set desired compression +for my $method ( COMPRESSION_STORED, COMPRESSION_DEFLATED) +{ + for my $infile (@empty) + { + my $outfile = OUTPUTZIP; + my $expectedout = "t/data/emptystore.zip"; + + passthrough($infile, $outfile, sub { + my $member = shift ; + $member->desiredCompressionMethod( $method ); + $member->setLastModFileDateTimeFromUnix($member->lastModTime()); + }); + + my $expected = readFile($expectedout); + my $after = readFile($outfile); + + my ($status, $reason) = testZip($outfile); + is $status, 0, "[$method] testZip ok after $infile to $outfile" + or warn("ziptest said: $reason\n"); + ok $after eq $expected, "[$method] $infile eq $outfile"; + } +} + +# The following non-empty files should not be changed at all +my @nochange = map { "t/data/$_.zip" } + qw( def defstr store storestr ); + +for my $infile (@nochange) +{ + my $outfile = OUTPUTZIP; + + passthrough($infile, $outfile, sub { + my $member = shift ; + $member->setLastModFileDateTimeFromUnix($member->lastModTime()); + }); + + my $expected = readFile($infile); + my $after = readFile($outfile); + + my ($status, $reason) = testZip($outfile); + is $status, 0, "testZip ok after $infile to $outfile" + or warn("ziptest said: $reason\n"); + ok $expected eq $after, "$infile eq $outfile"; +} + diff --git a/t/19_bug_101240.t b/t/19_bug_101240.t new file mode 100755 index 0000000..a980f43 --- /dev/null +++ b/t/19_bug_101240.t @@ -0,0 +1,53 @@ +#!/usr/bin/perl + +use strict; + +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 4; +use File::Spec; +use File::Path; +use Archive::Zip qw(:CONSTANTS); + +use t::common; + +#101240: Possible issue with zero length files on Win32 when UNICODE is enabled + + +my $test_dir = File::Spec->catdir(TESTDIR, "empty"); +my $input_file = File::Spec->catfile($test_dir, "empty.zip"); +mkpath($test_dir); + +{ + # Create a zip file that contains a member where compressed size is 0 + + my $zip = Archive::Zip->new(); + my $string_member = $zip->addString( '', 'fred' ); + $string_member->desiredCompressionMethod( COMPRESSION_STORED ); + $zip->writeToFileNamed($input_file) ; +} + +for my $unicode (0, 1) +{ + local $Archive::Zip::UNICODE = $unicode; + + my $zip = Archive::Zip->new(); + + $zip->read($input_file); + + my $test_file = File::Spec->catfile($test_dir, "test_file$unicode"); + + $zip->memberNamed("fred")->extractToFileNamed($test_file); + + # TEST + ok -e $test_file, "[UNICODE=$unicode] output file exists"; + is -s $test_file, 0, "[UNICODE=$unicode] output file is empty"; + + # Clean up. + #unlink $test_file; +} + +#rmtree($test_dir); diff --git a/t/20_bug_github11.t b/t/20_bug_github11.t new file mode 100644 index 0000000..5bad5bd --- /dev/null +++ b/t/20_bug_github11.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl + +# Github 11: "CRC or size mismatch" when extracting member second time +# Test for correct functionality to prevent regression + +use strict; +use warnings; + +use Archive::Zip qw( :ERROR_CODES ); +use File::Spec; +use File::Path; +use t::common; + +use Test::More tests => 2; + +# create test env +my $GH_ISSUE = 'github11'; +my $TEST_NAME = "20_bug_$GH_ISSUE"; +my $TEST_DIR = File::Spec->catdir(TESTDIR, $TEST_NAME); +mkpath($TEST_DIR); + +# test 1 +my $DATA_DIR = File::Spec->catfile('t', 'data'); +my $GOOD_ZIP_FILE = File::Spec->catfile($DATA_DIR, "good_${GH_ISSUE}.zip"); +my $GOOD_ZIP = Archive::Zip->new($GOOD_ZIP_FILE); +my $MEMBER_FILE = 'FILE'; +my $member = $GOOD_ZIP->memberNamed($MEMBER_FILE); +my $OUT_FILE = File::Spec->catfile($TEST_DIR, "out"); +# Extracting twice triggered the bug +$member->extractToFileNamed($OUT_FILE); +is($member->extractToFileNamed($OUT_FILE), AZ_OK, 'Testing known good zip'); + +# test 2 +my $BAD_ZIP_FILE = File::Spec->catfile($DATA_DIR, "bad_${GH_ISSUE}.zip"); +my $BAD_ZIP = Archive::Zip->new($BAD_ZIP_FILE); +$member = $BAD_ZIP->memberNamed($MEMBER_FILE); +# Extracting twice triggered the bug +$member->extractToFileNamed($OUT_FILE); +is($member->extractToFileNamed($OUT_FILE), AZ_OK, 'Testing known bad zip'); diff --git a/t/21_zip64.t b/t/21_zip64.t new file mode 100644 index 0000000..f337db8 --- /dev/null +++ b/t/21_zip64.t @@ -0,0 +1,20 @@ +#!/usr/bin/perl + +# Test to make sure zip64 files are properly detected + +use strict; +use warnings; + +use Archive::Zip qw( :ERROR_CODES ); +use File::Spec; +use t::common; + +use Test::More tests => 1; + +my $DATA_DIR = File::Spec->catfile('t', 'data'); +my $ZIP_FILE = File::Spec->catfile($DATA_DIR, "zip64.zip"); + +my @errors = (); +$Archive::Zip::ErrorHandler = sub { push @errors, @_ }; +eval { Archive::Zip->new($ZIP_FILE) }; +ok($errors[0] =~ /zip64 not supported/, 'Got expected zip64 error'); diff --git a/t/22_deflated_dir.t b/t/22_deflated_dir.t new file mode 100644 index 0000000..dae2180 --- /dev/null +++ b/t/22_deflated_dir.t @@ -0,0 +1,25 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Archive::Zip qw( :ERROR_CODES ); +use File::Spec; +use t::common; + +use Test::More tests => 4; + +my $zip = Archive::Zip->new(); +isa_ok( $zip, 'Archive::Zip' ); +is( $zip->read(File::Spec->catfile('t', 'data', 'jar.zip')), AZ_OK, 'Read file' ); + +my $ret = eval { $zip->writeToFileNamed(OUTPUTZIP) }; + +is($ret, AZ_OK, 'Wrote file'); + +my ($status, $zipout) = testZip(); +# STDERR->print("status= $status, out=$zipout\n"); +SKIP: { + skip( "test zip doesn't work", 1 ) if $testZipDoesntWork; + is( $status, 0, "output zip isn't corrupted" ); +} diff --git a/t/badjpeg/expected.jpg b/t/badjpeg/expected.jpg Binary files differnew file mode 100755 index 0000000..0b362db --- /dev/null +++ b/t/badjpeg/expected.jpg diff --git a/t/badjpeg/source.zip b/t/badjpeg/source.zip Binary files differnew file mode 100755 index 0000000..7ad9663 --- /dev/null +++ b/t/badjpeg/source.zip diff --git a/t/common.pm b/t/common.pm new file mode 100644 index 0000000..cff8f78 --- /dev/null +++ b/t/common.pm @@ -0,0 +1,257 @@ +use strict; + +# Shared defs for test programs + +# Paths. Must make case-insensitive. +use File::Temp qw(tempfile tempdir); +use File::Spec; +BEGIN { mkdir 'testdir' } +use constant TESTDIR => do { + my $tmpdir = File::Spec->abs2rel(tempdir(DIR => 'testdir', CLEANUP => 1)); + $tmpdir =~ s!\\!/!g if $^O eq 'MSWin32'; + $tmpdir +}; +use constant INPUTZIP => + (tempfile('testin-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1]; +use constant OUTPUTZIP => + (tempfile('testout-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1]; + +# Do we have the 'zip' and 'unzip' programs? +# Embed a copy of the module, rather than adding a dependency +BEGIN { + + package File::Which; + + use File::Spec; + + my $Is_VMS = ($^O eq 'VMS'); + my $Is_MacOS = ($^O eq 'MacOS'); + my $Is_DOSish = + (($^O eq 'MSWin32') or ($^O eq 'dos') or ($^O eq 'os2')); + + # For Win32 systems, stores the extensions used for + # executable files + # For others, the empty string is used + # because 'perl' . '' eq 'perl' => easier + my @path_ext = (''); + if ($Is_DOSish) { + if ($ENV{PATHEXT} and $Is_DOSish) + { # WinNT. PATHEXT might be set on Cygwin, but not used. + push @path_ext, split ';', $ENV{PATHEXT}; + } else { + push @path_ext, qw(.com .exe .bat) + ; # Win9X or other: doesn't have PATHEXT, so needs hardcoded. + } + } elsif ($Is_VMS) { + push @path_ext, qw(.exe .com); + } + + sub which { + my ($exec) = @_; + + return undef unless $exec; + + my $all = wantarray; + my @results = (); + + # check for aliases first + if ($Is_VMS) { + my $symbol = `SHOW SYMBOL $exec`; + chomp($symbol); + if (!$?) { + return $symbol unless $all; + push @results, $symbol; + } + } + if ($Is_MacOS) { + my @aliases = split /\,/, $ENV{Aliases}; + foreach my $alias (@aliases) { + + # This has not been tested!! + # PPT which says MPW-Perl cannot resolve `Alias $alias`, + # let's just hope it's fixed + if (lc($alias) eq lc($exec)) { + chomp(my $file = `Alias $alias`); + last unless $file; # if it failed, just go on the normal way + return $file unless $all; + push @results, $file; + + # we can stop this loop as if it finds more aliases matching, + # it'll just be the same result anyway + last; + } + } + } + + my @path = File::Spec->path(); + unshift @path, File::Spec->curdir if $Is_DOSish or $Is_VMS or $Is_MacOS; + + for my $base (map { File::Spec->catfile($_, $exec) } @path) { + for my $ext (@path_ext) { + my $file = $base . $ext; + + # print STDERR "$file\n"; + + if ( + ( + -x $file or # executable, normal case + ( + $Is_MacOS + || # MacOS doesn't mark as executable so we check -e + ( + $Is_DOSish + and grep { $file =~ /$_$/i } + @path_ext[1 .. $#path_ext]) + + # DOSish systems don't pass -x on non-exe/bat/com files. + # so we check -e. However, we don't want to pass -e on files + # that aren't in PATHEXT, like README. + and -e _)) + and !-d _) + { # and finally, we don't want dirs to pass (as they are -x) + + # print STDERR "-x: ", -x $file, " -e: ", -e _, " -d: ", -d _, "\n"; + + return $file unless $all; + push @results, $file; # Make list to return later + } + } + } + + if ($all) { + return @results; + } else { + return undef; + } + } +} +use constant HAVEZIP => !!File::Which::which('zip'); +use constant HAVEUNZIP => !!File::Which::which('unzip'); + +use constant ZIP => 'zip '; +use constant ZIPTEST => 'unzip -t '; + +# 300-character test string +use constant TESTSTRING => join("\n", 1 .. 102) . "\n"; +use constant TESTSTRINGLENGTH => length(TESTSTRING); + +use Archive::Zip (); + +# CRC-32 should be ac373f32 +use constant TESTSTRINGCRC => Archive::Zip::computeCRC32(TESTSTRING); + +# This is so that it will work on other systems. +use constant CAT => $^X . ' -pe "BEGIN{binmode(STDIN);binmode(STDOUT)}"'; +use constant CATPIPE => '| ' . CAT . ' >'; + +use vars qw($zipWorks $testZipDoesntWork $catWorks); + +# Run ZIPTEST to test a zip file. +sub testZip { + my $zipName = shift || OUTPUTZIP; + if ($testZipDoesntWork) { + return wantarray ? (0, '') : 0; + } + my $cmd = ZIPTEST . $zipName . ($^O eq 'MSWin32' ? '' : ' 2>&1'); + my $zipout = `$cmd`; + return wantarray ? ($?, $zipout) : $?; +} + +# Return the crc-32 of the given file (0 if empty or error) +sub fileCRC { + my $fileName = shift; + local $/ = undef; + my $fh = IO::File->new($fileName, "r"); + binmode($fh); + return 0 if not defined($fh); + my $contents = <$fh>; + return Archive::Zip::computeCRC32($contents); +} + +#--------- check to see if cat works + +sub testCat { + my $fh = IO::File->new(CATPIPE . OUTPUTZIP); + binmode($fh); + my $testString = pack('C256', 0 .. 255); + my $testCrc = Archive::Zip::computeCRC32($testString); + $fh->write($testString, length($testString)) or return 0; + $fh->close(); + (-f OUTPUTZIP) or return 0; + my @stat = stat(OUTPUTZIP); + $stat[7] == length($testString) or return 0; + fileCRC(OUTPUTZIP) == $testCrc or return 0; + unlink(OUTPUTZIP); + return 1; +} + +BEGIN { + $catWorks = testCat(); + unless ($catWorks) { + warn('warning: ', CAT, " doesn't seem to work, may skip some tests"); + } +} + +#--------- check to see if zip works (and make INPUTZIP) + +BEGIN { + unlink(INPUTZIP); + + # Do we have zip installed? + if (HAVEZIP) { + my $cmd = ZIP . INPUTZIP . ' *' . ($^O eq 'MSWin32' ? '' : ' 2>&1'); + my $zipout = `$cmd`; + $zipWorks = not $?; + unless ($zipWorks) { + warn('warning: ', ZIP, + " doesn't seem to work, may skip some tests"); + } + } +} + +#--------- check to see if unzip -t works + +BEGIN { + $testZipDoesntWork = 1; + if (HAVEUNZIP) { + my ($status, $zipout) = do { local $testZipDoesntWork = 0; testZip(INPUTZIP) }; + $testZipDoesntWork = $status; + + # Again, on Win32 no big surprise if this doesn't work + if ($testZipDoesntWork) { + warn('warning: ', ZIPTEST, + " doesn't seem to work, may skip some tests"); + } + } +} + +sub passthrough +{ + my $fromFile = shift ; + my $toFile = shift ; + my $action = shift ; + + my $z = Archive::Zip->new; + $z->read($fromFile); + if ($action) + { + for my $member($z->members()) + { + &$action($member) ; + } + } + $z->writeToFileNamed($toFile); +} + +sub readFile +{ + my $name = shift ; + local $/; + open F, "<$name" + or die "Cannot open $name: $!\n"; + my $data = <F>; + close F ; + return $data; +} + +1; diff --git a/t/data/bad_github11.zip b/t/data/bad_github11.zip Binary files differnew file mode 100644 index 0000000..3fe4892 --- /dev/null +++ b/t/data/bad_github11.zip diff --git a/t/data/chmod.zip b/t/data/chmod.zip Binary files differnew file mode 100644 index 0000000..fccda55 --- /dev/null +++ b/t/data/chmod.zip diff --git a/t/data/crypcomp.zip b/t/data/crypcomp.zip Binary files differnew file mode 100644 index 0000000..cd4d1e8 --- /dev/null +++ b/t/data/crypcomp.zip diff --git a/t/data/crypt.zip b/t/data/crypt.zip Binary files differnew file mode 100644 index 0000000..d1c897f --- /dev/null +++ b/t/data/crypt.zip diff --git a/t/data/def.zip b/t/data/def.zip Binary files differnew file mode 100644 index 0000000..2c2890f --- /dev/null +++ b/t/data/def.zip diff --git a/t/data/defstr.zip b/t/data/defstr.zip Binary files differnew file mode 100644 index 0000000..60591d1 --- /dev/null +++ b/t/data/defstr.zip diff --git a/t/data/emptydef.zip b/t/data/emptydef.zip Binary files differnew file mode 100644 index 0000000..87b26a3 --- /dev/null +++ b/t/data/emptydef.zip diff --git a/t/data/emptydefstr.zip b/t/data/emptydefstr.zip Binary files differnew file mode 100644 index 0000000..074bea2 --- /dev/null +++ b/t/data/emptydefstr.zip diff --git a/t/data/emptystore.zip b/t/data/emptystore.zip Binary files differnew file mode 100644 index 0000000..b3e98d8 --- /dev/null +++ b/t/data/emptystore.zip diff --git a/t/data/emptystorestr.zip b/t/data/emptystorestr.zip Binary files differnew file mode 100644 index 0000000..2c80dde --- /dev/null +++ b/t/data/emptystorestr.zip diff --git a/t/data/good_github11.zip b/t/data/good_github11.zip Binary files differnew file mode 100644 index 0000000..39ee392 --- /dev/null +++ b/t/data/good_github11.zip diff --git a/t/data/jar.zip b/t/data/jar.zip Binary files differnew file mode 100644 index 0000000..a8da50f --- /dev/null +++ b/t/data/jar.zip diff --git a/t/data/linux.zip b/t/data/linux.zip Binary files differnew file mode 100644 index 0000000..3f8e449 --- /dev/null +++ b/t/data/linux.zip diff --git a/t/data/mkzip.pl b/t/data/mkzip.pl new file mode 100755 index 0000000..b445846 --- /dev/null +++ b/t/data/mkzip.pl @@ -0,0 +1,54 @@ +#!/usr/bin/perl + +#This script will create test zip files used by some of the tests. +# +# File Length Streamed Method +# =============================================== +# emptydef.zip Yes No Deflate +# emptydefstr.zip Yes Yes Deflate +# emptystore.zip Yes No Store +# emptystorestr.zip Yes Yes Store +# + + +use warnings; +use strict; + +use IO::Compress::Zip qw(:all); + +my $time = 325532800; + +zip \"" => "emptydef.zip", + Name => "fred", Stream => 0, Method => ZIP_CM_DEFLATE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"" => "emptydefstr.zip", + Name => "fred", Stream => 1, Method => ZIP_CM_DEFLATE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"" => "emptystore.zip", + Name => "fred", Stream => 0, Method => ZIP_CM_STORE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"" => "emptystorestr.zip", + Name => "fred", Stream => 1, Method => ZIP_CM_STORE, Time => $time + or die "Cannot create zip: $ZipError"; + + + +zip \"abc" => "def.zip", + Name => "fred", Stream => 0, Method => ZIP_CM_DEFLATE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"abc" => "defstr.zip", + Name => "fred", Stream => 1, Method => ZIP_CM_DEFLATE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"abc" => "store.zip", + Name => "fred", Stream => 0, Method => ZIP_CM_STORE, Time => $time + or die "Cannot create zip: $ZipError"; + +zip \"abc" => "storestr.zip", + Name => "fred", Stream => 1, Method => ZIP_CM_STORE, Time => $time + or die "Cannot create zip: $ZipError"; + diff --git a/t/data/perl.zip b/t/data/perl.zip Binary files differnew file mode 100644 index 0000000..0430db3 --- /dev/null +++ b/t/data/perl.zip diff --git a/t/data/store.zip b/t/data/store.zip Binary files differnew file mode 100644 index 0000000..f8e4496 --- /dev/null +++ b/t/data/store.zip diff --git a/t/data/storestr.zip b/t/data/storestr.zip Binary files differnew file mode 100644 index 0000000..cc97102 --- /dev/null +++ b/t/data/storestr.zip diff --git a/t/data/streamed.zip b/t/data/streamed.zip Binary files differnew file mode 100644 index 0000000..90c0ed3 --- /dev/null +++ b/t/data/streamed.zip diff --git a/t/data/winzip.zip b/t/data/winzip.zip Binary files differnew file mode 100644 index 0000000..d8b1f0c --- /dev/null +++ b/t/data/winzip.zip diff --git a/t/data/zip64.zip b/t/data/zip64.zip Binary files differnew file mode 100644 index 0000000..a2ee1fa --- /dev/null +++ b/t/data/zip64.zip |
