@@ -1,45 +0,0 @@
-personal_ws-1.1 en 44
-arg
-chunkSize
-compressionLevel
-compressionMethod
-CPAN
-CRC
-Das
-deflater
-desiredCompressionLevel
-desiredCompressionMethod
-directoryName
-EOCD
-filename
-fileName
-filenames
-inflater
-inline
-Konz
-lastModFileDateTime
-memberOrZipName
-multi
-myErrorHandler
-namespace
-NewFileMember
-newMember
-pathnames
-proxying
-seekable
-Sreeji
-STDOUT
-subdirectory
-txt
-uncompress
-uncompresses
-undef
-UTF
-versa
-writeToFileHandle
-writeToFileNamed
-zipfile
-ZipFileMember
-ZipFileMembers
-zipName
-zlib
@@ -1 +0,0 @@
-set! writeeol=dos
@@ -1,5 +1,10 @@
Revision history for Perl extension Archive-Zip
+
+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,5 +1,3 @@
-.aspell.local.pws
-.exrc
Changes
examples/calcSizes.pl
examples/copy.pl
@@ -53,7 +51,7 @@ t/15_decrypt.t
t/16_decrypt.t
t/badjpeg/expected.jpg
t/badjpeg/source.zip
-t/common.pl
+t/common.pm
t/data/chmod.zip
t/data/crypcomp.zip
t/data/crypt.zip
@@ -4,7 +4,7 @@
"Ned Konz <perl@bike-nomad.com>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630",
"license" : [
"perl_5"
],
@@ -53,5 +53,5 @@
"url" : "https://github.com/redhotpenguin/perl-Archive-Zip-svn"
}
},
- "version" : "1.38"
+ "version" : "1.39"
}
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -32,4 +32,4 @@ requires:
perl: 5.006
resources:
repository: https://github.com/redhotpenguin/perl-Archive-Zip-svn
-version: 1.38
+version: 1.39
@@ -3,7 +3,7 @@
use strict;
use Archive::Zip qw(:ERROR_CODES);
use File::Spec;
-my $zip = Archive::Zip->new();
+my $zip = Archive::Zip->new();
my $blackHoleDevice = File::Spec->devnull();
$zip->addFile($_) foreach (<*.pl>);
@@ -13,19 +13,19 @@ $zip->addFile($_) foreach (<*.pl>);
# to the compressed size.
$zip->writeToFileNamed($blackHoleDevice);
-my $totalSize = 0;
+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";
+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";
+print "Total Size=", $totalSize, ", total compressed=", $totalCompressedSize,
+ "\n";
$zip->writeToFileNamed('test.zip');
@@ -6,7 +6,7 @@
use Archive::Zip qw(:ERROR_CODES);
die "usage: perl copy.pl input.zip output.zip\n"
- if scalar(@ARGV) != 2;
+ if scalar(@ARGV) != 2;
my $zip = Archive::Zip->new();
@@ -17,24 +17,23 @@ use Getopt::Std;
$opt_j = 0;
getopts('j');
-if (@ARGV < 2)
-{
- die <<EOF
+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 $zip = Archive::Zip->new();
my $zipName = shift(@ARGV);
-my $status = $zip->read( $zipName );
+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;
+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;
}
@@ -15,7 +15,7 @@ use IO::Scalar;
use MIME::Entity; # part of MIME::Tools package
my $zipContents = '';
-my $SH = IO::Scalar->new( \$zipContents );
+my $SH = IO::Scalar->new(\$zipContents);
my $zip = Archive::Zip->new();
my $member;
@@ -23,13 +23,14 @@ 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";
+print STDERR "zip is " . length($zipContents) . " bytes long\n";
### Create an entity:
my $top = MIME::Entity->build(
@@ -47,21 +48,22 @@ $top->attach(
# attach the zip
$top->attach(
- Data => \$zipContents,
- Type => "application/x-zip",
- Encoding => "base64",
- Disposition => 'attachment',
- Filename => 'your.zip'
+ 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'
+ Encoding => '8bit',
+ Type => 'text/plain',
+ Path => $0,
+
+ # Data => 'whatever',
+ Disposition => 'inline'
);
# and print it out to stdout
-$top->print( \*STDOUT );
+$top->print(\*STDOUT);
@@ -10,18 +10,17 @@ 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;
+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 $zip = Archive::Zip->new();
my $status = $zip->read($ARGV[0]);
exit $status if $status != AZ_OK;
@@ -17,7 +17,7 @@ printf "Read %d bytes\n", length($zipContents);
my $SH = IO::Scalar->new(\$zipContents);
my $zip = Archive::Zip->new();
-$zip->readFromFileHandle( $SH );
+$zip->readFromFileHandle($SH);
my $member = $zip->addString('c' x 300, 'bunchOfCs.txt');
$member->desiredCompressionMethod(COMPRESSION_DEFLATED);
$member = $zip->addString('d' x 300, 'bunchOfDs.txt');
@@ -24,20 +24,18 @@ my $outputName = shift();
my $zip = Archive::Zip->new();
-foreach my $file (@ARGV)
-{
- $zip->addFileOrDirectory($file);
+foreach my $file (@ARGV) {
+ $zip->addFileOrDirectory($file);
}
-my $fh = IO::File->new( $outputName, O_CREAT | O_WRONLY | O_TRUNC, 0777 )
+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($_)
+while (<DATA>) {
+ $fh->print($_)
}
$zip->writeToFileHandle($fh);
@@ -14,17 +14,16 @@ use Getopt::Std;
$opt_j = 0;
getopts('j');
-if (@ARGV < 1)
-{
- die <<EOF
+if (@ARGV < 1) {
+ die <<EOF
usage: perl $0 [-j] zipfile.zip
if -j option given, discards paths.
EOF
}
-my $zip = Archive::Zip->new();
+my $zip = Archive::Zip->new();
my $zipName = shift(@ARGV);
-my $status = $zip->read( $zipName );
+my $status = $zip->read($zipName);
die "Read of $zipName failed\n" if $status != AZ_OK;
$zip->extractTree();
@@ -10,7 +10,7 @@
use Archive::Zip qw(:ERROR_CODES);
my $mirror = 0;
-if ( $ARGV[0] eq '-m' ) { shift; $mirror = 1; }
+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';
@@ -18,18 +18,16 @@ 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;
+if (-f $zipName) {
+ die "can't read $zipName\n" unless $zip->read($zipName) == AZ_OK;
- # Update the zip
- $zip->updateTree($dirName, undef, undef, $mirror);
+ # 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
+ # 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) );
+ $zip->addTree($dirName);
+ exit($zip->writeToFileNamed($zipName));
}
@@ -13,30 +13,21 @@ 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";
- }
+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() );
+exit($zip->overwrite());
@@ -6,14 +6,14 @@ use IO::File;
# test writing to a scalar
my $zipContents = '';
-my $SH = IO::Scalar->new(\$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 $status = $zip->writeToFileHandle($SH);
my $file = IO::File->new('test.zip', 'w');
binmode($file);
@@ -6,14 +6,14 @@ use IO::File;
# test writing to a scalar
my $zipContents = '';
-my $SH = IO::String->new($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 $status = $zip->writeToFileHandle($SH);
my $file = IO::File->new('test.zip', 'w');
binmode($file);
@@ -7,23 +7,19 @@ use strict;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
die "usage: $0 zipfile.zip file [...]\n"
- if (scalar(@ARGV) < 2);
+ if (scalar(@ARGV) < 2);
my $zipName = shift(@ARGV);
-my $zip = Archive::Zip->new();
+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";
- }
+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);
@@ -8,15 +8,14 @@
use strict;
use Archive::Zip qw(:CONSTANTS :ERROR_CODES);
-if ( @ARGV != 2 )
-{
- print <<EOF;
+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;
+ exit 1;
}
my $pattern = shift;
@@ -24,34 +23,30 @@ $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";
+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;
+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;
+ 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};
- }
+ my $buffer = $lastChunk . $$bufferRef;
+ while ($buffer =~ m{(.*$pattern.*\n)}mg) {
+ print "$memberName:$1";
+ }
+ ($lastChunk) = $$bufferRef =~ m{([^\n\r]+)\z};
+ }
- $member->endRead();
+ $member->endRead();
}
@@ -11,29 +11,25 @@ use IO::Handle;
use File::Spec;
# instead of stack dump:
-Archive::Zip::setErrorHandler( sub { warn shift() } );
+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;
+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;
- }
- }
+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;
+ }
+ }
}
@@ -16,20 +16,20 @@ $| = 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();
+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 );
+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::Useqq = 1; # enable double-quotes for string values
$Data::Dumper::Indent = 1;
-my $zip = Archive::Zip->new();
+my $zip = Archive::Zip->new();
my $zipFileName = shift(@ARGV);
my $fh = Archive::Zip::BufferedFileHandle->new();
@@ -38,110 +38,105 @@ $fh->readFromFile($zipFileName) or exit($!);
my $status = $zip->_findEndOfCentralDirectory($fh);
die("can't find EOCD\n") if $status != AZ_OK;
-my $eocdPosition = $fh->tell( );
+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 });
+$zipDumper->Seen({ref($fh), $fh});
print $zipDumper->Dump(), "\n";
-my $expectedEOCDPosition = $zip->centralDirectoryOffsetWRTStartingDiskNumber()
- + $zip->centralDirectorySize();
+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);
+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 $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 = $zip->ZIPMEMBERCLASS->_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;
+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;
+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");
+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
@@ -1,15 +1,15 @@
#!/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:
+# 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
+# -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
+# -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)
#
@@ -18,23 +18,22 @@
use strict;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
-use Cwd;
+use Cwd;
use File::Basename;
use File::Copy;
use File::Find;
-use File::Path;
+use File::Path;
# argument and variable defaults
#
my $maxFileAgeDays = 1;
-my $defaultzipdir = 'h:/zip/_homework';
+my $defaultzipdir = 'h:/zip/_homework';
my ($sourcedir, $zipdir, $zippath, @extensions, $query);
-
# usage
#
my $scriptname = basename $0;
-my $usage = <<ENDUSAGE;
+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).
@@ -47,7 +46,6 @@ whose file extension is in specified extensions (default: any extension).
<zippath>.zip path to zipfile to be created (or updated if it exists)
ENDUSAGE
-
# parse arguments
#
while (@ARGV) {
@@ -56,47 +54,40 @@ while (@ARGV) {
if ($arg eq '-d') {
$maxFileAgeDays = shift;
$maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;
- }
- elsif ($arg eq '-e') {
+ } elsif ($arg eq '-e') {
while ($ARGV[0] && $ARGV[0] !~ /^-/) {
- push @extensions, shift;
+ 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') {
+ } 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') {
+ } elsif ($arg eq '-h') {
print STDERR $usage;
exit;
- }
- elsif (-d $arg) {
+ } elsif (-d $arg) {
$sourcedir = $arg;
- }
- elsif ($arg eq '-z') {
+ } elsif ($arg eq '-z') {
if ($ARGV[0]) {
- $zipdir = shift;
+ $zipdir = shift;
}
- }
- elsif ($arg =~ /\.zip$/) {
+ } elsif ($arg =~ /\.zip$/) {
$zippath = $arg;
- }
- else {
+ } else {
errorExit("Unknown option or argument: $arg");
}
}
# process arguments
#
-errorExit("Please specify an existing source directory") unless defined($sourcedir) && -d $sourcedir;
+errorExit("Please specify an existing source directory")
+ unless defined($sourcedir) && -d $sourcedir;
my $extensions;
if (@extensions) {
$extensions = join "|", @extensions;
-}
-else {
+} else {
$extensions = ".*";
}
@@ -105,7 +96,6 @@ else {
$sourcedir =~ s|\\|/|g;
$zippath =~ s|\\|/|g if defined($zippath);
-
# find files
#
my @files;
@@ -113,22 +103,20 @@ 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;
+} else {
+ $zipdir = $defaultzipdir;
}
# make sure that zip directory exists
@@ -136,13 +124,10 @@ else {
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) {
@@ -152,51 +137,42 @@ if (defined $zippath && -f $zippath) {
# add files
#
-foreach my $memberName (@files)
-{
- if (-d $memberName )
- {
+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";
+ if $zip->addTree($memberName, $memberName) != AZ_OK;
+ } else {
+ $zip->addFile($memberName)
+ or warn "Can't add file $memberName\n";
}
}
-
-# prepare the new zip path
+# 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, failed to rename to $zippath\n";
- }
- }
- else {
+ } else {
print STDERR "Created file $newzippath\n";
}
+} else {
+ print STDERR "Failed to create file $newzippath\n";
}
-else {
- print STDERR "Failed to create file $newzippath\n";
-}
-
-
# subroutines
#
@@ -204,11 +180,12 @@ else {
sub listFiles {
if (/\.($extensions)$/) {
cwd $File::Find::dir;
- return if -d $File::Find::name; # skip directories
+ 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:
+ (my $filename = $File::Find::name) =~
+ s/^[a-zA-Z]://; # remove the leading drive letter:
push @files, $filename;
}
}
@@ -228,8 +205,10 @@ sub fileAgeDays {
}
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;
+ 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__
@@ -16,12 +16,11 @@ use vars qw( @ISA );
my $crc;
-sub writeHook
-{
- my $self = shift;
- my $bytes = shift;
- my $length = length($bytes);
- $crc = Archive::Zip::computeCRC32($bytes, $crc);
+sub writeHook {
+ my $self = shift;
+ my $bytes = shift;
+ my $length = length($bytes);
+ $crc = Archive::Zip::computeCRC32($bytes, $crc);
}
sub resetCRC { $crc = 0 }
@@ -31,10 +30,10 @@ sub crc { $crc }
package main;
die "usage: $0 zipfile.zip\n"
- if (scalar(@ARGV) != 1);
+ if (scalar(@ARGV) != 1);
-my $zip = Archive::Zip->new();
-my $status = $zip->read( $ARGV[0] );
+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";
@@ -43,40 +42,35 @@ 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));
- }
+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";
+if (scalar(@errors)) {
+ print join("\n", @errors);
+ die "CRC errors found\n";
+} else {
+ print "All CRCs check OK\n";
}
@@ -13,13 +13,13 @@ use Cwd;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw( Archive::Zip );
- if ( $^O eq 'MSWin32' ) {
+ if ($^O eq 'MSWin32') {
require Win32;
require Encode;
- Encode->import( qw{ encode_utf8 decode_utf8 } );
+ Encode->import(qw{ encode_utf8 decode_utf8 });
}
}
@@ -40,11 +40,12 @@ sub new {
{
'diskNumber' => 0,
'diskNumberWithStartOfCentralDirectory' => 0,
- 'numberOfCentralDirectoriesOnThisDisk' => 0, # should be # of members
- 'numberOfCentralDirectories' => 0, # should be # of members
- 'centralDirectorySize' => 0, # must re-compute on write
+ 'numberOfCentralDirectoriesOnThisDisk' =>
+ 0, # should be # of members
+ 'numberOfCentralDirectories' => 0, # should be # of members
+ 'centralDirectorySize' => 0, # must re-compute on write
'centralDirectoryOffsetWRTStartingDiskNumber' =>
- 0, # must re-compute
+ 0, # must re-compute
'writeEOCDOffset' => 0,
'writeCentralDirectoryOffset' => 0,
'zipfileComment' => '',
@@ -54,7 +55,7 @@ sub new {
$class
);
$self->{'members'} = [];
- my $fileName = ( ref( $_[0] ) eq 'HASH' ) ? shift->{filename} : shift;
+ my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift;
if ($fileName) {
my $status = $self->read($fileName);
return $status == AZ_OK ? $self : undef;
@@ -68,11 +69,11 @@ sub storeSymbolicLink {
}
sub members {
- @{ shift->{'members'} };
+ @{shift->{'members'}};
}
sub numberOfMembers {
- scalar( shift->members() );
+ scalar(shift->members());
}
sub memberNames {
@@ -82,17 +83,17 @@ sub memberNames {
# 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() ) {
+ 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;
+ my $self = shift;
+ my $pattern = (ref($_[0]) eq 'HASH') ? shift->{regex} : shift;
return grep { $_->fileName() =~ /$pattern/ } $self->members();
}
@@ -124,8 +125,8 @@ 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
+ my $new_comment = (ref($_[0]) eq 'HASH') ? shift->{comment} : shift;
+ $self->{'zipfileComment'} = pack('C0a*', $new_comment); # avoid Unicode
}
return $comment;
}
@@ -140,8 +141,8 @@ sub fileName {
}
sub removeMember {
- my $self = shift;
- my $member = ( ref( $_[0] ) eq 'HASH' ) ? shift->{memberOrZipName} : shift;
+ 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();
@@ -152,20 +153,19 @@ sub removeMember {
sub replaceMember {
my $self = shift;
- my ( $oldMember, $newMember );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($oldMember, $newMember);
+ if (ref($_[0]) eq 'HASH') {
$oldMember = $_[0]->{memberOrZipName};
$newMember = $_[0]->{newMember};
- }
- else {
- ( $oldMember, $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();
+ map { ($_ == $oldMember) ? $newMember : $_ } $self->members();
$self->{'members'} = \@newMembers;
return $oldMember;
}
@@ -173,34 +173,32 @@ sub replaceMember {
sub extractMember {
my $self = shift;
- my ( $member, $name );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($member, $name);
+ if (ref($_[0]) eq 'HASH') {
$member = $_[0]->{memberOrZipName};
$name = $_[0]->{name};
- }
- else {
- ( $member, $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 {
+ 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 = $name) =~ s{[^/]*$}{};
$dirName = Archive::Zip::_asLocalName($dirName);
$name = Archive::Zip::_asLocalName($name);
}
- if ( $dirName && !-d $dirName ) {
+ if ($dirName && !-d $dirName) {
mkpath($dirName);
- return _ioError("can't create dir $dirName") if ( !-d $dirName );
+ return _ioError("can't create dir $dirName") if (!-d $dirName);
}
- my $rc = $member->extractToFileNamed( $name, @_ );
+ my $rc = $member->extractToFileNamed($name, @_);
# TODO refactor this fix into extractToFileNamed()
$member->{'compressedSize'} = $originalSize;
@@ -210,13 +208,12 @@ sub extractMember {
sub extractMemberWithoutPaths {
my $self = shift;
- my ( $member, $name );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($member, $name);
+ if (ref($_[0]) eq 'HASH') {
$member = $_[0]->{memberOrZipName};
$name = $_[0]->{name};
- }
- else {
- ( $member, $name ) = @_;
+ } else {
+ ($member, $name) = @_;
}
$member = $self->memberNamed($member) unless ref($member);
@@ -228,47 +225,49 @@ sub extractMemberWithoutPaths {
$name =~ s{.*/}{}; # strip off directories, if any
$name = Archive::Zip::_asLocalName($name);
}
- my $rc = $member->extractToFileNamed( $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;
+ 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' ) {
+ my ($fileName, $newName, $compressionLevel);
+ if (ref($_[0]) eq 'HASH') {
$fileName = $_[0]->{filename};
$newName = $_[0]->{zipName};
$compressionLevel = $_[0]->{compressionLevel};
- }
- else {
- ( $fileName, $newName, $compressionLevel ) = @_;
+ } else {
+ ($fileName, $newName, $compressionLevel) = @_;
}
- if ( $^O eq 'MSWin32' && $Archive::Zip::UNICODE ) {
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
$fileName = Win32::GetANSIPathName($fileName);
}
- my $newMember = $self->ZIPMEMBERCLASS->newFromFile( $fileName, $newName );
+ my $newMember = Archive::Zip::Member->newFromFile($fileName, $newName);
$newMember->desiredCompressionLevel($compressionLevel);
- if ( $self->{'storeSymbolicLink'} && -l $fileName ) {
- my $newMember = $self->ZIPMEMBERCLASS->newFromString(readlink $fileName, $newName);
- # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
+ 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) );
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
+ $newMember->{'fileName'} =
+ encode_utf8(Win32::GetLongPathName($fileName));
}
return $newMember;
}
@@ -276,19 +275,17 @@ sub addFile {
sub addString {
my $self = shift;
- my ( $stringOrStringRef, $name, $compressionLevel );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($stringOrStringRef, $name, $compressionLevel);
+ if (ref($_[0]) eq 'HASH') {
$stringOrStringRef = $_[0]->{string};
$name = $_[0]->{zipName};
$compressionLevel = $_[0]->{compressionLevel};
- }
- else {
- ( $stringOrStringRef, $name, $compressionLevel ) = @_;;
+ } else {
+ ($stringOrStringRef, $name, $compressionLevel) = @_;
}
- my $newMember = $self->ZIPMEMBERCLASS->newFromString(
- $stringOrStringRef, $name
- );
+ my $newMember =
+ Archive::Zip::Member->newFromString($stringOrStringRef, $name);
$newMember->desiredCompressionLevel($compressionLevel);
return $self->addMember($newMember);
}
@@ -296,32 +293,32 @@ sub addString {
sub addDirectory {
my $self = shift;
- my ( $name, $newName );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($name, $newName);
+ if (ref($_[0]) eq 'HASH') {
$name = $_[0]->{directoryName};
$newName = $_[0]->{zipName};
- }
- else {
- ( $name, $newName ) = @_;
+ } else {
+ ($name, $newName) = @_;
}
- if ( $^O eq 'MSWin32' && $Archive::Zip::UNICODE ) {
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
$name = Win32::GetANSIPathName($name);
}
- my $newMember = $self->ZIPMEMBERCLASS->newDirectoryNamed( $name, $newName );
- if ( $self->{'storeSymbolicLink'} && -l $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 = $self->ZIPMEMBERCLASS->newFromString($link, $newName);
- # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
+ ($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) );
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
+ $newMember->{'fileName'} = encode_utf8(Win32::GetLongPathName($name));
}
return $newMember;
}
@@ -331,33 +328,30 @@ sub addDirectory {
sub addFileOrDirectory {
my $self = shift;
- my ( $name, $newName, $compressionLevel );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($name, $newName, $compressionLevel);
+ if (ref($_[0]) eq 'HASH') {
$name = $_[0]->{name};
$newName = $_[0]->{zipName};
$compressionLevel = $_[0]->{compressionLevel};
- }
- else {
- ( $name, $newName, $compressionLevel ) = @_;
+ } else {
+ ($name, $newName, $compressionLevel) = @_;
}
- if ( $^O eq 'MSWin32' && $Archive::Zip::UNICODE ) {
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
$name = Win32::GetANSIPathName($name);
}
$name =~ s{/$}{};
- if ( $newName ) {
+ 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 {
+ 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");
}
}
@@ -365,13 +359,12 @@ sub addFileOrDirectory {
sub contents {
my $self = shift;
- my ( $member, $newContents );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($member, $newContents);
+ if (ref($_[0]) eq 'HASH') {
$member = $_[0]->{memberOrZipName};
$newContents = $_[0]->{contents};
- }
- else {
- ( $member, $newContents ) = @_;
+ } else {
+ ($member, $newContents) = @_;
}
return _error('No member name given') unless $member;
@@ -383,17 +376,17 @@ sub contents {
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 "
+ (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." );
+ . "; consider using overwrite() or overwriteAs() instead.");
}
}
- my ( $status, $fh ) = _newFileHandle( $fileName, 'w' );
+ my ($status, $fh) = _newFileHandle($fileName, 'w');
return _ioError("Can't open $fileName for write") unless $status;
- my $retval = $self->writeToFileHandle( $fh, 1 );
+ my $retval = $self->writeToFileHandle($fh, 1);
$fh->close();
$fh = undef;
@@ -405,14 +398,13 @@ sub writeToFileNamed {
sub writeToFileHandle {
my $self = shift;
- my ( $fh, $fhIsSeekable );
- if ( ref( $_[0] ) eq 'HASH' ) {
- $fh = $_[0]->{fileHandle};
+ my ($fh, $fhIsSeekable);
+ if (ref($_[0]) eq 'HASH') {
+ $fh = $_[0]->{fileHandle};
$fhIsSeekable =
- exists( $_[0]->{seek} ) ? $_[0]->{seek} : _isSeekable($fh);
- }
- else {
- $fh = shift;
+ exists($_[0]->{seek}) ? $_[0]->{seek} : _isSeekable($fh);
+ } else {
+ $fh = shift;
$fhIsSeekable = @_ ? shift : _isSeekable($fh);
}
@@ -422,10 +414,10 @@ sub writeToFileHandle {
# Find out where the current position is.
my $offset = $fhIsSeekable ? $fh->tell() : 0;
- $offset = 0 if $offset < 0;
+ $offset = 0 if $offset < 0;
- foreach my $member ( $self->members() ) {
- my $retval = $member->_writeToFileHandle( $fh, $fhIsSeekable, $offset );
+ 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();
@@ -445,27 +437,27 @@ sub writeToFileHandle {
# Returns AZ_OK if successful.
sub overwrite {
my $self = shift;
- return $self->overwriteAs( $self->{'fileName'} );
+ 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;
+ 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 ($fh, $tempName) = Archive::Zip::tempFile();
+ return _error("Can't open temp file", $!) unless $fh;
- ( my $backupName = $zipName ) =~ s{(\.[^.]*)?$}{.zbk};
+ (my $backupName = $zipName) =~ s{(\.[^.]*)?$}{.zbk};
my $status = $self->writeToFileHandle($fh);
$fh->close();
$fh = undef;
- if ( $status != AZ_OK ) {
+ if ($status != AZ_OK) {
unlink($tempName);
_printError("Can't write to $tempName");
return $status;
@@ -474,24 +466,25 @@ sub overwriteAs {
my $err;
# rename the zip
- if ( -f $zipName && !rename( $zipName, $backupName ) ) {
+ if (-f $zipName && !rename($zipName, $backupName)) {
$err = $!;
unlink($tempName);
- return _error( "Can't rename $zipName as $backupName", $err );
+ 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) ) {
+ unless (File::Copy::move($tempName, $zipName)
+ || File::Copy::copy($tempName, $zipName)) {
$err = $!;
- rename( $backupName, $zipName );
+ rename($backupName, $zipName);
unlink($tempName);
- return _error( "Can't move $tempName to $zipName", $err );
+ return _error("Can't move $tempName to $zipName", $err);
}
# unlink the backup
- if ( -f $backupName && !unlink($backupName) ) {
+ if (-f $backupName && !unlink($backupName)) {
$err = $!;
- return _error( "Can't unlink $backupName", $err );
+ return _error("Can't unlink $backupName", $err);
}
return AZ_OK;
@@ -508,11 +501,11 @@ sub _writeEOCDOffset {
# Expects to have _writeEOCDOffset() set
sub _writeEndOfCentralDirectory {
- my ( $self, $fh ) = @_;
+ my ($self, $fh) = @_;
$self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
or return _ioError('writing EOCD Signature');
- my $zipfileCommentLength = length( $self->zipfileComment() );
+ my $zipfileCommentLength = length($self->zipfileComment());
my $header = pack(
END_OF_CENTRAL_DIRECTORY_FORMAT,
@@ -527,7 +520,7 @@ sub _writeEndOfCentralDirectory {
$self->_print($fh, $header)
or return _ioError('writing EOCD header');
if ($zipfileCommentLength) {
- $self->_print($fh, $self->zipfileComment() )
+ $self->_print($fh, $self->zipfileComment())
or return _ioError('writing zipfile comment');
}
return AZ_OK;
@@ -537,25 +530,23 @@ sub _writeEndOfCentralDirectory {
sub writeCentralDirectory {
my $self = shift;
- my ( $fh, $offset );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($fh, $offset);
+ if (ref($_[0]) eq 'HASH') {
$fh = $_[0]->{fileHandle};
$offset = $_[0]->{offset};
- }
- else {
- ( $fh, $offset ) = @_;
+ } else {
+ ($fh, $offset) = @_;
}
- if ( defined($offset) ) {
+ if (defined($offset)) {
$self->{'writeCentralDirectoryOffset'} = $offset;
- $fh->seek( $offset, IO::Seekable::SEEK_SET )
+ $fh->seek($offset, IO::Seekable::SEEK_SET)
or return _ioError('seeking to write central directory');
- }
- else {
+ } else {
$offset = $self->_writeCentralDirectoryOffset();
}
- foreach my $member ( $self->members() ) {
+ foreach my $member ($self->members()) {
my $status = $member->_writeCentralDirectoryFileHeader($fh);
return $status if $status != AZ_OK;
$offset += $member->_centralDirectoryHeaderSize();
@@ -565,13 +556,13 @@ sub writeCentralDirectory {
}
sub read {
- my $self = shift;
- my $fileName = ( ref( $_[0] ) eq 'HASH' ) ? shift->{filename} : shift;
+ 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' );
+ my ($status, $fh) = _newFileHandle($fileName, 'r');
return _ioError("opening $fileName for read") unless $status;
- $status = $self->readFromFileHandle( $fh, $fileName );
+ $status = $self->readFromFileHandle($fh, $fileName);
return $status if $status != AZ_OK;
$fh->close();
@@ -582,13 +573,12 @@ sub read {
sub readFromFileHandle {
my $self = shift;
- my ( $fh, $fileName );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($fh, $fileName);
+ if (ref($_[0]) eq 'HASH') {
$fh = $_[0]->{fileHandle};
$fileName = $_[0]->{filename};
- }
- else {
- ( $fh, $fileName ) = @_;
+ } else {
+ ($fh, $fileName) = @_;
}
$fileName = $fh unless defined($fileName);
@@ -602,7 +592,7 @@ sub readFromFileHandle {
return _error('file not seekable')
unless _isSeekable($fh);
- $fh->seek( 0, 0 ); # rewind the file
+ $fh->seek(0, 0); # rewind the file
my $status = $self->_findEndOfCentralDirectory($fh);
return $status if $status != AZ_OK;
@@ -612,8 +602,8 @@ sub readFromFileHandle {
$status = $self->_readEndOfCentralDirectory($fh);
return $status if $status != AZ_OK;
- $fh->seek( $eocdPosition - $self->centralDirectorySize(),
- IO::Seekable::SEEK_SET )
+ $fh->seek($eocdPosition - $self->centralDirectorySize(),
+ IO::Seekable::SEEK_SET)
or return _ioError("Can't seek $fileName");
# Try to detect garbage at beginning of archives
@@ -621,20 +611,20 @@ sub readFromFileHandle {
$self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
- $self->centralDirectoryOffsetWRTStartingDiskNumber();
- for ( ; ; ) {
+ for (; ;) {
my $newMember =
- $self->ZIPMEMBERCLASS->_newFromZipFile( $fh, $fileName,
- $self->eocdOffset() );
+ Archive::Zip::Member->_newFromZipFile($fh, $fileName,
+ $self->eocdOffset());
my $signature;
- ( $status, $signature ) = _readSignature( $fh, $fileName );
+ ($status, $signature) = _readSignature($fh, $fileName);
return $status if $status != AZ_OK;
- last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
+ 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 );
+ push(@{$self->{'members'}}, $newMember);
}
return AZ_OK;
@@ -647,12 +637,12 @@ sub _readEndOfCentralDirectory {
my $fh = shift;
# Skip past signature
- $fh->seek( SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR )
+ $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 ) {
+ my $bytesRead = $fh->read($header, END_OF_CENTRAL_DIRECTORY_LENGTH);
+ if ($bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH) {
return _ioError("reading end of central directory");
}
@@ -665,12 +655,12 @@ sub _readEndOfCentralDirectory {
$self->{'centralDirectorySize'},
$self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
$zipfileCommentLength
- ) = unpack( END_OF_CENTRAL_DIRECTORY_FORMAT, $header );
+ ) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header);
if ($zipfileCommentLength) {
my $zipfileComment = '';
- $bytesRead = $fh->read( $zipfileComment, $zipfileCommentLength );
- if ( $bytesRead != $zipfileCommentLength ) {
+ $bytesRead = $fh->read($zipfileComment, $zipfileCommentLength);
+ if ($bytesRead != $zipfileCommentLength) {
return _ioError("reading zipfile comment");
}
$self->{'zipfileComment'} = $zipfileComment;
@@ -686,38 +676,37 @@ sub _findEndOfCentralDirectory {
my $self = shift;
my $fh = shift;
my $data = '';
- $fh->seek( 0, IO::Seekable::SEEK_END )
+ $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 ) {
+ if ($fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4) {
return _formatError("file is too short");
}
my $seekOffset = 0;
my $pos = -1;
- for ( ; ; ) {
+ for (; ;) {
$seekOffset += 512;
- $seekOffset = $fileLength if ( $seekOffset > $fileLength );
- $fh->seek( -$seekOffset, IO::Seekable::SEEK_END )
+ $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 ) {
+ my $bytesRead = $fh->read($data, $seekOffset);
+ if ($bytesRead != $seekOffset) {
return _ioError("read failed");
}
- $pos = rindex( $data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING );
+ $pos = rindex($data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING);
last
if ( $pos >= 0
or $seekOffset == $fileLength
- or $seekOffset >= $Archive::Zip::ChunkSize );
+ or $seekOffset >= $Archive::Zip::ChunkSize);
}
- if ( $pos >= 0 ) {
- $fh->seek( $pos - $seekOffset, IO::Seekable::SEEK_CUR )
+ if ($pos >= 0) {
+ $fh->seek($pos - $seekOffset, IO::Seekable::SEEK_CUR)
or return _ioError("seeking to EOCD");
return AZ_OK;
- }
- else {
+ } else {
return _formatError("can't find EOCD signature");
}
}
@@ -735,26 +724,26 @@ sub _untaintDir {
sub addTree {
my $self = shift;
- my ( $root, $dest, $pred, $compressionLevel );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ 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 ) = @_;
+ } 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);
+ $pred = sub { -r }
+ unless defined($pred);
my @files;
- my $startDir = _untaintDir( cwd() );
+ my $startDir = _untaintDir(cwd());
- return _error( 'undef returned by _untaintDir on cwd ', cwd() )
+ return _error('undef returned by _untaintDir on cwd ', cwd())
unless $startDir;
# This avoids chdir'ing in Find, in a way compatible with older
@@ -763,43 +752,42 @@ sub addTree {
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);
+ 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);
+ } else {
+ push(@files, $File::Find::name) if (&$pred);
}
chdir($dir);
};
- if ( $^O eq 'MSWin32' && $Archive::Zip::UNICODE ) {
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
$root = Win32::GetANSIPathName($root);
}
- File::Find::find( $wanted, $root );
+ File::Find::find($wanted, $root);
- my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
+ my $rootZipName = _asZipDirName($root, 1); # with trailing slash
my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
- $dest = _asZipDirName( $dest, 1 ); # with trailing slash
+ $dest = _asZipDirName($dest, 1); # with trailing slash
foreach my $fileName (@files) {
my $isDir;
- if ( $^O eq 'MSWin32' && $Archive::Zip::UNICODE ) {
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
$isDir = -d Win32::GetANSIPathName($fileName);
- }
- else {
+ } 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 );
+ 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;
@@ -810,16 +798,15 @@ sub addTree {
sub addTreeMatching {
my $self = shift;
- my ( $root, $dest, $pattern, $pred, $compressionLevel );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ 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 ) = @_;
+ } else {
+ ($root, $dest, $pattern, $pred, $compressionLevel) = @_;
}
return _error("root arg missing in call to addTreeMatching()")
@@ -829,7 +816,7 @@ sub addTreeMatching {
unless defined($pattern);
my $matcher =
$pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
- return $self->addTree( $root, $dest, $matcher, $compressionLevel );
+ return $self->addTree($root, $dest, $matcher, $compressionLevel);
}
# $zip->extractTree( $root, $dest [, $volume] );
@@ -840,23 +827,21 @@ sub addTreeMatching {
sub extractTree {
my $self = shift;
- my ( $root, $dest, $volume );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($root, $dest, $volume);
+ if (ref($_[0]) eq 'HASH') {
$root = $_[0]->{root};
$dest = $_[0]->{zipName};
$volume = $_[0]->{volume};
- }
- else {
- ( $root, $dest, $volume ) = @_;
+ } else {
+ ($root, $dest, $volume) = @_;
}
$root = '' unless defined($root);
- if ( defined $dest ) {
- if ( $dest !~ m{/$} ) {
+ if (defined $dest) {
+ if ($dest !~ m{/$}) {
$dest .= '/';
}
- }
- else {
+ } else {
$dest = './';
}
@@ -864,10 +849,10 @@ sub extractTree {
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 $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;
}
@@ -880,22 +865,21 @@ sub extractTree {
sub updateMember {
my $self = shift;
- my ( $oldMember, $fileName );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($oldMember, $fileName);
+ if (ref($_[0]) eq 'HASH') {
$oldMember = $_[0]->{memberOrZipName};
$fileName = $_[0]->{name};
- }
- else {
- ( $oldMember, $fileName ) = @_;
+ } else {
+ ($oldMember, $fileName) = @_;
}
- if ( !defined($fileName) ) {
+ if (!defined($fileName)) {
_error("updateMember(): missing fileName argument");
return undef;
}
my @newStat = stat($fileName);
- if ( !@newStat ) {
+ if (!@newStat) {
_ioError("Can't stat $fileName");
return undef;
}
@@ -904,36 +888,36 @@ sub updateMember {
my $memberName;
- if ( ref($oldMember) ) {
+ if (ref($oldMember)) {
$memberName = $oldMember->fileName();
- }
- else {
- $oldMember = $self->memberNamed( $memberName = $oldMember )
- || $self->memberNamed( $memberName =
- _asZipDirName( $oldMember, $isDir ) );
+ } else {
+ $oldMember = $self->memberNamed($memberName = $oldMember)
+ || $self->memberNamed($memberName =
+ _asZipDirName($oldMember, $isDir));
}
- unless ( defined($oldMember)
+ unless (defined($oldMember)
&& $oldMember->lastModTime() == $newStat[9]
&& $oldMember->isDirectory() == $isDir
- && ( $isDir || ( $oldMember->uncompressedSize() == $newStat[7] ) ) )
- {
+ && ($isDir || ($oldMember->uncompressedSize() == $newStat[7]))) {
# create the new member
- my $newMember = $isDir
- ? $self->ZIPMEMBERCLASS->newDirectoryNamed( $fileName, $memberName )
- : $self->ZIPMEMBERCLASS->newFromFile( $fileName, $memberName );
+ my $newMember =
+ $isDir
+ ? Archive::Zip::Member->newDirectoryNamed($fileName, $memberName)
+ : Archive::Zip::Member->newFromFile($fileName, $memberName);
- unless ( defined($newMember) ) {
+ 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 );
+ if (defined($oldMember)) {
+ $self->replaceMember($oldMember, $newMember);
+ } else {
+ $self->addMember($newMember);
}
- else { $self->addMember($newMember); }
return $newMember;
}
@@ -952,31 +936,31 @@ sub updateMember {
sub updateTree {
my $self = shift;
- my ( $root, $dest, $pred, $mirror, $compressionLevel );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ 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 ) = @_;
+ } 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);
+ $pred = sub { -r }
+ unless defined($pred);
- $dest = _asZipDirName( $dest, 1 );
- my $rootZipName = _asZipDirName( $root, 1 ); # with trailing slash
+ $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() );
+ my $startDir = _untaintDir(cwd());
- return _error( 'undef returned by _untaintDir on cwd ', cwd() )
+ return _error('undef returned by _untaintDir on cwd ', cwd())
unless $startDir;
# This avoids chdir'ing in Find, in a way compatible with older
@@ -985,11 +969,11 @@ sub updateTree {
local $main::_ = $File::Find::name;
my $dir = _untaintDir($File::Find::dir);
chdir($startDir);
- push( @files, $File::Find::name ) if (&$pred);
+ push(@files, $File::Find::name) if (&$pred);
chdir($dir);
};
- File::Find::find( $wanted, $root );
+ 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.
@@ -1000,13 +984,13 @@ sub updateTree {
my $isDir = -d _;
# normalize, remove leading ./
- my $memberName = _asZipDirName( $fileName, $isDir );
- if ( $memberName eq $rootZipName ) { $memberName = $dest }
- else { $memberName =~ s{$pattern}{$dest} }
+ 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 );
+ my $changedMember = $self->updateMember($memberName, $fileName);
$changedMember->desiredCompressionLevel($compressionLevel);
return _error("updateTree failed to update $fileName")
unless ref($changedMember);
@@ -1015,9 +999,9 @@ sub updateTree {
# @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() ) {
+ foreach my $member ($self->members()) {
$self->removeMember($member)
- unless $done{ $member->fileName() };
+ unless $done{$member->fileName()};
}
}
@@ -13,7 +13,7 @@ use Carp;
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
$VERSION = eval $VERSION;
}
@@ -35,15 +35,15 @@ sub new {
sub readFromFile {
my $self = shift;
my $fileName = shift;
- my $fh = IO::File->new( $fileName, "r" );
+ my $fh = IO::File->new($fileName, "r");
CORE::binmode($fh);
- if ( !$fh ) {
+ if (!$fh) {
Carp::carp("Can't open $fileName: $!\n");
return undef;
}
local $/ = undef;
$self->{content} = <$fh>;
- $self->{size} = length( $self->{content} );
+ $self->{size} = length($self->{content});
return $self;
}
@@ -51,7 +51,7 @@ sub contents {
my $self = shift;
if (@_) {
$self->{content} = shift;
- $self->{size} = length( $self->{content} );
+ $self->{size} = length($self->{content});
}
return $self->{content};
}
@@ -73,14 +73,14 @@ sub seek {
my $whence = shift;
# SEEK_SET
- if ( $whence == 0 ) { $self->{position} = $pos; }
+ if ($whence == 0) { $self->{position} = $pos; }
# SEEK_CUR
- elsif ( $whence == 1 ) { $self->{position} += $pos; }
+ elsif ($whence == 1) { $self->{position} += $pos; }
# SEEK_END
- elsif ( $whence == 2 ) { $self->{position} = $self->{size} + $pos; }
- else { return 0; }
+ elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; }
+ else { return 0; }
return 1;
}
@@ -90,18 +90,18 @@ sub tell { return shift->{position}; }
# Copy my data to given buffer
sub read {
my $self = shift;
- my $buf = \( $_[0] );
+ 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} )
+ ($self->{position} + $len > $self->{size})
+ ? ($self->{size} - $self->{position})
: $len;
- substr( $$buf, $offset, $bytesRead ) =
- substr( $self->{content}, $self->{position}, $bytesRead );
+ substr($$buf, $offset, $bytesRead) =
+ substr($self->{content}, $self->{position}, $bytesRead);
$self->{position} += $bytesRead;
return $bytesRead;
}
@@ -109,7 +109,7 @@ sub read {
# Copy given buffer to me
sub write {
my $self = shift;
- my $buf = \( $_[0] );
+ my $buf = \($_[0]);
shift;
my $len = shift;
my $offset = shift || 0;
@@ -117,12 +117,12 @@ sub write {
$$buf = '' if not defined($$buf);
my $bufLen = length($$buf);
my $bytesWritten =
- ( $offset + $len > $bufLen )
+ ($offset + $len > $bufLen)
? $bufLen - $offset
: $len;
- substr( $self->{content}, $self->{position}, $bytesWritten ) =
- substr( $$buf, $offset, $bytesWritten );
- $self->{size} = length( $self->{content} );
+ substr($self->{content}, $self->{position}, $bytesWritten) =
+ substr($$buf, $offset, $bytesWritten);
+ $self->{size} = length($self->{content});
return $bytesWritten;
}
@@ -6,7 +6,7 @@ use File::Path;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw( Archive::Zip::Member );
}
@@ -24,25 +24,25 @@ sub _newNamed {
$self->{'externalFileName'} = $fileName;
$self->fileName($newName);
- if ( -e $fileName ) {
+ if (-e $fileName) {
# -e does NOT do a full stat, so we need to do one now
- if ( -d _ ) {
+ if (-d _ ) {
my @stat = stat(_);
- $self->unixFileAttributes( $stat[2] );
+ $self->unixFileAttributes($stat[2]);
my $mod_t = $stat[9];
- if ( $^O eq 'MSWin32' and !$mod_t ) {
+ 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' );
+ _error($fileName, ' exists but is not a directory');
return undef;
}
} else {
- $self->unixFileAttributes( $self->DEFAULT_DIRECTORY_PERMISSIONS );
- $self->setLastModFileDateTimeFromUnix( time() );
+ $self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS);
+ $self->setLastModFileDateTimeFromUnix(time());
}
return $self;
}
@@ -59,8 +59,8 @@ 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 );
+ mkpath($name, 0, $attribs); # croaks on error
+ utime($self->lastModTime(), $self->lastModTime(), $name);
return AZ_OK;
}
@@ -74,7 +74,7 @@ sub fileName {
# 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;
+ return wantarray ? (undef, AZ_OK) : undef;
}
1;
@@ -4,7 +4,7 @@ use strict;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw ( Archive::Zip::Member );
}
@@ -28,16 +28,16 @@ sub _usesFileNamed {
sub fh {
my $self = shift;
$self->_openFile()
- if !defined( $self->{'fh'} ) || !$self->{'fh'}->opened();
+ 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() );
+ my ($status, $fh) = _newFileHandle($self->externalFileName(), 'r');
+ if (!$status) {
+ _ioError("Can't open", $self->externalFileName());
return undef;
}
$self->{'fh'} = $fh;
@@ -56,8 +56,8 @@ sub _become {
my $self = shift;
my $newClass = shift;
return $self if ref($self) eq $newClass;
- delete( $self->{'externalFileName'} );
- delete( $self->{'fh'} );
+ delete($self->{'externalFileName'});
+ delete($self->{'fh'});
return $self->SUPER::_become($newClass);
}
@@ -6,13 +6,13 @@ use strict;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw( Archive::Zip );
- if ( $^O eq 'MSWin32' ) {
+ if ($^O eq 'MSWin32') {
require Win32;
require Encode;
- Encode->import( qw{ decode_utf8 } );
+ Encode->import(qw{ decode_utf8 });
}
}
@@ -29,11 +29,6 @@ use Compress::Raw::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS );
use File::Path;
use File::Basename;
-use constant ZIPFILEMEMBERCLASS => 'Archive::Zip::ZipFileMember';
-use constant NEWFILEMEMBERCLASS => 'Archive::Zip::NewFileMember';
-use constant STRINGMEMBERCLASS => 'Archive::Zip::StringMember';
-use constant DIRECTORYMEMBERCLASS => 'Archive::Zip::DirectoryMember';
-
# Unix perms for default creation of files/dirs.
use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
use constant DEFAULT_FILE_PERMISSIONS => 0100666;
@@ -45,58 +40,55 @@ use constant FILE_ATTRIB => 0100000;
# Leaves fh positioned immediately after file header or EOCD signature.
sub _newFromZipFile {
my $class = shift;
- my $self = $class->ZIPFILEMEMBERCLASS->_newFromZipFile(@_);
+ my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_);
return $self;
}
sub newFromString {
my $class = shift;
- my ( $stringOrStringRef, $fileName );
- if ( ref( $_[0] ) eq 'HASH' ) {
+ my ($stringOrStringRef, $fileName);
+ if (ref($_[0]) eq 'HASH') {
$stringOrStringRef = $_[0]->{string};
$fileName = $_[0]->{zipName};
- }
- else {
- ( $stringOrStringRef, $fileName ) = @_;
+ } else {
+ ($stringOrStringRef, $fileName) = @_;
}
- my $self = $class->STRINGMEMBERCLASS->_newFromString( $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' ) {
+ my ($fileName, $zipName);
+ if (ref($_[0]) eq 'HASH') {
$fileName = $_[0]->{fileName};
$zipName = $_[0]->{zipName};
- }
- else {
- ( $fileName, $zipName ) = @_;
+ } else {
+ ($fileName, $zipName) = @_;
}
- my $self = $class->NEWFILEMEMBERCLASS->_newFromFileNamed( $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' ) {
+ my ($directoryName, $newName);
+ if (ref($_[0]) eq 'HASH') {
$directoryName = $_[0]->{directoryName};
$newName = $_[0]->{zipName};
- }
- else {
- ( $directoryName, $newName ) = @_;
+ } else {
+ ($directoryName, $newName) = @_;
}
- my $self = $class->DIRECTORYMEMBERCLASS->_newNamed( $directoryName,
- $newName );
+ my $self =
+ Archive::Zip::DirectoryMember->_newNamed($directoryName, $newName);
return $self;
}
@@ -121,25 +113,25 @@ sub new {
'compressedSize' => 0,
'uncompressedSize' => 0,
'isSymbolicLink' => 0,
- 'password' => undef, # password for encrypted data
- 'crc32c' => -1, # crc for decrypted data
+ 'password' => undef, # password for encrypted data
+ 'crc32c' => -1, # crc for decrypted data
@_
};
- bless( $self, $class );
- $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
+ bless($self, $class);
+ $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS);
return $self;
}
sub _becomeDirectoryIfNecessary {
my $self = shift;
- $self->_become(DIRECTORYMEMBERCLASS)
+ $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] );
+ return bless($_[0], $_[1]);
}
sub versionMadeBy {
@@ -150,10 +142,9 @@ sub fileAttributeFormat {
my $self = shift;
if (@_) {
- $self->{fileAttributeFormat} = ( ref( $_[0] ) eq 'HASH' )
- ? $_[0]->{format} : $_[0];
- }
- else {
+ $self->{fileAttributeFormat} =
+ (ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0];
+ } else {
return $self->{fileAttributeFormat};
}
}
@@ -165,14 +156,18 @@ sub versionNeededToExtract {
sub bitFlag {
my $self = shift;
- # Set General Purpose Bit Flags according to the desiredCompressionLevel setting
- if ( $self->desiredCompressionLevel == 1 || $self->desiredCompressionLevel == 2 ) {
+# 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 ) {
+ } 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 ) {
+ } elsif ($self->desiredCompressionLevel == 8
+ || $self->desiredCompressionLevel == 9) {
$self->{'bitFlag'} = DEFLATING_COMPRESSION_MAXIMUM;
}
@@ -195,15 +190,15 @@ sub compressionMethod {
sub desiredCompressionMethod {
my $self = shift;
my $newDesiredCompressionMethod =
- ( ref( $_[0] ) eq 'HASH' ) ? shift->{compressionMethod} : shift;
+ (ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift;
my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'};
- if ( defined($newDesiredCompressionMethod) ) {
+ if (defined($newDesiredCompressionMethod)) {
$self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod;
- if ( $newDesiredCompressionMethod == COMPRESSION_STORED ) {
+ if ($newDesiredCompressionMethod == COMPRESSION_STORED) {
$self->{'desiredCompressionLevel'} = 0;
$self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
- } elsif ( $oldDesiredCompressionMethod == COMPRESSION_STORED ) {
+ } elsif ($oldDesiredCompressionMethod == COMPRESSION_STORED) {
$self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT;
}
}
@@ -213,9 +208,9 @@ sub desiredCompressionMethod {
sub desiredCompressionLevel {
my $self = shift;
my $newDesiredCompressionLevel =
- ( ref( $_[0] ) eq 'HASH' ) ? shift->{compressionLevel} : shift;
+ (ref($_[0]) eq 'HASH') ? shift->{compressionLevel} : shift;
my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'};
- if ( defined($newDesiredCompressionLevel) ) {
+ if (defined($newDesiredCompressionLevel)) {
$self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel;
$self->{'desiredCompressionMethod'} = (
$newDesiredCompressionLevel
@@ -229,7 +224,7 @@ sub desiredCompressionLevel {
sub fileName {
my $self = shift;
my $newName = shift;
- if ( defined $newName ) {
+ if (defined $newName) {
$newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems
$self->{'fileName'} = $newName;
}
@@ -244,7 +239,7 @@ sub lastModFileDateTime {
sub lastModTime {
my $self = shift;
- return _dosToUnixTime( $self->lastModFileDateTime() );
+ return _dosToUnixTime($self->lastModFileDateTime());
}
sub setLastModFileDateTimeFromUnix {
@@ -269,7 +264,7 @@ sub _mapPermissionsFromUnix {
my $attribs = $mode << 16;
# Microsoft Windows Explorer needs this bit set for directories
- if ( $mode & DIRECTORY_ATTRIB ) {
+ if ($mode & DIRECTORY_ATTRIB) {
$attribs |= 16;
}
@@ -297,18 +292,17 @@ sub _mapPermissionsToUnix {
my $mode = 0;
- if ( $format == FA_AMIGA ) {
+ if ($format == FA_AMIGA) {
$attribs = $attribs >> 17 & 7; # Amiga RWE bits
$mode = $attribs << 6 | $attribs << 3 | $attribs;
return $mode;
}
- if ( $format == FA_THEOS ) {
+ if ($format == FA_THEOS) {
$attribs &= 0xF1FFFFFF;
- if ( ( $attribs & 0xF0000000 ) != 0x40000000 ) {
+ if (($attribs & 0xF0000000) != 0x40000000) {
$attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits
- }
- else {
+ } else {
$attribs &= 0x41FFFFFF; # leave directory bit as set
}
}
@@ -319,8 +313,7 @@ sub _mapPermissionsToUnix {
|| $format == FA_ATARI_ST
|| $format == FA_BEOS
|| $format == FA_QDOS
- || $format == FA_TANDEM )
- {
+ || $format == FA_TANDEM) {
$mode = $attribs >> 16;
return $mode if $mode != 0 or not $self->localExtraField;
@@ -349,16 +342,16 @@ sub _mapPermissionsToUnix {
# 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 ) {
+ 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;
+ $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 );
+ return $mode if ($mode & 0700) == (0400 | $attribs << 6);
$mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
return $mode;
}
@@ -368,17 +361,18 @@ sub unixFileAttributes {
my $oldPerms = $self->_mapPermissionsToUnix;
my $perms;
- if ( @_ ) {
- $perms = ( ref( $_[0] ) eq 'HASH' ) ? $_[0]->{attributes} : $_[0];
+ if (@_) {
+ $perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0];
- if ( $self->isDirectory ) {
+ if ($self->isDirectory) {
$perms &= ~FILE_ATTRIB;
$perms |= DIRECTORY_ATTRIB;
} else {
$perms &= ~DIRECTORY_ATTRIB;
$perms |= FILE_ATTRIB;
}
- $self->{externalFileAttributes} = $self->_mapPermissionsFromUnix($perms);
+ $self->{externalFileAttributes} =
+ $self->_mapPermissionsFromUnix($perms);
}
return $oldPerms;
@@ -388,10 +382,9 @@ sub localExtraField {
my $self = shift;
if (@_) {
- $self->{localExtraField} = ( ref( $_[0] ) eq 'HASH' )
- ? $_[0]->{field} : $_[0];
- }
- else {
+ $self->{localExtraField} =
+ (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0];
+ } else {
return $self->{localExtraField};
}
}
@@ -400,10 +393,8 @@ sub cdExtraField {
my $self = shift;
if (@_) {
- $self->{cdExtraField} = ( ref( $_[0] ) eq 'HASH' )
- ? $_[0]->{field} : $_[0];
- }
- else {
+ $self->{cdExtraField} = (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0];
+ } else {
return $self->{cdExtraField};
}
}
@@ -417,10 +408,11 @@ sub fileComment {
my $self = shift;
if (@_) {
- $self->{fileComment} = ( ref( $_[0] ) eq 'HASH' )
- ? pack( 'C0a*', $_[0]->{comment} ) : pack( 'C0a*', $_[0] );
- }
- else {
+ $self->{fileComment} =
+ (ref($_[0]) eq 'HASH')
+ ? pack('C0a*', $_[0]->{comment})
+ : pack('C0a*', $_[0]);
+ } else {
return $self->{fileComment};
}
}
@@ -431,8 +423,7 @@ sub hasDataDescriptor {
my $shouldHave = shift;
if ($shouldHave) {
$self->{'bitFlag'} |= GPBF_HAS_DATA_DESCRIPTOR_MASK;
- }
- else {
+ } else {
$self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK;
}
}
@@ -444,7 +435,7 @@ sub crc32 {
}
sub crc32String {
- sprintf( "%08x", shift->{'crc32'} );
+ sprintf("%08x", shift->{'crc32'});
}
sub compressedSize {
@@ -463,10 +454,10 @@ sub isTextFile {
my $self = shift;
my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK;
if (@_) {
- my $flag = ( ref( $_[0] ) eq 'HASH' ) ? shift->{flag} : shift;
+ my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift;
$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
$self->{'internalFileAttributes'} |=
- ( $flag ? IFA_TEXT_FILE: IFA_BINARY_FILE );
+ ($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE);
}
return $bit == IFA_TEXT_FILE;
}
@@ -478,7 +469,7 @@ sub isBinaryFile {
my $flag = shift;
$self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK;
$self->{'internalFileAttributes'} |=
- ( $flag ? IFA_BINARY_FILE: IFA_TEXT_FILE );
+ ($flag ? IFA_BINARY_FILE : IFA_TEXT_FILE);
}
return $bit == IFA_BINARY_FILE;
}
@@ -487,41 +478,40 @@ sub extractToFileNamed {
my $self = shift;
# local FS name
- my $name = ( ref( $_[0] ) eq 'HASH' ) ? $_[0]->{name} : $_[0];
+ 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 ) {
+ if ($self->{'externalFileAttributes'} == 0xA1FF0000) {
$self->{'isSymbolicLink'} = 1;
- $self->{'newName'} = $name;
- my ( $status, $fh ) = _newFileHandle( $name, 'r' );
+ $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) );
+
+ my ($status, $fh);
+ if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
+ $name = decode_utf8(Win32::GetFullPathName($name));
mkpath_win32($name);
- if ( $self->{'compressedSize'} == 0 ) {
+ if ($self->{'compressedSize'} == 0) {
return;
- }
- else {
+ } else {
Win32::CreateFile($name);
}
- ( $status, $fh ) = _newFileHandle( Win32::GetANSIPathName($name), 'w' );
- }
- else {
- mkpath( dirname($name) ); # croaks on error
- ( $status, $fh ) = _newFileHandle( $name, 'w' );
+ ($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 );
+ chmod($self->unixFileAttributes(), $name)
+ or return _error("Can't chmod() ${name}: $!");
+ utime($self->lastModTime(), $self->lastModTime(), $name);
return $retval;
}
}
@@ -530,28 +520,29 @@ sub mkpath_win32 {
my $path = shift;
use File::Spec;
- my ( $volume, @path ) = File::Spec->splitdir($path);
- $path = File::Spec->catfile( $volume, shift @path );
+ 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 );
+ $path = File::Spec->catfile($path, shift @path);
Win32::CreateDirectory($path);
}
}
sub _writeSymbolicLink {
- my $self = shift;
- my $name = shift;
+ 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);
+ my ($outRef, undef) = $self->readChunk(100);
}
sub isSymbolicLink {
my $self = shift;
- if ( $self->{'externalFileAttributes'} == 0xA1FF0000 ) {
+ if ($self->{'externalFileAttributes'} == 0xA1FF0000) {
$self->{'isSymbolicLink'} = 1;
} else {
return 0;
@@ -603,8 +594,10 @@ sub _localHeaderSize {
my $self = shift;
{
use bytes;
- return SIGNATURE_LENGTH + LOCAL_FILE_HEADER_LENGTH +
- length( $self->fileName() ) + length( $self->localExtraField() );
+ return SIGNATURE_LENGTH +
+ LOCAL_FILE_HEADER_LENGTH +
+ length($self->fileName()) +
+ length($self->localExtraField());
}
}
@@ -613,9 +606,11 @@ sub _centralDirectoryHeaderSize {
my $self = shift;
{
use bytes;
- return SIGNATURE_LENGTH + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
- length( $self->fileName() ) + length( $self->cdExtraField() ) +
- length( $self->fileComment() );
+ return SIGNATURE_LENGTH +
+ CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
+ length($self->fileName()) +
+ length($self->cdExtraField()) +
+ length($self->fileComment());
}
}
@@ -633,17 +628,17 @@ 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 $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 );
+ 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 ); };
+ eval { Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year); };
return time() if ($@);
return $time_t;
}
@@ -660,18 +655,18 @@ sub _unixToDosTime {
_error("Tried to add member with zero or undef value for time");
$time_t = $safe_epoch;
}
- if ( $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 ($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 );
+ $dt += ($sec >> 1);
+ $dt += ($min << 5);
+ $dt += ($hour << 11);
+ $dt += ($mday << 16);
+ $dt += (($mon + 1) << 21);
+ $dt += (($year - 80) << 25);
return $dt;
}
@@ -680,17 +675,15 @@ sub head {
use bytes;
return pack LOCAL_FILE_HEADER_FORMAT,
- $self->versionNeededToExtract(),
- $self->{'bitFlag'},
- $self->desiredCompressionMethod(),
- $self->lastModFileDateTime(),
- $self->crc32(),
- $mode
- ? $self->_writeOffset() # compressed size
- : $self->compressedSize(), # may need to be re-written later
- $self->uncompressedSize(),
- length( $self->fileName() ),
- length( $self->localExtraField() );
+ $self->versionNeededToExtract(),
+ $self->{'bitFlag'},
+ $self->desiredCompressionMethod(),
+ $self->lastModFileDateTime(), $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.
@@ -701,7 +694,7 @@ sub _writeLocalFileHeader {
my $self = shift;
my $fh = shift;
- my $signatureData = pack( SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE );
+ my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE);
$self->_print($fh, $signatureData)
or return _ioError("writing local header signature");
@@ -710,12 +703,12 @@ sub _writeLocalFileHeader {
$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() )
+ 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() )
+ if ($self->localExtraField()) {
+ $self->_print($fh, $self->localExtraField())
or return _ioError("writing local extra field");
}
@@ -727,16 +720,16 @@ sub _writeCentralDirectoryFileHeader {
my $fh = shift;
my $sigData =
- pack( SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE );
+ pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE);
$self->_print($fh, $sigData)
or return _ioError("writing central directory header signature");
- my ( $fileNameLength, $extraFieldLength, $fileCommentLength );
+ my ($fileNameLength, $extraFieldLength, $fileCommentLength);
{
use bytes;
- $fileNameLength = length( $self->fileName() );
- $extraFieldLength = length( $self->cdExtraField() );
- $fileCommentLength = length( $self->fileComment() );
+ $fileNameLength = length($self->fileName());
+ $extraFieldLength = length($self->cdExtraField());
+ $fileCommentLength = length($self->fileComment());
}
my $header = pack(
@@ -756,21 +749,20 @@ sub _writeCentralDirectoryFileHeader {
0, # {'diskNumberStart'},
$self->internalFileAttributes(),
$self->externalFileAttributes(),
- $self->writeLocalHeaderRelativeOffset()
- );
+ $self->writeLocalHeaderRelativeOffset());
$self->_print($fh, $header)
or return _ioError("writing central directory header");
if ($fileNameLength) {
- $self->_print($fh, $self->fileName() )
+ $self->_print($fh, $self->fileName())
or return _ioError("writing central directory header signature");
}
if ($extraFieldLength) {
- $self->_print($fh, $self->cdExtraField() )
+ $self->_print($fh, $self->cdExtraField())
or return _ioError("writing central directory extra field");
}
if ($fileCommentLength) {
- $self->_print($fh, $self->fileComment() )
+ $self->_print($fh, $self->fileComment())
or return _ioError("writing central directory file comment");
}
@@ -790,8 +782,7 @@ sub _writeDataDescriptor {
DATA_DESCRIPTOR_SIGNATURE,
$self->crc32(),
$self->_writeOffset(), # compressed size
- $self->uncompressedSize()
- );
+ $self->uncompressedSize());
$self->_print($fh, $header)
or return _ioError("writing data descriptor");
@@ -806,15 +797,15 @@ sub _refreshLocalFileHeader {
my $fh = shift;
my $here = $fh->tell();
- $fh->seek( $self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH,
- IO::Seekable::SEEK_SET )
+ $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 )
+ $fh->seek($here, IO::Seekable::SEEK_SET)
or return _ioError("seeking after rewrite of local header");
return AZ_OK;
@@ -822,12 +813,12 @@ sub _refreshLocalFileHeader {
sub readChunk {
my $self = shift;
- my $chunkSize = ( ref( $_[0] ) eq 'HASH' ) ? $_[0]->{chunkSize} : $_[0];
+ my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0];
- if ( $self->readIsDone() ) {
+ if ($self->readIsDone()) {
$self->endRead();
my $dummy = '';
- return ( \$dummy, AZ_STREAM_END );
+ return (\$dummy, AZ_STREAM_END);
}
$chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize);
@@ -836,24 +827,24 @@ sub readChunk {
my $buffer = '';
my $outputRef;
- my ( $bytesRead, $status ) = $self->_readRawChunk( \$buffer, $chunkSize );
- return ( \$buffer, $status ) unless $status == AZ_OK;
+ 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'} );
+ if ($self->compressionMethod() == COMPRESSION_STORED) {
+ $self->{'crc32'} = $self->computeCRC32($buffer, $self->{'crc32'});
}
- ( $outputRef, $status ) = &{ $self->{'chunkHandler'} }( $self, \$buffer );
+ ($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer);
$self->{'writeOffset'} += length($$outputRef);
$self->endRead()
if $self->readIsDone();
- return ( $outputRef, $status );
+ return ($outputRef, $status);
}
# Read the next raw chunk of my data. Subclasses MUST implement.
@@ -867,53 +858,50 @@ sub _readRawChunk {
# the error code.
sub _noChunk {
my $self = shift;
- return ( \undef, _error("trying to copy chunk when init failed") );
+ 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 );
+ 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 );
+ my ($self, $buffer) = @_;
+ my ($status) = $self->_deflater()->deflate($buffer, my $out);
- if ( $self->_readDataRemaining() == 0 ) {
+ if ($self->_readDataRemaining() == 0) {
my $extraOutput;
- ( $status ) = $self->_deflater()->flush($extraOutput);
+ ($status) = $self->_deflater()->flush($extraOutput);
$out .= $extraOutput;
$self->endRead();
- return ( \$out, AZ_STREAM_END );
- }
- elsif ( $status == Z_OK ) {
- return ( \$out, AZ_OK );
- }
- else {
+ return (\$out, AZ_STREAM_END);
+ } elsif ($status == Z_OK) {
+ return (\$out, AZ_OK);
+ } else {
$self->endRead();
- my $retval = _error( 'deflate error', $status );
+ my $retval = _error('deflate error', $status);
my $dummy = '';
- return ( \$dummy, $retval );
+ return (\$dummy, $retval);
}
}
# ( $outputRef, $status) = $self->_inflateChunk( \$buffer );
sub _inflateChunk {
- my ( $self, $buffer ) = @_;
- my ( $status ) = $self->_inflater()->inflate( $buffer, my $out );
+ 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 );
+ 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 );
+ return (\$dummy, $retval);
}
}
@@ -930,49 +918,42 @@ sub rewindData {
# assume that we're going to read the whole file, and compute the CRC anew.
$self->{'crc32'} = 0
- if ( $self->compressionMethod() == COMPRESSION_STORED );
+ 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(
+ 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 )
+ 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(
+ } 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 )
+ return _error('inflateInit error:', $status)
unless $status == Z_OK;
$self->{'chunkHandler'} = $self->can('_inflateChunk');
- }
- elsif ( $self->compressionMethod() == $self->desiredCompressionMethod() ) {
+ } elsif ($self->compressionMethod() == $self->desiredCompressionMethod()) {
$self->{'chunkHandler'} = $self->can('_copyChunk');
- }
- else {
+ } else {
return _error(
sprintf(
"Unsupported compression combination: read %d, write %d",
$self->compressionMethod(),
- $self->desiredCompressionMethod()
- )
- );
+ $self->desiredCompressionMethod()));
}
$self->{'readDataRemaining'} =
- ( $self->compressionMethod() == COMPRESSION_STORED )
+ ($self->compressionMethod() == COMPRESSION_STORED)
? $self->uncompressedSize()
: $self->compressedSize();
$self->{'dataEnded'} = 0;
@@ -992,50 +973,49 @@ sub endRead {
sub readIsDone {
my $self = shift;
- return ( $self->_dataEnded() or !$self->_readDataRemaining() );
+ return ($self->_dataEnded() or !$self->_readDataRemaining());
}
sub contents {
my $self = shift;
my $newContents = shift;
- if ( defined($newContents) ) {
+ if (defined($newContents)) {
# change our type and call the subclass contents method.
- $self->_become(STRINGMEMBERCLASS);
- return $self->contents( pack( 'C0a*', $newContents ) )
- ; # in case of Unicode
- }
- else {
+ $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 ) {
+ if ($status != AZ_OK) {
$self->endRead();
return $status;
}
my $retval = '';
- while ( $status == AZ_OK ) {
+ while ($status == AZ_OK) {
my $ref;
- ( $ref, $status ) = $self->readChunk( $self->_readDataRemaining() );
+ ($ref, $status) = $self->readChunk($self->_readDataRemaining());
# did we get it in one chunk?
- if ( length($$ref) == $self->uncompressedSize() ) {
+ if (length($$ref) == $self->uncompressedSize()) {
$retval = $$ref;
+ } else {
+ $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;
+ return wantarray ? ($retval, $status) : $retval;
}
}
sub extractToFileHandle {
my $self = shift;
- my $fh = ( ref( $_[0] ) eq 'HASH' ) ? shift->{fileHandle} : shift;
+ my $fh = (ref($_[0]) eq 'HASH') ? shift->{fileHandle} : shift;
_binmode($fh);
my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED);
my $status = $self->rewindData(@_);
@@ -1062,19 +1042,18 @@ sub _writeToFileHandle {
# 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 )
+ ($self->uncompressedSize() > 0)
and ($self->compressionMethod() == COMPRESSION_STORED
- or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED )
- );
+ or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED));
# Set both compressedSize and uncompressedSize to 0 if either of them is 0
- if ( $self->uncompressedSize == 0 || $self->uncompressedSize == 0 ) {
+ if ($self->uncompressedSize == 0 || $self->uncompressedSize == 0) {
$self->{'compressedSize'} = 0;
$self->{'uncompressedSize'} = 0;
}
my $shouldWriteDataDescriptor =
- ( $headerFieldsUnknown and not $fhIsSeekable );
+ ($headerFieldsUnknown and not $fhIsSeekable);
$self->hasDataDescriptor(1)
if ($shouldWriteDataDescriptor);
@@ -1082,16 +1061,15 @@ sub _writeToFileHandle {
$self->{'writeOffset'} = 0;
my $status = $self->rewindData();
- ( $status = $self->_writeLocalFileHeader($fh) )
+ ($status = $self->_writeLocalFileHeader($fh))
if $status == AZ_OK;
- ( $status = $self->_writeData($fh) )
+ ($status = $self->_writeData($fh))
if $status == AZ_OK;
- if ( $status == AZ_OK ) {
+ if ($status == AZ_OK) {
$self->{'wasWritten'} = 1;
- if ( $self->hasDataDescriptor() ) {
+ if ($self->hasDataDescriptor()) {
$status = $self->_writeDataDescriptor($fh);
- }
- elsif ($headerFieldsUnknown) {
+ } elsif ($headerFieldsUnknown) {
$status = $self->_refreshLocalFileHeader($fh);
}
}
@@ -1105,22 +1083,22 @@ 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' ) {
+# 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);
+ my ($outRef, $status) = $self->readChunk($chunkSize);
symlink $$outRef, $self->{'newName'};
} else {
- return AZ_OK if ( $self->uncompressedSize() == 0 );
+ return AZ_OK if ($self->uncompressedSize() == 0);
my $status;
my $chunkSize = $Archive::Zip::ChunkSize;
- while ( $self->_readDataRemaining() > 0 ) {
+ while ($self->_readDataRemaining() > 0) {
my $outRef;
- ( $outRef, $status ) = $self->readChunk($chunkSize);
- return $status if ( $status != AZ_OK and $status != AZ_STREAM_END );
+ ($outRef, $status) = $self->readChunk($chunkSize);
+ return $status if ($status != AZ_OK and $status != AZ_STREAM_END);
- if ( length($$outRef) > 0 ) {
+ if (length($$outRef) > 0) {
$self->_print($writeFh, $$outRef)
or return _ioError("write error during copy");
}
@@ -1199,50 +1177,47 @@ my @crct = do {
foreach my $n (0 .. 255) {
my $c = $n;
$c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8;
- $crc[$n] = _revbe ($c);
- }
+ $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;
- };
+ }
+ map { _revbe($crc[$_]) } 0 .. 1023;
+};
-sub _crc32
-{
+sub _crc32 {
my ($c, $b) = @_;
return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8));
- } # _crc32
+} # _crc32
-sub _revbe
-{
+sub _revbe {
my $w = shift;
- return (($w >> 24) + (($w >> 8) & 0xff00) +
- (($w & 0xff00) << 8) + (($w & 0xff) << 24));
- } # _revbe
+ return (($w >> 24) +
+ (($w >> 8) & 0xff00) +
+ (($w & 0xff00) << 8) +
+ (($w & 0xff) << 24));
+} # _revbe
-sub _update_keys
-{
+sub _update_keys {
use integer;
- my $c = shift; # signed int
- $keys[0] = _crc32 ($keys[0], $c);
+ 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
+ $keys[2] = _crc32($keys[2], $keyshift);
+} # _update_keys
-sub _zdecode ($)
-{
+sub _zdecode ($) {
my $c = shift;
my $t = ($keys[2] & 0xffff) | 2;
- _update_keys ($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff));
+ _update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff));
return $c;
- } # _zdecode
+} # _zdecode
-sub _decode
-{
+sub _decode {
my $self = shift;
my $buff = shift;
@@ -1252,23 +1227,26 @@ sub _decode
defined $pass or return "";
@keys = (0x12345678, 0x23456789, 0x34567890);
- _update_keys ($_) for unpack "C*", $pass;
+ _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
+ 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;
+ $buff = pack "C*" => map { _zdecode($_) } unpack "C*" => $buff;
+
# DHexDump ($buff);
return $buff;
- } # _decode
+} # _decode
1;
@@ -40,10 +40,11 @@ use vars qw{$VERSION};
my $nl;
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
$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";
+
+# 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()
@@ -62,7 +63,7 @@ calling C<readFileHandle()>:
=cut
sub Archive::Zip::Member::readFileHandle {
- return Archive::Zip::MemberRead->new( shift() );
+ return Archive::Zip::MemberRead->new(shift());
}
=item Archive::Zip::MemberRead->new($zip, $fileName)
@@ -78,31 +79,29 @@ Construct a new Archive::Zip::MemberRead on the specified member.
=cut
sub new {
- my ( $class, $zip, $file ) = @_;
- my ( $self, $member );
+ my ($class, $zip, $file) = @_;
+ my ($self, $member);
- if ( $zip && $file ) # zip and filename, or zip and 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
+ } elsif ($zip && !$file && ref($zip)) # just member
{
$member = $zip;
- }
- else {
+ } else {
die(
-'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
+ 'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
);
}
$self = {};
- bless( $self, $class );
+ bless($self, $class);
$self->set_member($member);
return $self;
}
sub set_member {
- my ( $self, $member ) = @_;
+ my ($self, $member) = @_;
$self->{member} = $member;
$self->set_compression(COMPRESSION_STORED);
@@ -110,7 +109,7 @@ sub set_member {
}
sub set_compression {
- my ( $self, $compression ) = @_;
+ my ($self, $compression) = @_;
$self->{member}->desiredCompressionMethod($compression) if $self->{member};
}
@@ -162,11 +161,12 @@ the global $/) is always returned.
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} : $/;
+ 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
@@ -176,6 +176,7 @@ sub input_record_separator {
# 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($/);
}
@@ -228,12 +229,11 @@ Default is the chunk size used by Archive::Zip.
=cut
sub buffer_size {
- my ( $self, $size ) = @_;
+ my ($self, $size) = @_;
- if ( !$size ) {
+ if (!$size) {
return $self->{chunkSize} || Archive::Zip::chunkSize();
- }
- else {
+ } else {
$self->{chunkSize} = $size;
}
}
@@ -254,35 +254,33 @@ Returns the next line including the line ending.
=cut
sub getline {
- my ( $self, $argref ) = @_;
+ my ($self, $argref) = @_;
my $size = $self->buffer_size();
my $sep = $self->_sep_re();
my $preserve_line_ending;
- if ( ref $argref eq 'HASH' ) {
+ if (ref $argref eq 'HASH') {
$preserve_line_ending = $argref->{'preserve_line_ending'};
$sep =~ s/\\([^A-Za-z_0-9])+/$1/g;
}
- for (;;) {
+ for (; ;) {
if ( $sep
&& defined($self->{buffer})
- && $self->{buffer} =~ s/^(.*?)$sep//s
- ) {
+ && $self->{buffer} =~ s/^(.*?)$sep//s) {
my $line = $1;
$self->{line_no}++;
if ($preserve_line_ending) {
return $line . $sep;
- }
- else {
+ } else {
return $line;
}
} elsif ($self->{at_end}) {
$self->{line_no}++ if $self->{buffer};
return delete $self->{buffer};
}
- my ($temp,$status) = $self->{member}->readChunk($size);
+ my ($temp, $status) = $self->{member}->readChunk($size);
if ($status != AZ_OK && $status != AZ_STREAM_END) {
die "ERROR: Error reading chunk from archive - $status";
}
@@ -314,14 +312,13 @@ Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>:
sub read {
my $self = $_[0];
my $size = $_[2];
- my ( $temp, $status, $ret );
+ my ($temp, $status, $ret);
- ( $temp, $status ) = $self->{member}->readChunk($size);
- if ( $status != AZ_OK && $status != AZ_STREAM_END ) {
+ ($temp, $status) = $self->{member}->readChunk($size);
+ if ($status != AZ_OK && $status != AZ_STREAM_END) {
$_[1] = undef;
$ret = undef;
- }
- else {
+ } else {
$_[1] = $$temp;
$ret = length($$temp);
}
@@ -10,7 +10,7 @@ use strict;
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
$VERSION = eval $VERSION;
}
@@ -35,9 +35,9 @@ sub eof {
# Copy given buffer to me
sub print {
my $self = shift;
- my $bytes = join( '', @_ );
+ my $bytes = join('', @_);
my $bytesWritten = $self->writeHook($bytes);
- if ( $self->{'position'} + $bytesWritten > $self->{'size'} ) {
+ if ($self->{'position'} + $bytesWritten > $self->{'size'}) {
$self->{'size'} = $self->{'position'} + $bytesWritten;
}
$self->{'position'} += $bytesWritten;
@@ -4,7 +4,7 @@ use strict;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw ( Archive::Zip::FileMember );
}
@@ -20,21 +20,21 @@ sub _newFromFileNamed {
my $fileName = shift; # local FS format
my $newName = shift;
$newName = _asZipDirName($fileName) unless defined($newName);
- return undef unless ( stat($fileName) && -r _ && !-d _ );
+ return undef unless (stat($fileName) && -r _ && !-d _ );
my $self = $class->new(@_);
- $self->{'fileName'} = $newName;
+ $self->{'fileName'} = $newName;
$self->{'externalFileName'} = $fileName;
$self->{'compressionMethod'} = COMPRESSION_STORED;
my @stat = stat(_);
$self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
$self->desiredCompressionMethod(
- ( $self->compressedSize() > 0 )
+ ($self->compressedSize() > 0)
? COMPRESSION_DEFLATED
: COMPRESSION_STORED
);
- $self->unixFileAttributes( $stat[2] );
- $self->setLastModFileDateTimeFromUnix( $stat[9] );
- $self->isTextFile( -T _ );
+ $self->unixFileAttributes($stat[2]);
+ $self->setLastModFileDateTimeFromUnix($stat[9]);
+ $self->isTextFile(-T _ );
return $self;
}
@@ -46,8 +46,8 @@ sub rewindData {
return AZ_IO_ERROR unless $self->fh();
$self->fh()->clearerr();
- $self->fh()->seek( 0, IO::Seekable::SEEK_SET )
- or return _ioError( "rewinding", $self->externalFileName() );
+ $self->fh()->seek(0, IO::Seekable::SEEK_SET)
+ or return _ioError("rewinding", $self->externalFileName());
return AZ_OK;
}
@@ -55,24 +55,22 @@ sub rewindData {
# 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 );
+ 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 )
- {
+ if (File::Spec->rel2abs($name) eq
+ File::Spec->rel2abs($self->externalFileName()) and -r $name) {
return AZ_OK;
- }
- else {
- return $self->SUPER::extractToFileNamed( $name, @_ );
+ } else {
+ return $self->SUPER::extractToFileNamed($name, @_);
}
}
@@ -4,7 +4,7 @@ use strict;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw( Archive::Zip::Member );
}
@@ -24,8 +24,8 @@ sub _newFromString {
$self->fileName($name) if defined($name);
# Set the file date to now
- $self->setLastModFileDateTimeFromUnix( time() );
- $self->unixFileAttributes( $self->DEFAULT_FILE_PERMISSIONS );
+ $self->setLastModFileDateTimeFromUnix(time());
+ $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS);
return $self;
}
@@ -33,7 +33,7 @@ sub _become {
my $self = shift;
my $newClass = shift;
return $self if ref($self) eq $newClass;
- delete( $self->{'contents'} );
+ delete($self->{'contents'});
return $self->SUPER::_become($newClass);
}
@@ -42,11 +42,11 @@ sub _become {
sub contents {
my $self = shift;
my $string = shift;
- if ( defined($string) ) {
+ if (defined($string)) {
$self->{'contents'} =
- pack( 'C0a*', ( ref($string) eq 'SCALAR' ) ? $$string : $string );
+ pack('C0a*', (ref($string) eq 'SCALAR') ? $$string : $string);
$self->{'uncompressedSize'} = $self->{'compressedSize'} =
- length( $self->{'contents'} );
+ length($self->{'contents'});
$self->{'compressionMethod'} = COMPRESSION_STORED;
}
return $self->{'contents'};
@@ -56,9 +56,9 @@ sub contents {
# 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 );
+ my ($self, $dataRef, $chunkSize) = @_;
+ $$dataRef = substr($self->contents(), $self->_readOffset(), $chunkSize);
+ return (length($$dataRef), AZ_OK);
}
1;
@@ -2,14 +2,15 @@ package Archive::Zip::Tree;
use strict;
use vars qw{$VERSION};
+
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
}
use Archive::Zip;
warn(
-"Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip."
+ "Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip."
) if $^W;
1;
@@ -4,7 +4,7 @@ use strict;
use vars qw( $VERSION @ISA );
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
@ISA = qw ( Archive::Zip::FileMember );
}
@@ -39,11 +39,8 @@ sub _newFromZipFile {
sub isDirectory {
my $self = shift;
- return (
- substr( $self->fileName, -1, 1 ) eq '/'
- and
- $self->uncompressedSize == 0
- );
+ return (substr($self->fileName, -1, 1) eq '/'
+ and $self->uncompressedSize == 0);
}
# Seek to the beginning of the local header, just past the signature.
@@ -65,21 +62,21 @@ sub _seekToLocalHeader {
my $status;
my $signature;
- $status = $self->fh()->seek( $where, IO::Seekable::SEEK_SET );
+ $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 );
+ ($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'} ) {
+ if ($status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'}) {
$status = $self->_seekToLocalHeader(
$self->localHeaderRelativeOffset() + $self->{'possibleEocdOffset'},
$where
);
- if ( $status == AZ_OK ) {
+ if ($status == AZ_OK) {
$self->{'localHeaderRelativeOffset'} +=
$self->{'possibleEocdOffset'};
$self->{'possibleEocdOffset'} = 0;
@@ -101,18 +98,18 @@ sub _become {
my $status = AZ_OK;
- if ( _isSeekable( $self->fh() ) ) {
+ 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 );
+ $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'} );
+ delete($self->{'eocdCrc32'});
+ delete($self->{'diskNumberStart'});
+ delete($self->{'localHeaderRelativeOffset'});
+ delete($self->{'dataOffset'});
return $self->SUPER::_become($newClass);
}
@@ -134,8 +131,8 @@ sub dataOffset {
sub _skipLocalFileHeader {
my $self = shift;
my $header;
- my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
- if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH ) {
+ my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH);
+ if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) {
return _ioError("reading local file header");
}
my $fileNameLength;
@@ -151,31 +148,31 @@ sub _skipLocalFileHeader {
undef, # $uncompressedSize,
$fileNameLength,
$extraFieldLength
- ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
+ ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header);
if ($fileNameLength) {
- $self->fh()->seek( $fileNameLength, IO::Seekable::SEEK_CUR )
+ $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 ) {
+ $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 ) {
+ 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 )
+ $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.
@@ -186,16 +183,16 @@ sub _skipLocalFileHeader {
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;
+ # 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'} );
+ || $oldUncompressedSize != $self->{'uncompressedSize'});
}
return AZ_OK;
@@ -209,8 +206,8 @@ sub _skipLocalFileHeader {
sub _readLocalFileHeader {
my $self = shift;
my $header;
- my $bytesRead = $self->fh()->read( $header, LOCAL_FILE_HEADER_LENGTH );
- if ( $bytesRead != LOCAL_FILE_HEADER_LENGTH ) {
+ my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH);
+ if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) {
return _ioError("reading local file header");
}
my $fileNameLength;
@@ -224,12 +221,12 @@ sub _readLocalFileHeader {
$crc32, $compressedSize,
$uncompressedSize, $fileNameLength,
$extraFieldLength
- ) = unpack( LOCAL_FILE_HEADER_FORMAT, $header );
+ ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header);
if ($fileNameLength) {
my $fileName;
- $bytesRead = $self->fh()->read( $fileName, $fileNameLength );
- if ( $bytesRead != $fileNameLength ) {
+ $bytesRead = $self->fh()->read($fileName, $fileNameLength);
+ if ($bytesRead != $fileNameLength) {
return _ioError("reading local file name");
}
$self->fileName($fileName);
@@ -237,31 +234,30 @@ sub _readLocalFileHeader {
if ($extraFieldLength) {
$bytesRead =
- $self->fh()->read( $self->{'localExtraField'}, $extraFieldLength );
- if ( $bytesRead != $extraFieldLength ) {
+ $self->fh()->read($self->{'localExtraField'}, $extraFieldLength);
+ if ($bytesRead != $extraFieldLength) {
return _ioError("reading local extra field");
}
}
$self->{'dataOffset'} = $self->fh()->tell();
- if ( $self->hasDataDescriptor() ) {
+ 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 )
+ $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 {
+ } else {
return _formatError(
"CRC or size mismatch after reading data descriptor")
if ( $self->{'crc32'} != $crc32
- || $self->{'uncompressedSize'} != $uncompressedSize );
+ || $self->{'uncompressedSize'} != $uncompressedSize);
}
return AZ_OK;
@@ -280,35 +276,32 @@ sub _readDataDescriptor {
my $compressedSize;
my $uncompressedSize;
- my $bytesRead = $self->fh()->read( $signatureData, SIGNATURE_LENGTH );
+ my $bytesRead = $self->fh()->read($signatureData, SIGNATURE_LENGTH);
return _ioError("reading header signature")
if $bytesRead != SIGNATURE_LENGTH;
- my $signature = unpack( SIGNATURE_FORMAT, $signatureData );
+ 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 );
+ 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 );
+ ($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 );
+ ($compressedSize, $uncompressedSize) =
+ unpack(DATA_DESCRIPTOR_FORMAT_NO_SIG, $header);
}
$self->{'eocdCrc32'} = $self->{'crc32'}
- unless defined( $self->{'eocdCrc32'} );
+ unless defined($self->{'eocdCrc32'});
$self->{'crc32'} = $crc32;
$self->{'compressedSize'} = $compressedSize;
$self->{'uncompressedSize'} = $uncompressedSize;
@@ -323,11 +316,11 @@ 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 ) {
+ 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 );
+ my ($fileNameLength, $extraFieldLength, $fileCommentLength);
(
$self->{'versionMadeBy'},
$self->{'fileAttributeFormat'},
@@ -345,37 +338,36 @@ sub _readCentralDirectoryFileHeader {
$self->{'internalFileAttributes'},
$self->{'externalFileAttributes'},
$self->{'localHeaderRelativeOffset'}
- ) = unpack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header );
+ ) = unpack(CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header);
$self->{'eocdCrc32'} = $self->{'crc32'};
if ($fileNameLength) {
- $bytesRead = $fh->read( $self->{'fileName'}, $fileNameLength );
- if ( $bytesRead != $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 ) {
+ $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 ) {
+ $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 )
- {
+ and $self->{'compressionMethod'} == COMPRESSION_STORED) {
$self->{'uncompressedSize'} = $self->{'compressedSize'};
}
- $self->desiredCompressionMethod( $self->compressionMethod() );
+ $self->desiredCompressionMethod($self->compressionMethod());
return AZ_OK;
}
@@ -401,7 +393,7 @@ sub rewindData {
return $status unless $status == AZ_OK;
# Seek to beginning of file data
- $self->fh()->seek( $self->dataOffset(), IO::Seekable::SEEK_SET )
+ $self->fh()->seek($self->dataOffset(), IO::Seekable::SEEK_SET)
or return _ioError("seeking to beginning of file data");
return AZ_OK;
@@ -411,11 +403,11 @@ sub rewindData {
# 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 );
+ 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;
@@ -12,14 +12,16 @@ use File::Temp ();
use FileHandle ();
use vars qw( $VERSION @ISA );
+
BEGIN {
- $VERSION = '1.38';
+ $VERSION = '1.39';
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
@@ -31,114 +33,126 @@ BEGIN {
# 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
- ) ],
+ 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
- CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
- DATA_DESCRIPTOR_FORMAT
- DATA_DESCRIPTOR_LENGTH
- DATA_DESCRIPTOR_SIGNATURE
- DATA_DESCRIPTOR_FORMAT_NO_SIG
- DATA_DESCRIPTOR_LENGTH_NO_SIG
- CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
- CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
- END_OF_CENTRAL_DIRECTORY_SIGNATURE
- END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING
- END_OF_CENTRAL_DIRECTORY_FORMAT
- END_OF_CENTRAL_DIRECTORY_LENGTH
- ) ],
+ PKZIP_CONSTANTS => [
+ qw(
+ SIGNATURE_FORMAT
+ SIGNATURE_LENGTH
+ LOCAL_FILE_HEADER_SIGNATURE
+ LOCAL_FILE_HEADER_FORMAT
+ LOCAL_FILE_HEADER_LENGTH
+ CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE
+ DATA_DESCRIPTOR_FORMAT
+ DATA_DESCRIPTOR_LENGTH
+ DATA_DESCRIPTOR_SIGNATURE
+ DATA_DESCRIPTOR_FORMAT_NO_SIG
+ DATA_DESCRIPTOR_LENGTH_NO_SIG
+ CENTRAL_DIRECTORY_FILE_HEADER_FORMAT
+ CENTRAL_DIRECTORY_FILE_HEADER_LENGTH
+ END_OF_CENTRAL_DIRECTORY_SIGNATURE
+ END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING
+ END_OF_CENTRAL_DIRECTORY_FORMAT
+ END_OF_CENTRAL_DIRECTORY_LENGTH
+ )
+ ],
# For Internal Use Only
- UTILITY_METHODS => [ qw(
- _error
- _printError
- _ioError
- _formatError
- _subclassResponsibility
- _binmode
- _isSeekable
- _newFileHandle
- _readSignature
- _asZipDirName
- ) ],
+ 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
- ) );
+ Exporter::export_ok_tags(
+ qw(
+ CONSTANTS
+ ERROR_CODES
+ PKZIP_CONSTANTS
+ UTILITY_METHODS
+ MISC_CONSTANTS
+ ));
}
@@ -190,11 +204,11 @@ 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_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
@@ -205,32 +219,32 @@ 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;
+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;
+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;
+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;
+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;
-use constant END_OF_CENTRAL_DIRECTORY_SIGNATURE => 0x06054b50;
+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;
+ 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;
@@ -256,55 +270,48 @@ require Archive::Zip::ZipFileMember;
require Archive::Zip::NewFileMember;
require Archive::Zip::StringMember;
-use constant ZIPARCHIVECLASS => 'Archive::Zip::Archive';
-use constant ZIPMEMBERCLASS => 'Archive::Zip::Member';
-
# Convenience functions
sub _ISA ($$) {
+
# Can't rely on Scalar::Util, so use the next best way
local $@;
- !! eval { ref $_[0] and $_[0]->isa($_[1]) };
+ !!eval { ref $_[0] and $_[0]->isa($_[1]) };
}
sub _CAN ($$) {
local $@;
- !! eval { ref $_[0] and $_[0]->can($_[1]) };
+ !!eval { ref $_[0] and $_[0]->can($_[1]) };
}
-
-
-
-
#####################################################################
# Methods
sub new {
my $class = shift;
- return $class->ZIPARCHIVECLASS->new(@_);
+ return Archive::Zip::Archive->new(@_);
}
sub computeCRC32 {
- my ( $data, $crc );
+ my ($data, $crc);
- if ( ref( $_[0] ) eq 'HASH' ) {
+ if (ref($_[0]) eq 'HASH') {
$data = $_[0]->{string};
$crc = $_[0]->{checksum};
- }
- else {
+ } else {
$data = shift;
$data = shift if ref($data);
$crc = shift;
}
- return Compress::Raw::Zlib::crc32( $data, $crc );
+ 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;
+ 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;
@@ -315,46 +322,42 @@ sub chunkSize {
}
sub setErrorHandler {
- my $errorHandler = ( ref( $_[0] ) eq 'HASH' ) ? shift->{subroutine} : shift;
+ 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 $string = join(' ', @_, "\n");
my $oldCarpLevel = $Carp::CarpLevel;
$Carp::CarpLevel += 2;
- &{$ErrorHandler} ($string);
+ &{$ErrorHandler}($string);
$Carp::CarpLevel = $oldCarpLevel;
}
# This is called on format errors.
sub _formatError {
- shift if ref( $_[0] );
- _printError( 'format error:', @_ );
+ 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:', @_, ':', $! );
+ 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:', @_ );
+ shift if ref($_[0]);
+ _printError('error:', @_);
return AZ_ERROR;
}
@@ -367,7 +370,7 @@ sub _subclassResponsibility {
# 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);
+ return _CAN($fh, 'binmode') ? $fh->binmode() : binmode($fh);
}
# Attempt to guess whether file handle is seekable.
@@ -376,28 +379,29 @@ sub _binmode {
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")) {
+ _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;
+ _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;
+ _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
-{
+sub _print {
my ($self, $fh, @data) = @_;
local $\;
@@ -415,21 +419,21 @@ sub _newFileHandle {
my $status = 1;
my $handle;
- if ( ref($fd) ) {
- if ( _ISA($fd, 'IO::Scalar') or _ISA($fd, 'IO::String') ) {
+ 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' ) {
+ } elsif (_ISA($fd, 'IO::Handle') or ref($fd) eq 'GLOB') {
$handle = IO::File->new;
- $status = $handle->fdopen( $fd, @_ );
+ $status = $handle->fdopen($fd, @_);
} else {
$handle = $fd;
}
} else {
$handle = IO::File->new;
- $status = $handle->open( $fd, @_ );
+ $status = $handle->open($fd, @_);
}
- return ( $status, $handle );
+ return ($status, $handle);
}
# Returns next signature from given file handle, leaves
@@ -443,32 +447,31 @@ sub _readSignature {
my $expectedSignature = shift; # optional
my $signatureData;
- my $bytesRead = $fh->read( $signatureData, SIGNATURE_LENGTH );
- if ( $bytesRead != SIGNATURE_LENGTH ) {
+ 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;
+ 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)
+ 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 ) )
- {
- my $errmsg = sprintf( "bad signature: 0x%08x", $signature );
- if ( _isSeekable($fh) )
- {
- $errmsg .=
- sprintf( " at offset %d", $fh->tell() - SIGNATURE_LENGTH );
+ && $signature != DATA_DESCRIPTOR_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 );
+ return ($status, $signature);
}
# Utility method to make and open a temp file.
@@ -480,15 +483,14 @@ sub _readSignature {
#
sub tempFile {
- my $dir = ( ref( $_[0] ) eq 'HASH' ) ? shift->{tempDir} : shift;
- my ( $fh, $filename ) = File::Temp::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 );
+ $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
@@ -509,17 +511,17 @@ sub tempFile {
# /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
-{
+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 ($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 : '' );
+ 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;
@@ -530,7 +532,7 @@ sub _asZipDirName
# 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
+ $normalised_path =~ s{^/}{}; # remove leading separator
return $normalised_path;
}
@@ -539,19 +541,18 @@ sub _asZipDirName
# Assume a directory if zip name has trailing slash.
# Takes an optional volume name in FS format (like 'a:').
#
-sub _asLocalName
-{
+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);
+ 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() );
+ my $localName = File::Spec->catpath($volume, $localDirs, $filename);
+ unless ($volume) {
+ $localName = File::Spec->rel2abs($localName, Cwd::getcwd());
}
return $localName;
}
@@ -1,11 +1,12 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Test::More tests => 2;
-use_ok( 'Archive::Zip' );
-use_ok( 'Archive::Zip::MemberRead' );
+use_ok('Archive::Zip');
+use_ok('Archive::Zip::MemberRead');
@@ -3,9 +3,10 @@
# Main testing for Archive::Zip
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
@@ -15,49 +16,36 @@ use File::Spec;
use Test::More tests => 141;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
-
-
-
-
+use t::common;
#####################################################################
# Testing Utility Functions
#--------- check CRC
-is( TESTSTRINGCRC, 0xac373f32, 'Testing CRC matches expected' );
+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' );
+ 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' );
+ 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
@@ -65,37 +53,40 @@ foreach my $unix_time (
# new # Archive::Zip
# new # Archive::Zip::Archive
my $zip = Archive::Zip->new();
-isa_ok( $zip, 'Archive::Zip' );
+isa_ok($zip, 'Archive::Zip');
# members # Archive::Zip::Archive
my @members = $zip->members;
-is(scalar(@members), 0, '->members is 0' );
+is(scalar(@members), 0, '->members is 0');
# numberOfMembers # Archive::Zip::Archive
my $numberOfMembers = $zip->numberOfMembers();
-is($numberOfMembers, 0, '->numberofMembers is 0' );
+is($numberOfMembers, 0, '->numberofMembers is 0');
# writeToFileNamed # Archive::Zip::Archive
-my $status = $zip->writeToFileNamed( OUTPUTZIP );
-is($status, AZ_OK, '->writeToFileNames ok' );
+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;
- ok( $status != 0 );
+ 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;
+ ok($status != 0);
}
+
# unzip -t returns error code=1 for warning on empty
#--------- add a directory
my $memberName = TESTDIR . '/';
-my $dirName = TESTDIR;
+my $dirName = TESTDIR;
# addDirectory # Archive::Zip::Archive
# new # Archive::Zip::Member
@@ -110,41 +101,43 @@ my $dir_time = $member->lastModFileDateTime();
# members # Archive::Zip::Archive
@members = $zip->members();
is(scalar(@members), 1);
-is($members[0], $member);
+is($members[0], $member);
# numberOfMembers # Archive::Zip::Archive
$numberOfMembers = $zip->numberOfMembers();
is($numberOfMembers, 1);
# writeToFileNamed # Archive::Zip::Archive
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$status = $zip->writeToFileNamed(OUTPUTZIP);
is($status, AZ_OK);
# Does the modification time get corrupted?
-is( ($zip->members)[0]->lastModFileDateTime(), $dir_time );
+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 );
+ 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);
+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
+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);
@@ -155,22 +148,23 @@ is($member->fileName(), $memberName);
# members # Archive::Zip::Archive
@members = $zip->members();
is(scalar(@members), 2);
-is($members[1], $member);
+is($members[1], $member);
# numberOfMembers # Archive::Zip::Archive
$numberOfMembers = $zip->numberOfMembers();
is($numberOfMembers, 2);
# writeToFileNamed # Archive::Zip::Archive
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
+ 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);
@@ -184,22 +178,23 @@ ok(-f $memberName);
is(fileCRC($memberName), TESTSTRINGCRC);
#--------- now compress it and re-test
-my $oldCompressionMethod =
- $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
+my $oldCompressionMethod =
+ $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
is($oldCompressionMethod, COMPRESSION_STORED, 'old compression method OK');
# writeToFileNamed # Archive::Zip::Archive
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$status = $zip->writeToFileNamed(OUTPUTZIP);
is($status, AZ_OK, 'writeToFileNamed returns AZ_OK');
-is($member->crc32(), TESTSTRINGCRC);
+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 );
+ 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
@@ -220,17 +215,18 @@ ok(defined($member));
is($member->desiredCompressionMethod(), COMPRESSION_DEFLATED);
# writeToFileNamed # Archive::Zip::Archive
-$status = $zip->writeToFileNamed( OUTPUTZIP );
-is($status, AZ_OK);
-is($member->crc32(), TESTSTRINGCRC);
+$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 );
+ 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
@@ -243,23 +239,23 @@ ok(-f $newName);
is(fileCRC($newName), TESTSTRINGCRC);
#--------- now make it uncompressed and re-test
-$oldCompressionMethod =
- $member->desiredCompressionMethod(COMPRESSION_STORED);
+$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);
+$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 );
+ 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
@@ -280,12 +276,12 @@ is(fileCRC($newName), TESTSTRINGCRC);
# members # Archive::Zip::Archive
@members = $zip->members();
is(scalar(@members), 3);
-is($members[2], $member);
+is($members[2], $member);
# memberNames # Archive::Zip::Archive
my @memberNames = $zip->memberNames();
is(scalar(@memberNames), 3);
-is($memberNames[2], $memberName);
+is($memberNames[2], $memberName);
# memberNamed # Archive::Zip::Archive
is($zip->memberNamed($memberName), $member);
@@ -293,26 +289,27 @@ is($zip->memberNamed($memberName), $member);
# membersMatching # Archive::Zip::Archive
@members = $zip->membersMatching('file');
is(scalar(@members), 1);
-is($members[0], $member);
+is($members[0], $member);
@members = $zip->membersMatching('.txt$');
is(scalar(@members), 2);
-is($members[1], $member);
+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 );
+$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 );
+ 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
@@ -321,33 +318,34 @@ $zip->addMember($member);
@members = $zip->members();
is(scalar(@members), 3);
-is($members[2], $member);
+is($members[2], $member);
# memberNames # Archive::Zip::Archive
@memberNames = $zip->memberNames();
is(scalar(@memberNames), 3);
-is($memberNames[1], $memberName);
+is($memberNames[1], $memberName);
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
+ 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($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($member, $members[2]);
is($zip->numberOfMembers(), 2);
#--------- re-add the string member
@@ -355,15 +353,16 @@ $zip->addMember($member);
is($zip->numberOfMembers(), 3);
@members = $zip->members();
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
+ 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
@@ -388,7 +387,7 @@ $member->desiredCompressionMethod(COMPRESSION_STORED);
#-------- ------- --- -------
# 1200 892 26% 5 files
-@members = $zip->members();
+@members = $zip->members();
$numberOfMembers = $zip->numberOfMembers();
is($numberOfMembers, 5);
@@ -409,48 +408,49 @@ is($members[3]->contents(), TESTSTRING);
is($members[4]->contents(), TESTSTRING);
#--------- write to INPUTZIP
-$status = $zip->writeToFileNamed( 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 );
+ 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($status, AZ_OK);
is($zip->numberOfMembers(), 10);
#--------- clean up duplicate names
@members = $zip->members();
-$member = $zip->removeMember($members[5]);
+$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);
- }
+ 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 );
+$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 );
+ 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!)
@@ -458,10 +458,10 @@ 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[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[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);
@@ -470,100 +470,102 @@ is($zip->extractMember($members[8]), AZ_OK);
#--------- count dirs
{
- my @dirs = grep { $_->isDirectory() } @members;
- is(scalar(@dirs), 1);
- is($dirs[0], $members[0]);
+ 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);
+ 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);
- }
+ 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" );
+$members[2]->contents("This is my new contents\n");
#--------- write zip out and test it.
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
+ 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" );
+$members[1]->contents("This is my new contents\n");
#--------- write zip out and test it.
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
+ 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" );
+$members[7]->contents("This is my new contents\n");
#--------- write zip out and test it.
-$status = $zip->writeToFileNamed( OUTPUTZIP );
+$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 );
-}
+ 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 ---------------------
+#--------------------- STILL UNTESTED IN THIS SCRIPT ---------------------
# sub setChunkSize # Archive::Zip
# sub _formatError # Archive::Zip
@@ -1,62 +1,58 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Spec;
use IO::File;
use Test::More tests => 17;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
+use t::common;
-sub runPerlCommand
-{
- my $libs = join ( ' -I', @INC );
- my $cmd = "\"$^X\" \"-I$libs\" -w \"". join('" "', @_). '"';
- my $output = `$cmd`;
- return wantarray ? ( $?, $output ) : $?;
+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
+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 );
+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' );
+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/copy.pl', INPUTZIP, OUTPUTZIP), 0);
-is( runPerlCommand( 'examples/extract.pl', OUTPUTZIP, ZFILENAME ), 0 );
+is(runPerlCommand('examples/extract.pl', OUTPUTZIP, ZFILENAME), 0);
-is( runPerlCommand( 'examples/mfh.pl', INPUTZIP ), 0 );
+is(runPerlCommand('examples/mfh.pl', INPUTZIP), 0);
-is( runPerlCommand( 'examples/zip.pl', OUTPUTZIP, INPUTZIP, FILENAME ), 0 );
+is(runPerlCommand('examples/zip.pl', OUTPUTZIP, INPUTZIP, FILENAME), 0);
-( $status, $output ) = runPerlCommand( 'examples/zipinfo.pl', INPUTZIP );
-is( $status, 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 );
+($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" );
+($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
@@ -65,13 +61,12 @@ is( $output, ZFILENAME . ":100\n" );
# ok( runPerlCommand('examples/readScalar.pl'), 0 );
unlink(OUTPUTZIP);
-is( runPerlCommand( 'examples/selfex.pl', OUTPUTZIP, FILENAME ), 0 );
+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" );
+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
@@ -80,8 +75,10 @@ is( -f $fn, 1, "$fn exists" );
# 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" );
+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);
@@ -1,59 +1,56 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Archive::Zip::MemberRead;
use Test::More tests => 10;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
+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 = 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 );
+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]);
+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 );
+ 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' );
+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] );
+ok($ret == length($data[0]));
+ok($buffer eq $data[0]);
$fh->close();
#
-# Different usages
+# Different usages
#
$fh = new Archive::Zip::MemberRead($zip, 'string.txt');
ok($fh);
@@ -3,45 +3,42 @@
use strict;
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use FileHandle;
use File::Spec;
-use Test::More tests =>6;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
+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 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";
+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' );
+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');
@@ -3,9 +3,10 @@
# Test Archive::Zip updating
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use File::Spec ();
use IO::File ();
@@ -13,52 +14,60 @@ use File::Find ();
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Test::More tests => 12;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
+use t::common;
my ($testFileVolume, $testFileDirs, $testFileName) = File::Spec->splitpath($0);
my $zip = Archive::Zip->new();
-my $testDir = File::Spec->catpath( $testFileVolume, $testFileDirs, '' );
+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');
+
+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' );
+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 $firstFile = $memberNames[0];
my $firstMember = ($zip->members())[0];
-is( $firstFile, $firstMember->fileName(), 'member name wrong');
+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');
+$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");
+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' );
+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");
+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' );
+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' );
+is($zip->updateTree($testDir, undef, undef, 1), AZ_OK, 'updateTree failed');
+is(scalar($zip->members()),
+ $numberOfMembers, 'wrong number of members after mirror');
@@ -18,41 +18,37 @@ use Archive::Zip;
use File::Path;
use File::Spec;
-BEGIN {
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
-}
+use t::common;
-mkpath( [ File::Spec->catdir( 'testdir', 'folder' ) ] );
+mkpath([File::Spec->catdir(TESTDIR, 'folder')]);
-my $zero_file = File::Spec->catfile( 'testdir', 'folder', "0" );
-open( O, ">$zero_file" );
+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" );
+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', );
+$archive->addTree(File::Spec->catfile(TESTDIR, 'folder'), 'folder',);
# TEST
ok(
- scalar( grep { $_ eq "folder/0" } $archive->memberNames() ),
+ scalar(grep { $_ eq "folder/0" } $archive->memberNames()),
"Checking that a file called '0' was added properly"
);
-rmtree( [ File::Spec->catdir( 'testdir', 'folder' ) ] );
+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 );
+ my $string_member = $archive->addString(TESTSTRING => 0);
$archive->writeToFileNamed(OUTPUTZIP);
}
@@ -60,9 +56,8 @@ rmtree( [ File::Spec->catdir( 'testdir', 'folder' ) ] );
# 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"
- );
+ 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);
@@ -1,34 +1,32 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 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 );
- }
-
- unshift @INC, "t/";
- require( File::Spec->catfile('t', 'common.pl') )
- or die "Can't load t/common.pl";
+ 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;
+ 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"
- );
+ isa_ok($zip, "Archive::Zip", "Testing that \$zip is an Archive::Zip");
my $data = <<"EOF";
One Line
@@ -50,58 +48,69 @@ EOF
{
# Testing for normal line-based reading.
my $member = $zip->memberNamed("string.txt");
- my $fh = $member->readFileHandle();
+ my $fh = $member->readFileHandle();
# TEST
- ok ($fh, "Filehandle is valid");
+ ok($fh, "Filehandle is valid");
+
# TEST
- is ($fh->getline(), "One Line",
- "Testing the first line in a normal read."
- );
+ 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."
- );
+ 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();
+ my $fh = $member->readFileHandle();
# TEST
- ok ($fh, "Filehandle is valid");
+ ok($fh, "Filehandle is valid");
+
# TEST
- is ($fh->getline(), "One Line\nTwo Lines\n",
+ 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",
+ 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();
+ my $fh = $member->readFileHandle();
# TEST
- ok ($fh, "Filehandle is valid");
-
+ ok($fh, "Filehandle is valid");
+
$fh->input_record_separator("</tag>\n");
# TEST
- is ($fh->getline(), "One Line\nTwo Lines\n",
+ 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",
+ is(
+ $fh->getline(),
+ "Three Lines\nFour Lines\nFive Lines\n",
"Testing the second line when input_record_separator is set."
);
}
@@ -112,19 +121,19 @@ EOF
local $/ = "</t";
my $member = $zip->memberNamed("string.txt");
- my $fh = $member->readFileHandle();
+ my $fh = $member->readFileHandle();
# TEST
- ok ($fh, "Filehandle is valid");
+ ok($fh, "Filehandle is valid");
$fh->input_record_separator(" ");
+
# TEST
- is ($fh->getline(), "One",
- "Testing the first \"line\" in a both set read"
- );
+ 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."
- );
+ is($fh->getline(), "Line\nTwo",
+ "Testing the second \"line\" in a both set read.");
}
}
@@ -1,45 +1,46 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Test::More tests => 6;
use File::Spec ();
use File::Spec::Unix ();
-use Archive::Zip qw( :ERROR_CODES );
+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 $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 $got_fn = "got.jpg";
my $archive_fn = "out.zip";
-my ( $before, $after );
+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;
+ 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;
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
my $verdict = ($got eq $expected);
- ok ($verdict, $msg);
+ ok($verdict, $msg);
if (!$verdict) {
my $len;
if (length($got) > length($expected)) {
@@ -52,17 +53,15 @@ sub binary_is {
$len = length($got);
}
- BYTE_LOOP:
- for my $byte_idx (0 .. ($len-1)) {
- my $got_byte = substr($got, $byte_idx, 1);
+ 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)
- )
- );
+ $byte_idx, ord($got_byte), ord($expected_byte)));
last BYTE_LOOP;
}
}
@@ -70,7 +69,7 @@ sub binary_is {
}
sub run_tests {
- my $id = shift;
+ my $id = shift;
my $msg_it = sub {
my $msg_raw = shift;
return "$id - $msg_raw";
@@ -80,43 +79,42 @@ sub run_tests {
$before = slurp_file($expected_fn);
# Zip the file.
- SCOPE: {
+ SCOPE: {
my $zip = Archive::Zip->new();
- $zip->addFile( $expected_fn );
- $zip->extractMember( $expected_zip, $got_fn );
+ $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,
+ # TEST:$n=$n+1
+ binary_is($after, $before,
$msg_it->("Content of file after extraction"),
);
- my $status = $zip->writeToFileNamed( $archive_fn );
+ my $status = $zip->writeToFileNamed($archive_fn);
+
# TEST:$n=$n+1
- cmp_ok( $status, '==', AZ_OK, $msg_it->('Zip was written fine') );
+ cmp_ok($status, '==', AZ_OK, $msg_it->('Zip was written fine'));
}
# Read back the file from the archive.
- SCOPE: {
+ SCOPE: {
my $zip2;
- $zip2 = Archive::Zip->new( $archive_fn );
+ $zip2 = Archive::Zip->new($archive_fn);
- $zip2->extractMember( $expected_zip, $got_fn );
+ $zip2->extractMember($expected_zip, $got_fn);
- $after = slurp_file( $got_fn );
+ $after = slurp_file($got_fn);
unlink $got_fn;
unlink $archive_fn;
# TEST:$n=$n+1
- binary_is(
- $after, $before,
+ binary_is($after, $before,
$msg_it->('Read back the file from the archive'),
);
- }
+ }
}
# Run the tests once with $\ undef.
@@ -1,27 +1,26 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Test::More;
use File::Spec;
use File::Path;
use Archive::Zip;
-sub get_perm
-{
+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->catdir(
- File::Spec->curdir(), "testdir", "chtest"
- );
+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");
@@ -34,7 +33,7 @@ sub test_if_chmod_is_working
my $test_perm = sub {
my $perm = shift;
- chmod ($perm, $test_file);
+ chmod($perm, $test_file);
return (get_perm($test_file) == $perm);
};
@@ -47,12 +46,9 @@ sub test_if_chmod_is_working
return $verdict;
}
-if (!test_if_chmod_is_working())
-{
+if (!test_if_chmod_is_working()) {
plan skip_all => "chmod() is not working on this machine.";
-}
-else
-{
+} else {
plan tests => 1;
}
@@ -60,10 +56,7 @@ 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"
- );
+my $test_dir = File::Spec->catdir(File::Spec->curdir(), "testdir", "chtest");
mkdir($test_dir, 0777);
@@ -72,10 +65,7 @@ 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."
-);
+is(get_perm($test_file), 0444, "File permission is OK.");
# Clean up.
rmtree($test_dir);
@@ -3,20 +3,21 @@
# Check Windows Explorer compatible directories
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 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' );
+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',
+ $member->externalFileAttributes & 16,
+ 'Directory has directory bit set as expected by Windows Explorer',
);
@@ -3,9 +3,10 @@
# Check Windows Explorer compatible directories
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 1;
+ $^W = 1;
}
use Test::More;
@@ -14,15 +15,16 @@ use File::Temp;
use File::Spec;
if ($^O eq 'MSWin32') {
- plan( tests => 1 );
+ plan(tests => 1);
} else {
- plan( skip_all => 'Only required on Win32.' );
+ plan(skip_all => 'Only required on Win32.');
}
-my $dist = Win32::GetShortPathName(File::Spec->rel2abs(File::Spec->catfile(qw(t data winzip.zip))));
+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 $tmpdir = File::Temp::mkdtemp($tmpdirname)
+ or die "Could not create temporary directory from template '$tmpdirname': $!";
my $path = $tmpdir;
$path = File::Spec->catdir($tmpdir, 'test');
@@ -1,16 +1,17 @@
#!/usr/bin/perl
use strict;
+
BEGIN {
- $| = 1;
- $^W = 1;
+ $| = 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' );
+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' );
\ No newline at end of file
+is($zip->extractTree(undef, 'extracted/xTree'), AZ_OK, 'Extracted archive');
+ok(-d 'extracted/xTree/foo', 'Checked directory');
@@ -20,32 +20,29 @@ use Archive::Zip;
use Cwd ();
use File::Spec ();
-my $file_relative_path = File::Spec->catfile( 'testdir', 'file.txt' );
-my $file_absolute_path = File::Spec->catfile(
- Cwd::getcwd(),
- $file_relative_path
-);
+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' ) {
+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
+ 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 $expected_member_name = $file_absolute_path) =~ s{^/}{};
my ($member_name) = $az->memberNames();
-is( $member_name, $expected_member_name, 'no leading separator' );
+is($member_name, $expected_member_name, 'no leading separator');
@@ -9,22 +9,26 @@ 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");
- }
+ 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;
@@ -8,16 +8,16 @@ 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");
+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");
+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");
+is($m->password("test"), "test", "correct password");
+is($m->contents, "encryption test\n" x 100, "Decoded buffer");
done_testing;
@@ -1,203 +0,0 @@
-# Shared defs for test programs
-
-# Paths. Must make case-insensitive.
-use constant TESTDIR => 'testdir';
-use constant INPUTZIP => 'testin.zip';
-use constant OUTPUTZIP => 'testout.zip';
-
-# 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);
-
-# 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);
-local ( $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' );
- $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 = 0;
- if ( HAVEUNZIP ) {
- my ( $status, $zipout ) = 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" );
- }
- }
-}
-
-1;
@@ -0,0 +1,226 @@
+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 =>
+ File::Spec->abs2rel(tempdir(DIR => 'testdir', CLEANUP => 1));
+use constant INPUTZIP =>
+ (tempfile('testin-XXXXX', SUFFIX => '.zip', TMPDIR => 1, UNLINK => 1))[1];
+use constant OUTPUTZIP =>
+ (tempfile('testout-XXXXX', SUFFIX => '.zip', TMPDIR => 1, 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);
+local ($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 = 0;
+ if (HAVEUNZIP) {
+ my ($status, $zipout) = 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");
+ }
+ }
+}
+
+1;