Archive-Zip
view release on metacpan or search on metacpan
- 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.
t/02_main.t view on Meta::CPAN
# 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
azok($zip->writeToFileNamed(OUTPUTZIP), '->writeToFileNamed ok');
azuztok(refzip => "emptyzip.zip");
#--------- add a directory
my $memberName = testPath(PATH_ZIPDIR);
my $dirName = testPath();
# addDirectory # Archive::Zip::Archive
# new # Archive::Zip::Member
my $member = $zip->addDirectory($memberName);
t/02_main.t view on Meta::CPAN
# 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
azok($zip->writeToFileNamed(OUTPUTZIP));
# Does the modification time get corrupted?
is(($zip->members)[0]->lastModFileDateTime(), $dirTime);
azuztok();
#--------- extract the directory by name
rmdir($dirName) or die;
azok($zip->extractMember($memberName));
ok(-d $dirName);
t/02_main.t view on Meta::CPAN
# 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
azok($zip->writeToFileNamed(OUTPUTZIP));
azuztok();
is($member->crc32(), TESTSTRINGCRC);
is($member->crc32String(), sprintf("%08x", TESTSTRINGCRC));
#--------- extract it by name
azok($zip->extractMember($memberName));
ok (-f $memberName);
is (readFile($memberName), TESTSTRING);
#--------- now compress it and re-test
my $oldCompressionMethod =
$member->desiredCompressionMethod(COMPRESSION_DEFLATED);
is($oldCompressionMethod, COMPRESSION_STORED, 'old compression method OK');
# writeToFileNamed # Archive::Zip::Archive
azok($zip->writeToFileNamed(OUTPUTZIP), 'writeToFileNamed returns AZ_OK');
is ($member->crc32(), TESTSTRINGCRC);
is ($member->uncompressedSize(), TESTSTRINGLENGTH);
azuztok();
#--------- extract it by name
azok($zip->extractMember($memberName));
ok (-f $memberName);
is (readFile($memberName), TESTSTRING);
t/02_main.t view on Meta::CPAN
$memberName = testPath('file.txt', PATH_ZIPFILE);
# addFile # Archive::Zip::Archive
# newFromFile # Archive::Zip::Member
$member = $zip->addFile($memberName);
ok(defined($member));
is($member->desiredCompressionMethod(), COMPRESSION_DEFLATED);
# writeToFileNamed # Archive::Zip::Archive
azok($zip->writeToFileNamed(OUTPUTZIP));
is ($member->crc32(), TESTSTRINGCRC);
is ($member->uncompressedSize(), TESTSTRINGLENGTH);
azuztok();
#--------- 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/;
azok($zip->extractMember($memberName, $newName));
ok (-f $newName);
is (readFile($newName), TESTSTRING);
#--------- now make it uncompressed and re-test
$oldCompressionMethod = $member->desiredCompressionMethod(COMPRESSION_STORED);
is($oldCompressionMethod, COMPRESSION_DEFLATED);
# writeToFileNamed # Archive::Zip::Archive
azok($zip->writeToFileNamed(OUTPUTZIP));
is ($member->crc32(), TESTSTRINGCRC);
is ($member->uncompressedSize(), TESTSTRINGLENGTH);
azuztok();
#--------- extract it by name
azok($zip->extractMember($memberName, $newName));
ok (-f $newName);
is (readFile($newName), TESTSTRING);
# 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();
t/02_main.t view on Meta::CPAN
#--------- 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
azwok($zip, 'file' => INPUTZIP);
#--------- read from INPUTZIP (appending its entries)
# read # Archive::Zip::Archive
azok($zip->read(INPUTZIP));
is ($zip->numberOfMembers(), 10);
#--------- clean up duplicate names
@members = $zip->members();
$member = $zip->removeMember($members[5]);
is($member->fileName(), testPath(PATH_ZIPDIR));
SCOPE: {
for my $i (6 .. 9) {
$memberName = $members[$i]->fileName();
t/02_main.t view on Meta::CPAN
#--------- 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;
ok ($fh = azopen(OUTPUTZIP), 'Pipe open');
azok($zip->writeToFileHandle($fh), 'Write zip to file handle');
ok ($fh->close(), 'Pipe close');
azuztok();
#--------- Change the contents of a string member
my $status;
is(ref($members[2]), 'Archive::Zip::StringMember');
(undef, $status) = $members[2]->contents("This is my new contents\n");
azok($status);
use common;
# Test example scripts
use constant FILENAME => testPath('testing.txt');
use constant ZFILENAME => testPath('testing.txt', PATH_ZIPFILE);
my $zip = Archive::Zip->new();
isa_ok($zip, 'Archive::Zip');
isa_ok($zip->addString(TESTSTRING, ZFILENAME), 'Archive::Zip::StringMember');
azok($zip->writeToFileNamed(INPUTZIP));
my ($status, $output);
($output, $status) = execPerl('examples/copy.pl', INPUTZIP, OUTPUTZIP);
is($status, 0) or diag($output);
($output, $status) = execPerl('examples/extract.pl', OUTPUTZIP, ZFILENAME);
is($status, 0) or diag($output);
($output, $status) = execPerl('examples/mfh.pl', INPUTZIP);
is($status, 0) or diag($output);
($output, $status) = execPerl('examples/zip.pl', OUTPUTZIP, INPUTZIP, FILENAME);
is($status, 0) or diag($output);
($output, $status) = execPerl('examples/zipinfo.pl', INPUTZIP);
if (is($status, 0)) {
note($output);
} else {
diag($output);
}
($output, $status) = execPerl('examples/ziptest.pl', INPUTZIP);
if (is($status, 0)) {
note($output);
} else {
diag($output);
}
($output, $status) = execPerl('examples/zipGrep.pl', '100', INPUTZIP);
is($status, 0);
is($output, ZFILENAME . ":100\n");
unlink(OUTPUTZIP);
($output, $status) = execPerl('examples/selfex.pl', OUTPUTZIP, FILENAME);
is($status, 0) or diag($output);
unlink(FILENAME);
($output, $status) = execPerl(OUTPUTZIP, testPath());
is($status, 0) or diag($output);
my $fn = testPath(FILENAME);
is(-f $fn, 1, "$fn exists");
unlink(OUTPUTZIP);
($output, $status) = execPerl('examples/updateTree.pl', OUTPUTZIP, testPath());
is($status, 0, "updateTree.pl create") or diag($output);
is(-f OUTPUTZIP, 1, "zip created");
($output, $status) = execPerl('examples/updateTree.pl', OUTPUTZIP, testPath());
is($status, 0, "updateTree.pl update") or diag($output);
is(-f OUTPUTZIP, 1, "zip updated");
unlink(OUTPUTZIP);
# Still untested:
#
# calcSizes.pl - creates test.zip, may be sensitive to /dev/null
# mailZip.pl
# readScalar.pl - requires IO::Scalar
# unzipAll.pl
# updateZip.pl
# writeScalar2.pl
# writeScalar.pl
t/07_filenames_of_0.t view on Meta::CPAN
# TEST
ok(scalar(grep { $_ eq "folder/0" } $archive->memberNames()),
"Checking that a file called '0' was added properly by addTree");
}
# Try to create member called "0" with addString
{
my $archive = Archive::Zip->new;
isa_ok($archive, 'Archive::Zip');
isa_ok($archive->addString((TESTSTRING) => 0), 'Archive::Zip::StringMember');
azwok($archive, 'file' => OUTPUTZIP);
}
# Try to find member called "0" with memberNames
{
my $archive = Archive::Zip->new;
isa_ok($archive, 'Archive::Zip');
azok($archive->read(OUTPUTZIP));
ok(scalar(grep { $_ eq "0" } $archive->memberNames()),
"Checking that a file called '0' was added properly by addString");
}
t/17_101092.t view on Meta::CPAN
# 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 = dataPath("streamed.zip");
my $outfile = OUTPUTZIP;
passThrough($infile, $outfile);
azuztok();
my $before = readFile($infile);
my $after = readFile($outfile);
ok($before eq $after);
t/18_bug_92205.t view on Meta::CPAN
[defstr => "defstr", undef, ],
[store => "store", undef, ],
[storestr => "storestr", undef, ],
);
for my $test (@TESTS)
{
my ($infile, $reffile, $method) = @$test;
$infile = dataPath($infile);
$reffile = dataPath($reffile);
my $outfile = OUTPUTZIP;
passThrough($infile, $outfile, sub {
my $member = shift;
$member->desiredCompressionMethod($method) if defined($method);
$member->setLastModFileDateTimeFromUnix($member->lastModTime());
});
azuztok($outfile, 'name' => "\"unzip -t\" ok after $infile to $outfile");
my $outtext = readFile($outfile);
my $reftext = readFile($reffile);
t/24_unicode_win32.t view on Meta::CPAN
# create and write archive
{
my $archive = Archive::Zip->new;
&$creator($archive);
azwok($archive, 'name' => $name);
}
# read archive and test member names
{
my $archive = Archive::Zip->new;
azok($archive->read(OUTPUTZIP), "$name - test read");
is_deeply([$archive->memberNames()], $membernames, "$name - test members");
}
unlink(OUTPUTZIP) or die;
}
my $euro_filename = "euro-€";
{
mkdir(testPath('folder')) or die;
open(my $euro_file, ">", testPath('folder', $euro_filename)) or die;
print $euro_file "File EURO\n" or die;
close($euro_file) or die;
}
t/28_zip64_unsupported.t view on Meta::CPAN
# trigger error in _readEndOfCentralDirectory
my $zip = Archive::Zip->new();
isa_ok($zip, 'Archive::Zip');
azis($zip->read(dataPath('zip64.zip')), AZ_ERROR,
qr/\Qzip64 format not supported on this Perl interpreter\E/);
# trigger error in _writeEndOfCentralDirectory
$zip = Archive::Zip->new();
$zip->desiredZip64Mode(ZIP64_EOCD);
isa_ok($zip, 'Archive::Zip');
azis($zip->writeToFileNamed(OUTPUTZIP), AZ_ERROR,
qr/\Qzip64 format not supported on this Perl interpreter\E/);
# trigger error in _writeLocalFileHeader
$zip = Archive::Zip->new();
$zip->desiredZip64Mode(ZIP64_HEADERS);
isa_ok($zip, 'Archive::Zip');
isa_ok($zip->addString("foo", "bar"), 'Archive::Zip::StringMember');
azis($zip->writeToFileNamed(OUTPUTZIP), AZ_ERROR,
qr/\Qzip64 format not supported on this Perl interpreter\E/);
# trigger error in _extractZip64ExtraField
my $zip64ExtraField = pack('v v', 0x0001, 0);
my $member = Archive::Zip::Member->newFromString(TESTSTRING);
ok(defined($member));
azis($member->cdExtraField($zip64ExtraField), AZ_ERROR,
qr/\Qzip64 format not supported on this Perl interpreter\E/);
t/README.md view on Meta::CPAN
usually preferred `use warnings;` since that way the
Archive::Zip module itself and its descendants get executed
with warnings, too. Which, unfortunately, otherwise would
not be the case.
- Keep test data below directory `t/data` without any
additional subdirectories and access it by means of function
`dataPath`.
- Create temporary results only in directory `TESTDIR` and in
files `INPUTZIP` and `OUTPUTZIP` to avoid race conditions
when tests are executed in parallel. Access directory
`TESTDIR` and any paths below it by means of function
`testPath`.
## Constants Provided by Package common
Package common, included by `use lib 't'; use common;` in a test
header, provides the following constants (which are all exported
by default):
- `TESTDIR`
Relative path to a unique (per test program) temporary test
directory located below the build directory of this module.
Better use function `testPath` to access that directory than
this constant.
- `INPUTZIP`, `OUTPUTZIP`
Absolute paths to unique (per test program) temporary files
with extension `.zip` that could be used arbitrarily by
tests. Except above facts tests should assume nothing about
these files.
- `TESTSTRING`, `TESTSTRINGLENGTH`, `TESTSTRINGCRC`
A somewhat harmless, ASCII-only-but-multi-line test string,
its length, and CRC.
t/README.md view on Meta::CPAN
Test that succeeds if the specified status equals the
expected status (one of the `:ERROR_CODES` constants) and/or,
if an error has been generated, if the error message matches
the specified regexp. Provides built-in diagnostics in case
of test failure and returns the test verdict.
- `my $fileHandle = azopen( $file )`
Creates and returns a file handle to write to the specified
file (defaulting to `OUTPUTZIP`). If possible, a piped file
handle, otherwise a regular one. Returns the undefined value
on failure.
- ```
my $ok = azuztok( [['file' =>] $file,]
['name' => $name] );
```
Test that succeeds if `unzip -t` on the specified file
(defaulting to `OUTPUTZIP`) returns exit value zero. This
function provides built-in diagnostics in case of test
failure and returns the test verdict regardless of the
specific calling syntax.
- ```
my $ok = azuztok( [['file' =>] $file,]
'refzip' => $refzip,
['name' => $name] );
```
t/common.pm view on Meta::CPAN
use Config;
use File::Spec;
use File::Spec::Unix;
use File::Temp qw(tempfile tempdir);
use Test::More;
use Archive::Zip qw(:ERROR_CODES);
use Exporter qw(import);
@common::EXPORT = qw(TESTDIR INPUTZIP OUTPUTZIP
TESTSTRING TESTSTRINGLENGTH TESTSTRINGCRC
PATH_REL PATH_ABS PATH_ZIPFILE PATH_ZIPDIR PATH_ZIPABS
passThrough readFile execProc execPerl dataPath testPath
azbinis azok azis
azopen azuztok azwok);
### Constants
# Flag whether we run in an automated test environment
use constant _IN_AUTOTEST_ENVIRONMENT =>
exists($ENV{'AUTOMATED_TESTING'}) ||
exists($ENV{'NONINTERACTIVE_TESTING'}) ||
exists($ENV{'PERL_CPAN_REPORTER_CONFIG'});
use constant TESTDIR => do {
-d 'testdir' or mkdir 'testdir' or die $!;
tempdir(DIR => 'testdir', CLEANUP => 1, EXLOCK => 0);
};
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];
# 300-character test string. CRC-32 should be ac373f32.
use constant TESTSTRING => join("\n", 1 .. 102) . "\n";
use constant TESTSTRINGLENGTH => length(TESTSTRING);
use constant TESTSTRINGCRC => Archive::Zip::computeCRC32(TESTSTRING);
# Path types used by functions dataPath and testPath
use constant PATH_REL => \ "PATH_REL";
use constant PATH_ABS => \ "PATH_ABS";
t/common.pm view on Meta::CPAN
}
elsif (! $uztWorks) {
$uztOutErr .= "Exit value $uztExitVal\n";
}
# Check whether we can write through a (non-seekable) pipe
my $pipeCommand = '| "' . $Config{'perlpath'} . '" -pe "BEGIN{binmode(STDIN);binmode(STDOUT)}" >';
my $pipeError = "";
my $pipeWorks = eval {
my $testString = pack('C256', 0 .. 255);
my $fh = FileHandle->new("$pipeCommand " . OUTPUTZIP) or die $!;
binmode($fh) or die $!;
$fh->write($testString, length($testString)) or die $!;
$fh->close() or die $!;
(-f OUTPUTZIP) or die $!;
(-s OUTPUTZIP) == length($testString) or die "length mismatch";
readFile(OUTPUTZIP) eq $testString or die "data mismatch";
return 1;
} or $pipeError = $@;
### Test Functions
# Diags or notes, depending on whether we run in an automated
# test environment or not.
sub _don
{
if (_IN_AUTOTEST_ENVIRONMENT) {
t/common.pm view on Meta::CPAN
}
@errors = ();
$trace = undef;
return $ok;
}
sub azopen
{
my $file = @_ ? shift : OUTPUTZIP;
if ($pipeWorks) {
if (-f $file && ! unlink($file)) {
return undef;
}
return FileHandle->new("$pipeCommand $file");
}
else {
return FileHandle->new("> $file");
}
}
my %rzipCache = ();
sub azuztok
{
my $file = @_ & 1 ? shift : undef;
my %params = @_;
$file = exists($params{'file'}) ? $params{'file'} :
defined($file) ? $file : OUTPUTZIP;
my $refzip = $params{'refzip'};
my $xppats = $params{'xppats'};
my $name = $params{'name'};
local $Test::Builder::Level = $Test::Builder::Level + 1;
if (! $uztWorks) {
SKIP: {
skip("\"unzip -t\" not available", 1)
}
t/common.pm view on Meta::CPAN
diag($outErr . "Exit value $exitVal\n");
}
return $ok;
}
}
sub azwok
{
my $zip = shift;
my %params = @_;
my $file = exists($params{'file'}) ? $params{'file'} : OUTPUTZIP;
my $name = $params{'name'} ? $params{'name'} : "write and test zip file";
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok;
my $fh;
$ok = 1;
$ok &&= ok($fh = azopen($file), "$name - open piped handle");
$ok &&= azok($zip->writeToFileHandle($fh), "$name - write piped");
( run in 0.654 second using v1.01-cache-2.11-cpan-4e96b696675 )