|
Packit |
0bf95d |
package Archive::Zip::Archive;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Represents a generic ZIP archive
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
use strict;
|
|
Packit |
0bf95d |
use File::Path;
|
|
Packit |
0bf95d |
use File::Find ();
|
|
Packit |
0bf95d |
use File::Spec ();
|
|
Packit |
0bf95d |
use File::Copy ();
|
|
Packit |
0bf95d |
use File::Basename;
|
|
Packit |
0bf95d |
use Cwd;
|
|
Packit |
0bf95d |
use Encode qw(encode_utf8 decode_utf8);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
use vars qw( $VERSION @ISA );
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
BEGIN {
|
|
Packit |
0bf95d |
$VERSION = '1.60';
|
|
Packit |
0bf95d |
@ISA = qw( Archive::Zip );
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
use Archive::Zip qw(
|
|
Packit |
0bf95d |
:CONSTANTS
|
|
Packit |
0bf95d |
:ERROR_CODES
|
|
Packit |
0bf95d |
:PKZIP_CONSTANTS
|
|
Packit |
0bf95d |
:UTILITY_METHODS
|
|
Packit |
0bf95d |
);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
our $UNICODE;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Note that this returns undef on read errors, else new zip object.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub new {
|
|
Packit |
0bf95d |
my $class = shift;
|
|
Packit |
0bf95d |
my $self = bless(
|
|
Packit |
0bf95d |
{
|
|
Packit |
0bf95d |
'diskNumber' => 0,
|
|
Packit |
0bf95d |
'diskNumberWithStartOfCentralDirectory' => 0,
|
|
Packit |
0bf95d |
'numberOfCentralDirectoriesOnThisDisk' =>
|
|
Packit |
0bf95d |
0, # should be # of members
|
|
Packit |
0bf95d |
'numberOfCentralDirectories' => 0, # should be # of members
|
|
Packit |
0bf95d |
'centralDirectorySize' => 0, # must re-compute on write
|
|
Packit |
0bf95d |
'centralDirectoryOffsetWRTStartingDiskNumber' =>
|
|
Packit |
0bf95d |
0, # must re-compute
|
|
Packit |
0bf95d |
'writeEOCDOffset' => 0,
|
|
Packit |
0bf95d |
'writeCentralDirectoryOffset' => 0,
|
|
Packit |
0bf95d |
'zipfileComment' => '',
|
|
Packit |
0bf95d |
'eocdOffset' => 0,
|
|
Packit |
0bf95d |
'fileName' => ''
|
|
Packit |
0bf95d |
},
|
|
Packit |
0bf95d |
$class
|
|
Packit |
0bf95d |
);
|
|
Packit |
0bf95d |
$self->{'members'} = [];
|
|
Packit |
0bf95d |
my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift;
|
|
Packit |
0bf95d |
if ($fileName) {
|
|
Packit |
0bf95d |
my $status = $self->read($fileName);
|
|
Packit |
0bf95d |
return $status == AZ_OK ? $self : undef;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return $self;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub storeSymbolicLink {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
$self->{'storeSymbolicLink'} = shift;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub members {
|
|
Packit |
0bf95d |
@{shift->{'members'}};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub numberOfMembers {
|
|
Packit |
0bf95d |
scalar(shift->members());
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub memberNames {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
return map { $_->fileName() } $self->members();
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# return ref to member with given name or undef
|
|
Packit |
0bf95d |
sub memberNamed {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $fileName = (ref($_[0]) eq 'HASH') ? shift->{zipName} : shift;
|
|
Packit |
0bf95d |
foreach my $member ($self->members()) {
|
|
Packit |
0bf95d |
return $member if $member->fileName() eq $fileName;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return undef;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub membersMatching {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $pattern = (ref($_[0]) eq 'HASH') ? shift->{regex} : shift;
|
|
Packit |
0bf95d |
return grep { $_->fileName() =~ /$pattern/ } $self->members();
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub diskNumber {
|
|
Packit |
0bf95d |
shift->{'diskNumber'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub diskNumberWithStartOfCentralDirectory {
|
|
Packit |
0bf95d |
shift->{'diskNumberWithStartOfCentralDirectory'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub numberOfCentralDirectoriesOnThisDisk {
|
|
Packit |
0bf95d |
shift->{'numberOfCentralDirectoriesOnThisDisk'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub numberOfCentralDirectories {
|
|
Packit |
0bf95d |
shift->{'numberOfCentralDirectories'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub centralDirectorySize {
|
|
Packit |
0bf95d |
shift->{'centralDirectorySize'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub centralDirectoryOffsetWRTStartingDiskNumber {
|
|
Packit |
0bf95d |
shift->{'centralDirectoryOffsetWRTStartingDiskNumber'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub zipfileComment {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $comment = $self->{'zipfileComment'};
|
|
Packit |
0bf95d |
if (@_) {
|
|
Packit |
0bf95d |
my $new_comment = (ref($_[0]) eq 'HASH') ? shift->{comment} : shift;
|
|
Packit |
0bf95d |
$self->{'zipfileComment'} = pack('C0a*', $new_comment); # avoid Unicode
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return $comment;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub eocdOffset {
|
|
Packit |
0bf95d |
shift->{'eocdOffset'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Return the name of the file last read.
|
|
Packit |
0bf95d |
sub fileName {
|
|
Packit |
0bf95d |
shift->{'fileName'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub removeMember {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $member = (ref($_[0]) eq 'HASH') ? shift->{memberOrZipName} : shift;
|
|
Packit |
0bf95d |
$member = $self->memberNamed($member) unless ref($member);
|
|
Packit |
0bf95d |
return undef unless $member;
|
|
Packit |
0bf95d |
my @newMembers = grep { $_ != $member } $self->members();
|
|
Packit |
0bf95d |
$self->{'members'} = \@newMembers;
|
|
Packit |
0bf95d |
return $member;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub replaceMember {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($oldMember, $newMember);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$oldMember = $_[0]->{memberOrZipName};
|
|
Packit |
0bf95d |
$newMember = $_[0]->{newMember};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($oldMember, $newMember) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$oldMember = $self->memberNamed($oldMember) unless ref($oldMember);
|
|
Packit |
0bf95d |
return undef unless $oldMember;
|
|
Packit |
0bf95d |
return undef unless $newMember;
|
|
Packit |
0bf95d |
my @newMembers =
|
|
Packit |
0bf95d |
map { ($_ == $oldMember) ? $newMember : $_ } $self->members();
|
|
Packit |
0bf95d |
$self->{'members'} = \@newMembers;
|
|
Packit |
0bf95d |
return $oldMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub extractMember {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($member, $name);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$member = $_[0]->{memberOrZipName};
|
|
Packit |
0bf95d |
$name = $_[0]->{name};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($member, $name) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$member = $self->memberNamed($member) unless ref($member);
|
|
Packit |
0bf95d |
return _error('member not found') unless $member;
|
|
Packit |
0bf95d |
my $originalSize = $member->compressedSize();
|
|
Packit |
0bf95d |
my ($volumeName, $dirName, $fileName);
|
|
Packit |
0bf95d |
if (defined($name)) {
|
|
Packit |
0bf95d |
($volumeName, $dirName, $fileName) = File::Spec->splitpath($name);
|
|
Packit |
0bf95d |
$dirName = File::Spec->catpath($volumeName, $dirName, '');
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$name = $member->fileName();
|
|
Packit |
0bf95d |
($dirName = $name) =~ s{[^/]*$}{};
|
|
Packit |
0bf95d |
$dirName = Archive::Zip::_asLocalName($dirName);
|
|
Packit |
0bf95d |
$name = Archive::Zip::_asLocalName($name);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
if ($dirName && !-d $dirName) {
|
|
Packit |
0bf95d |
mkpath($dirName);
|
|
Packit |
0bf95d |
return _ioError("can't create dir $dirName") if (!-d $dirName);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
my $rc = $member->extractToFileNamed($name, @_);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# TODO refactor this fix into extractToFileNamed()
|
|
Packit |
0bf95d |
$member->{'compressedSize'} = $originalSize;
|
|
Packit |
0bf95d |
return $rc;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub extractMemberWithoutPaths {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($member, $name);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$member = $_[0]->{memberOrZipName};
|
|
Packit |
0bf95d |
$name = $_[0]->{name};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($member, $name) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$member = $self->memberNamed($member) unless ref($member);
|
|
Packit |
0bf95d |
return _error('member not found') unless $member;
|
|
Packit |
0bf95d |
my $originalSize = $member->compressedSize();
|
|
Packit |
0bf95d |
return AZ_OK if $member->isDirectory();
|
|
Packit |
0bf95d |
unless ($name) {
|
|
Packit |
0bf95d |
$name = $member->fileName();
|
|
Packit |
0bf95d |
$name =~ s{.*/}{}; # strip off directories, if any
|
|
Packit |
0bf95d |
$name = Archive::Zip::_asLocalName($name);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
my $rc = $member->extractToFileNamed($name, @_);
|
|
Packit |
0bf95d |
$member->{'compressedSize'} = $originalSize;
|
|
Packit |
0bf95d |
return $rc;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addMember {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $newMember = (ref($_[0]) eq 'HASH') ? shift->{member} : shift;
|
|
Packit |
0bf95d |
push(@{$self->{'members'}}, $newMember) if $newMember;
|
|
Packit |
0bf95d |
if($newMember && ($newMember->{bitFlag} & 0x800)
|
|
Packit |
0bf95d |
&& !utf8::is_utf8($newMember->{fileName})){
|
|
Packit |
0bf95d |
$newMember->{fileName} = Encode::decode_utf8( $newMember->{fileName} );
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return $newMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addFile {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($fileName, $newName, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$fileName = $_[0]->{filename};
|
|
Packit |
0bf95d |
$newName = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($fileName, $newName, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
$fileName = Win32::GetANSIPathName($fileName);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $newMember = Archive::Zip::Member->newFromFile($fileName, $newName);
|
|
Packit |
0bf95d |
$newMember->desiredCompressionLevel($compressionLevel);
|
|
Packit |
0bf95d |
if ($self->{'storeSymbolicLink'} && -l $fileName) {
|
|
Packit |
0bf95d |
my $newMember =
|
|
Packit |
0bf95d |
Archive::Zip::Member->newFromString(readlink $fileName, $newName);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
|
|
Packit |
0bf95d |
$newMember->{'externalFileAttributes'} = 0xA1FF0000;
|
|
Packit |
0bf95d |
$self->addMember($newMember);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$self->addMember($newMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return $newMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addString {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($stringOrStringRef, $name, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$stringOrStringRef = $_[0]->{string};
|
|
Packit |
0bf95d |
$name = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($stringOrStringRef, $name, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $newMember =
|
|
Packit |
0bf95d |
Archive::Zip::Member->newFromString($stringOrStringRef, $name);
|
|
Packit |
0bf95d |
$newMember->desiredCompressionLevel($compressionLevel);
|
|
Packit |
0bf95d |
return $self->addMember($newMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addDirectory {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($name, $newName);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$name = $_[0]->{directoryName};
|
|
Packit |
0bf95d |
$newName = $_[0]->{zipName};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($name, $newName) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
$name = Win32::GetANSIPathName($name);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $newMember = Archive::Zip::Member->newDirectoryNamed($name, $newName);
|
|
Packit |
0bf95d |
if ($self->{'storeSymbolicLink'} && -l $name) {
|
|
Packit |
0bf95d |
my $link = readlink $name;
|
|
Packit |
0bf95d |
($newName =~ s{/$}{}) if $newName; # Strip trailing /
|
|
Packit |
0bf95d |
my $newMember = Archive::Zip::Member->newFromString($link, $newName);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP
|
|
Packit |
0bf95d |
$newMember->{'externalFileAttributes'} = 0xA1FF0000;
|
|
Packit |
0bf95d |
$self->addMember($newMember);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$self->addMember($newMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return $newMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# add either a file or a directory.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addFileOrDirectory {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($name, $newName, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$name = $_[0]->{name};
|
|
Packit |
0bf95d |
$newName = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($name, $newName, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
$name = Win32::GetANSIPathName($name);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$name =~ s{/$}{};
|
|
Packit |
0bf95d |
if ($newName) {
|
|
Packit |
0bf95d |
$newName =~ s{/$}{};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$newName = $name;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
if (-f $name) {
|
|
Packit |
0bf95d |
return $self->addFile($name, $newName, $compressionLevel);
|
|
Packit |
0bf95d |
} elsif (-d $name) {
|
|
Packit |
0bf95d |
return $self->addDirectory($name, $newName);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
return _error("$name is neither a file nor a directory");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub contents {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($member, $newContents);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$member = $_[0]->{memberOrZipName};
|
|
Packit |
0bf95d |
$newContents = $_[0]->{contents};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($member, $newContents) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error('No member name given') unless $member;
|
|
Packit |
0bf95d |
$member = $self->memberNamed($member) unless ref($member);
|
|
Packit |
0bf95d |
return undef unless $member;
|
|
Packit |
0bf95d |
return $member->contents($newContents);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub writeToFileNamed {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $fileName =
|
|
Packit |
0bf95d |
(ref($_[0]) eq 'HASH') ? shift->{filename} : shift; # local FS format
|
|
Packit |
0bf95d |
foreach my $member ($self->members()) {
|
|
Packit |
0bf95d |
if ($member->_usesFileNamed($fileName)) {
|
|
Packit |
0bf95d |
return _error("$fileName is needed by member "
|
|
Packit |
0bf95d |
. $member->fileName()
|
|
Packit |
0bf95d |
. "; consider using overwrite() or overwriteAs() instead.");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
my ($status, $fh) = _newFileHandle($fileName, 'w');
|
|
Packit |
0bf95d |
return _ioError("Can't open $fileName for write") unless $status;
|
|
Packit |
0bf95d |
my $retval = $self->writeToFileHandle($fh, 1);
|
|
Packit |
0bf95d |
$fh->close();
|
|
Packit |
0bf95d |
$fh = undef;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return $retval;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# It is possible to write data to the FH before calling this,
|
|
Packit |
0bf95d |
# perhaps to make a self-extracting archive.
|
|
Packit |
0bf95d |
sub writeToFileHandle {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($fh, $fhIsSeekable);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$fh = $_[0]->{fileHandle};
|
|
Packit |
0bf95d |
$fhIsSeekable =
|
|
Packit |
0bf95d |
exists($_[0]->{seek}) ? $_[0]->{seek} : _isSeekable($fh);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$fh = shift;
|
|
Packit |
0bf95d |
$fhIsSeekable = @_ ? shift : _isSeekable($fh);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error('No filehandle given') unless $fh;
|
|
Packit |
0bf95d |
return _ioError('filehandle not open') unless $fh->opened();
|
|
Packit |
0bf95d |
_binmode($fh);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Find out where the current position is.
|
|
Packit |
0bf95d |
my $offset = $fhIsSeekable ? $fh->tell() : 0;
|
|
Packit |
0bf95d |
$offset = 0 if $offset < 0;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
foreach my $member ($self->members()) {
|
|
Packit |
0bf95d |
my $retval = $member->_writeToFileHandle($fh, $fhIsSeekable, $offset);
|
|
Packit |
0bf95d |
$member->endRead();
|
|
Packit |
0bf95d |
return $retval if $retval != AZ_OK;
|
|
Packit |
0bf95d |
$offset += $member->_localHeaderSize() + $member->_writeOffset();
|
|
Packit |
0bf95d |
$offset +=
|
|
Packit |
0bf95d |
$member->hasDataDescriptor()
|
|
Packit |
0bf95d |
? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH
|
|
Packit |
0bf95d |
: 0;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# changed this so it reflects the last successful position
|
|
Packit |
0bf95d |
$self->{'writeCentralDirectoryOffset'} = $offset;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return $self->writeCentralDirectory($fh);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Write zip back to the original file,
|
|
Packit |
0bf95d |
# as safely as possible.
|
|
Packit |
0bf95d |
# Returns AZ_OK if successful.
|
|
Packit |
0bf95d |
sub overwrite {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
return $self->overwriteAs($self->{'fileName'});
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Write zip to the specified file,
|
|
Packit |
0bf95d |
# as safely as possible.
|
|
Packit |
0bf95d |
# Returns AZ_OK if successful.
|
|
Packit |
0bf95d |
sub overwriteAs {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $zipName = (ref($_[0]) eq 'HASH') ? $_[0]->{filename} : shift;
|
|
Packit |
0bf95d |
return _error("no filename in overwriteAs()") unless defined($zipName);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($fh, $tempName) = Archive::Zip::tempFile();
|
|
Packit |
0bf95d |
return _error("Can't open temp file", $!) unless $fh;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
(my $backupName = $zipName) =~ s{(\.[^.]*)?$}{.zbk};
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $status = $self->writeToFileHandle($fh);
|
|
Packit |
0bf95d |
$fh->close();
|
|
Packit |
0bf95d |
$fh = undef;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($status != AZ_OK) {
|
|
Packit |
0bf95d |
unlink($tempName);
|
|
Packit |
0bf95d |
_printError("Can't write to $tempName");
|
|
Packit |
0bf95d |
return $status;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $err;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# rename the zip
|
|
Packit |
0bf95d |
if (-f $zipName && !rename($zipName, $backupName)) {
|
|
Packit |
0bf95d |
$err = $!;
|
|
Packit |
0bf95d |
unlink($tempName);
|
|
Packit |
0bf95d |
return _error("Can't rename $zipName as $backupName", $err);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# move the temp to the original name (possibly copying)
|
|
Packit |
0bf95d |
unless (File::Copy::move($tempName, $zipName)
|
|
Packit |
0bf95d |
|| File::Copy::copy($tempName, $zipName)) {
|
|
Packit |
0bf95d |
$err = $!;
|
|
Packit |
0bf95d |
rename($backupName, $zipName);
|
|
Packit |
0bf95d |
unlink($tempName);
|
|
Packit |
0bf95d |
return _error("Can't move $tempName to $zipName", $err);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# unlink the backup
|
|
Packit |
0bf95d |
if (-f $backupName && !unlink($backupName)) {
|
|
Packit |
0bf95d |
$err = $!;
|
|
Packit |
0bf95d |
return _error("Can't unlink $backupName", $err);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Used only during writing
|
|
Packit |
0bf95d |
sub _writeCentralDirectoryOffset {
|
|
Packit |
0bf95d |
shift->{'writeCentralDirectoryOffset'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub _writeEOCDOffset {
|
|
Packit |
0bf95d |
shift->{'writeEOCDOffset'};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Expects to have _writeEOCDOffset() set
|
|
Packit |
0bf95d |
sub _writeEndOfCentralDirectory {
|
|
Packit |
0bf95d |
my ($self, $fh) = @_;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING)
|
|
Packit |
0bf95d |
or return _ioError('writing EOCD Signature');
|
|
Packit |
0bf95d |
my $zipfileCommentLength = length($self->zipfileComment());
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $header = pack(
|
|
Packit |
0bf95d |
END_OF_CENTRAL_DIRECTORY_FORMAT,
|
|
Packit |
0bf95d |
0, # {'diskNumber'},
|
|
Packit |
0bf95d |
0, # {'diskNumberWithStartOfCentralDirectory'},
|
|
Packit |
0bf95d |
$self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'},
|
|
Packit |
0bf95d |
$self->numberOfMembers(), # {'numberOfCentralDirectories'},
|
|
Packit |
0bf95d |
$self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(),
|
|
Packit |
0bf95d |
$self->_writeCentralDirectoryOffset(),
|
|
Packit |
0bf95d |
$zipfileCommentLength
|
|
Packit |
0bf95d |
);
|
|
Packit |
0bf95d |
$self->_print($fh, $header)
|
|
Packit |
0bf95d |
or return _ioError('writing EOCD header');
|
|
Packit |
0bf95d |
if ($zipfileCommentLength) {
|
|
Packit |
0bf95d |
$self->_print($fh, $self->zipfileComment())
|
|
Packit |
0bf95d |
or return _ioError('writing zipfile comment');
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# $offset can be specified to truncate a zip file.
|
|
Packit |
0bf95d |
sub writeCentralDirectory {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($fh, $offset);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$fh = $_[0]->{fileHandle};
|
|
Packit |
0bf95d |
$offset = $_[0]->{offset};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($fh, $offset) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if (defined($offset)) {
|
|
Packit |
0bf95d |
$self->{'writeCentralDirectoryOffset'} = $offset;
|
|
Packit |
0bf95d |
$fh->seek($offset, IO::Seekable::SEEK_SET)
|
|
Packit |
0bf95d |
or return _ioError('seeking to write central directory');
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$offset = $self->_writeCentralDirectoryOffset();
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
foreach my $member ($self->members()) {
|
|
Packit |
0bf95d |
my $status = $member->_writeCentralDirectoryFileHeader($fh);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
$offset += $member->_centralDirectoryHeaderSize();
|
|
Packit |
0bf95d |
$self->{'writeEOCDOffset'} = $offset;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return $self->_writeEndOfCentralDirectory($fh);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub read {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift;
|
|
Packit |
0bf95d |
return _error('No filename given') unless $fileName;
|
|
Packit |
0bf95d |
my ($status, $fh) = _newFileHandle($fileName, 'r');
|
|
Packit |
0bf95d |
return _ioError("opening $fileName for read") unless $status;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$status = $self->readFromFileHandle($fh, $fileName);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$fh->close();
|
|
Packit |
0bf95d |
$self->{'fileName'} = $fileName;
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub readFromFileHandle {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($fh, $fileName);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$fh = $_[0]->{fileHandle};
|
|
Packit |
0bf95d |
$fileName = $_[0]->{filename};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($fh, $fileName) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$fileName = $fh unless defined($fileName);
|
|
Packit |
0bf95d |
return _error('No filehandle given') unless $fh;
|
|
Packit |
0bf95d |
return _ioError('filehandle not open') unless $fh->opened();
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
_binmode($fh);
|
|
Packit |
0bf95d |
$self->{'fileName'} = "$fh";
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# TODO: how to support non-seekable zips?
|
|
Packit |
0bf95d |
return _error('file not seekable')
|
|
Packit |
0bf95d |
unless _isSeekable($fh);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$fh->seek(0, 0); # rewind the file
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $status = $self->_findEndOfCentralDirectory($fh);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $eocdPosition = $fh->tell();
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$status = $self->_readEndOfCentralDirectory($fh);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$fh->seek($eocdPosition - $self->centralDirectorySize(),
|
|
Packit |
0bf95d |
IO::Seekable::SEEK_SET)
|
|
Packit |
0bf95d |
or return _ioError("Can't seek $fileName");
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Try to detect garbage at beginning of archives
|
|
Packit |
0bf95d |
# This should be 0
|
|
Packit |
0bf95d |
$self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here
|
|
Packit |
0bf95d |
- $self->centralDirectoryOffsetWRTStartingDiskNumber();
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
for (; ;) {
|
|
Packit |
0bf95d |
my $newMember =
|
|
Packit |
0bf95d |
Archive::Zip::Member->_newFromZipFile($fh, $fileName,
|
|
Packit |
0bf95d |
$self->eocdOffset());
|
|
Packit |
0bf95d |
my $signature;
|
|
Packit |
0bf95d |
($status, $signature) = _readSignature($fh, $fileName);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE;
|
|
Packit |
0bf95d |
$status = $newMember->_readCentralDirectoryFileHeader();
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
$status = $newMember->endRead();
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
$newMember->_becomeDirectoryIfNecessary();
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if(($newMember->{bitFlag} & 0x800) && !utf8::is_utf8($newMember->{fileName})){
|
|
Packit |
0bf95d |
$newMember->{fileName} = Encode::decode_utf8($newMember->{fileName});
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
push(@{$self->{'members'}}, $newMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Read EOCD, starting from position before signature.
|
|
Packit |
0bf95d |
# Return AZ_OK on success.
|
|
Packit |
0bf95d |
sub _readEndOfCentralDirectory {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $fh = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Skip past signature
|
|
Packit |
0bf95d |
$fh->seek(SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR)
|
|
Packit |
0bf95d |
or return _ioError("Can't seek past EOCD signature");
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $header = '';
|
|
Packit |
0bf95d |
my $bytesRead = $fh->read($header, END_OF_CENTRAL_DIRECTORY_LENGTH);
|
|
Packit |
0bf95d |
if ($bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH) {
|
|
Packit |
0bf95d |
return _ioError("reading end of central directory");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $zipfileCommentLength;
|
|
Packit |
0bf95d |
(
|
|
Packit |
0bf95d |
$self->{'diskNumber'},
|
|
Packit |
0bf95d |
$self->{'diskNumberWithStartOfCentralDirectory'},
|
|
Packit |
0bf95d |
$self->{'numberOfCentralDirectoriesOnThisDisk'},
|
|
Packit |
0bf95d |
$self->{'numberOfCentralDirectories'},
|
|
Packit |
0bf95d |
$self->{'centralDirectorySize'},
|
|
Packit |
0bf95d |
$self->{'centralDirectoryOffsetWRTStartingDiskNumber'},
|
|
Packit |
0bf95d |
$zipfileCommentLength
|
|
Packit |
0bf95d |
) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($self->{'diskNumber'} == 0xFFFF ||
|
|
Packit |
0bf95d |
$self->{'diskNumberWithStartOfCentralDirectory'} == 0xFFFF ||
|
|
Packit |
0bf95d |
$self->{'numberOfCentralDirectoriesOnThisDisk'} == 0xFFFF ||
|
|
Packit |
0bf95d |
$self->{'numberOfCentralDirectories'} == 0xFFFF ||
|
|
Packit |
0bf95d |
$self->{'centralDirectorySize'} == 0xFFFFFFFF ||
|
|
Packit |
0bf95d |
$self->{'centralDirectoryOffsetWRTStartingDiskNumber'} == 0xFFFFFFFF) {
|
|
Packit |
0bf95d |
return _formatError("zip64 not supported" . Dumper($self));
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
use Data::Dumper;
|
|
Packit |
0bf95d |
if ($zipfileCommentLength) {
|
|
Packit |
0bf95d |
my $zipfileComment = '';
|
|
Packit |
0bf95d |
$bytesRead = $fh->read($zipfileComment, $zipfileCommentLength);
|
|
Packit |
0bf95d |
if ($bytesRead != $zipfileCommentLength) {
|
|
Packit |
0bf95d |
return _ioError("reading zipfile comment");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
$self->{'zipfileComment'} = $zipfileComment;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Seek in my file to the end, then read backwards until we find the
|
|
Packit |
0bf95d |
# signature of the central directory record. Leave the file positioned right
|
|
Packit |
0bf95d |
# before the signature. Returns AZ_OK if success.
|
|
Packit |
0bf95d |
sub _findEndOfCentralDirectory {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
my $fh = shift;
|
|
Packit |
0bf95d |
my $data = '';
|
|
Packit |
0bf95d |
$fh->seek(0, IO::Seekable::SEEK_END)
|
|
Packit |
0bf95d |
or return _ioError("seeking to end");
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $fileLength = $fh->tell();
|
|
Packit |
0bf95d |
if ($fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4) {
|
|
Packit |
0bf95d |
return _formatError("file is too short");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $seekOffset = 0;
|
|
Packit |
0bf95d |
my $pos = -1;
|
|
Packit |
0bf95d |
for (; ;) {
|
|
Packit |
0bf95d |
$seekOffset += 512;
|
|
Packit |
0bf95d |
$seekOffset = $fileLength if ($seekOffset > $fileLength);
|
|
Packit |
0bf95d |
$fh->seek(-$seekOffset, IO::Seekable::SEEK_END)
|
|
Packit |
0bf95d |
or return _ioError("seek failed");
|
|
Packit |
0bf95d |
my $bytesRead = $fh->read($data, $seekOffset);
|
|
Packit |
0bf95d |
if ($bytesRead != $seekOffset) {
|
|
Packit |
0bf95d |
return _ioError("read failed");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
$pos = rindex($data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING);
|
|
Packit |
0bf95d |
last
|
|
Packit |
0bf95d |
if ( $pos >= 0
|
|
Packit |
0bf95d |
or $seekOffset == $fileLength
|
|
Packit |
0bf95d |
or $seekOffset >= $Archive::Zip::ChunkSize);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($pos >= 0) {
|
|
Packit |
0bf95d |
$fh->seek($pos - $seekOffset, IO::Seekable::SEEK_CUR)
|
|
Packit |
0bf95d |
or return _ioError("seeking to EOCD");
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
return _formatError("can't find EOCD signature");
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Used to avoid taint problems when chdir'ing.
|
|
Packit |
0bf95d |
# Not intended to increase security in any way; just intended to shut up the -T
|
|
Packit |
0bf95d |
# complaints. If your Cwd module is giving you unreliable returns from cwd()
|
|
Packit |
0bf95d |
# you have bigger problems than this.
|
|
Packit |
0bf95d |
sub _untaintDir {
|
|
Packit |
0bf95d |
my $dir = shift;
|
|
Packit |
0bf95d |
$dir =~ m/\A(.+)\z/s;
|
|
Packit |
0bf95d |
return $1;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addTree {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($root, $dest, $pred, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$root = $_[0]->{root};
|
|
Packit |
0bf95d |
$dest = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$pred = $_[0]->{select};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($root, $dest, $pred, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error("root arg missing in call to addTree()")
|
|
Packit |
0bf95d |
unless defined($root);
|
|
Packit |
0bf95d |
$dest = '' unless defined($dest);
|
|
Packit |
0bf95d |
$pred = sub { -r }
|
|
Packit |
0bf95d |
unless defined($pred);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my @files;
|
|
Packit |
0bf95d |
my $startDir = _untaintDir(cwd());
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error('undef returned by _untaintDir on cwd ', cwd())
|
|
Packit |
0bf95d |
unless $startDir;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# This avoids chdir'ing in Find, in a way compatible with older
|
|
Packit |
0bf95d |
# versions of File::Find.
|
|
Packit |
0bf95d |
my $wanted = sub {
|
|
Packit |
0bf95d |
local $main::_ = $File::Find::name;
|
|
Packit |
0bf95d |
my $dir = _untaintDir($File::Find::dir);
|
|
Packit |
0bf95d |
chdir($startDir);
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
push(@files, Win32::GetANSIPathName($File::Find::name)) if (&$pred);
|
|
Packit |
0bf95d |
$dir = Win32::GetANSIPathName($dir);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
push(@files, $File::Find::name) if (&$pred);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
chdir($dir);
|
|
Packit |
0bf95d |
};
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
$root = Win32::GetANSIPathName($root);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
File::Find::find($wanted, $root);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $rootZipName = _asZipDirName($root, 1); # with trailing slash
|
|
Packit |
0bf95d |
my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$dest = _asZipDirName($dest, 1); # with trailing slash
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
foreach my $fileName (@files) {
|
|
Packit |
0bf95d |
my $isDir;
|
|
Packit |
0bf95d |
if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) {
|
|
Packit |
0bf95d |
$isDir = -d Win32::GetANSIPathName($fileName);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$isDir = -d $fileName;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# normalize, remove leading ./
|
|
Packit |
0bf95d |
my $archiveName = _asZipDirName($fileName, $isDir);
|
|
Packit |
0bf95d |
if ($archiveName eq $rootZipName) { $archiveName = $dest }
|
|
Packit |
0bf95d |
else { $archiveName =~ s{$pattern}{$dest} }
|
|
Packit |
0bf95d |
next if $archiveName =~ m{^\.?/?$}; # skip current dir
|
|
Packit |
0bf95d |
my $member =
|
|
Packit |
0bf95d |
$isDir
|
|
Packit |
0bf95d |
? $self->addDirectory($fileName, $archiveName)
|
|
Packit |
0bf95d |
: $self->addFile($fileName, $archiveName);
|
|
Packit |
0bf95d |
$member->desiredCompressionLevel($compressionLevel);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error("add $fileName failed in addTree()") if !$member;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub addTreeMatching {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($root, $dest, $pattern, $pred, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$root = $_[0]->{root};
|
|
Packit |
0bf95d |
$dest = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$pattern = $_[0]->{pattern};
|
|
Packit |
0bf95d |
$pred = $_[0]->{select};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($root, $dest, $pattern, $pred, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error("root arg missing in call to addTreeMatching()")
|
|
Packit |
0bf95d |
unless defined($root);
|
|
Packit |
0bf95d |
$dest = '' unless defined($dest);
|
|
Packit |
0bf95d |
return _error("pattern missing in call to addTreeMatching()")
|
|
Packit |
0bf95d |
unless defined($pattern);
|
|
Packit |
0bf95d |
my $matcher =
|
|
Packit |
0bf95d |
$pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r };
|
|
Packit |
0bf95d |
return $self->addTree($root, $dest, $matcher, $compressionLevel);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# $zip->extractTree( $root, $dest [, $volume] );
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
# $root and $dest are Unix-style.
|
|
Packit |
0bf95d |
# $volume is in local FS format.
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
sub extractTree {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($root, $dest, $volume);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$root = $_[0]->{root};
|
|
Packit |
0bf95d |
$dest = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$volume = $_[0]->{volume};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($root, $dest, $volume) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$root = '' unless defined($root);
|
|
Packit |
0bf95d |
if (defined $dest) {
|
|
Packit |
0bf95d |
if ($dest !~ m{/$}) {
|
|
Packit |
0bf95d |
$dest .= '/';
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$dest = './';
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $pattern = "^\Q$root";
|
|
Packit |
0bf95d |
my @members = $self->membersMatching($pattern);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
foreach my $member (@members) {
|
|
Packit |
0bf95d |
my $fileName = $member->fileName(); # in Unix format
|
|
Packit |
0bf95d |
$fileName =~ s{$pattern}{$dest}; # in Unix format
|
|
Packit |
0bf95d |
# convert to platform format:
|
|
Packit |
0bf95d |
$fileName = Archive::Zip::_asLocalName($fileName, $volume);
|
|
Packit |
0bf95d |
my $status = $member->extractToFileNamed($fileName);
|
|
Packit |
0bf95d |
return $status if $status != AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# $zip->updateMember( $memberOrName, $fileName );
|
|
Packit |
0bf95d |
# Returns (possibly updated) member, if any; undef on errors.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub updateMember {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($oldMember, $fileName);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$oldMember = $_[0]->{memberOrZipName};
|
|
Packit |
0bf95d |
$fileName = $_[0]->{name};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($oldMember, $fileName) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if (!defined($fileName)) {
|
|
Packit |
0bf95d |
_error("updateMember(): missing fileName argument");
|
|
Packit |
0bf95d |
return undef;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my @newStat = stat($fileName);
|
|
Packit |
0bf95d |
if (!@newStat) {
|
|
Packit |
0bf95d |
_ioError("Can't stat $fileName");
|
|
Packit |
0bf95d |
return undef;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $isDir = -d _;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my $memberName;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
if (ref($oldMember)) {
|
|
Packit |
0bf95d |
$memberName = $oldMember->fileName();
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$oldMember = $self->memberNamed($memberName = $oldMember)
|
|
Packit |
0bf95d |
|| $self->memberNamed($memberName =
|
|
Packit |
0bf95d |
_asZipDirName($oldMember, $isDir));
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
unless (defined($oldMember)
|
|
Packit |
0bf95d |
&& $oldMember->lastModTime() == $newStat[9]
|
|
Packit |
0bf95d |
&& $oldMember->isDirectory() == $isDir
|
|
Packit |
0bf95d |
&& ($isDir || ($oldMember->uncompressedSize() == $newStat[7]))) {
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# create the new member
|
|
Packit |
0bf95d |
my $newMember =
|
|
Packit |
0bf95d |
$isDir
|
|
Packit |
0bf95d |
? Archive::Zip::Member->newDirectoryNamed($fileName, $memberName)
|
|
Packit |
0bf95d |
: Archive::Zip::Member->newFromFile($fileName, $memberName);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
unless (defined($newMember)) {
|
|
Packit |
0bf95d |
_error("creation of member $fileName failed in updateMember()");
|
|
Packit |
0bf95d |
return undef;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# replace old member or append new one
|
|
Packit |
0bf95d |
if (defined($oldMember)) {
|
|
Packit |
0bf95d |
$self->replaceMember($oldMember, $newMember);
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
$self->addMember($newMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return $newMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return $oldMember;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] );
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
# This takes the same arguments as addTree, but first checks to see
|
|
Packit |
0bf95d |
# whether the file or directory already exists in the zip file.
|
|
Packit |
0bf95d |
#
|
|
Packit |
0bf95d |
# If the fourth argument $mirror is true, then delete all my members
|
|
Packit |
0bf95d |
# if corresponding files were not found.
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
sub updateTree {
|
|
Packit |
0bf95d |
my $self = shift;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my ($root, $dest, $pred, $mirror, $compressionLevel);
|
|
Packit |
0bf95d |
if (ref($_[0]) eq 'HASH') {
|
|
Packit |
0bf95d |
$root = $_[0]->{root};
|
|
Packit |
0bf95d |
$dest = $_[0]->{zipName};
|
|
Packit |
0bf95d |
$pred = $_[0]->{select};
|
|
Packit |
0bf95d |
$mirror = $_[0]->{mirror};
|
|
Packit |
0bf95d |
$compressionLevel = $_[0]->{compressionLevel};
|
|
Packit |
0bf95d |
} else {
|
|
Packit |
0bf95d |
($root, $dest, $pred, $mirror, $compressionLevel) = @_;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error("root arg missing in call to updateTree()")
|
|
Packit |
0bf95d |
unless defined($root);
|
|
Packit |
0bf95d |
$dest = '' unless defined($dest);
|
|
Packit |
0bf95d |
$pred = sub { -r }
|
|
Packit |
0bf95d |
unless defined($pred);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$dest = _asZipDirName($dest, 1);
|
|
Packit |
0bf95d |
my $rootZipName = _asZipDirName($root, 1); # with trailing slash
|
|
Packit |
0bf95d |
my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E";
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
my @files;
|
|
Packit |
0bf95d |
my $startDir = _untaintDir(cwd());
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return _error('undef returned by _untaintDir on cwd ', cwd())
|
|
Packit |
0bf95d |
unless $startDir;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# This avoids chdir'ing in Find, in a way compatible with older
|
|
Packit |
0bf95d |
# versions of File::Find.
|
|
Packit |
0bf95d |
my $wanted = sub {
|
|
Packit |
0bf95d |
local $main::_ = $File::Find::name;
|
|
Packit |
0bf95d |
my $dir = _untaintDir($File::Find::dir);
|
|
Packit |
0bf95d |
chdir($startDir);
|
|
Packit |
0bf95d |
push(@files, $File::Find::name) if (&$pred);
|
|
Packit |
0bf95d |
chdir($dir);
|
|
Packit |
0bf95d |
};
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
File::Find::find($wanted, $root);
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# Now @files has all the files that I could potentially be adding to
|
|
Packit |
0bf95d |
# the zip. Only add the ones that are necessary.
|
|
Packit |
0bf95d |
# For each file (updated or not), add its member name to @done.
|
|
Packit |
0bf95d |
my %done;
|
|
Packit |
0bf95d |
foreach my $fileName (@files) {
|
|
Packit |
0bf95d |
my @newStat = stat($fileName);
|
|
Packit |
0bf95d |
my $isDir = -d _;
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# normalize, remove leading ./
|
|
Packit |
0bf95d |
my $memberName = _asZipDirName($fileName, $isDir);
|
|
Packit |
0bf95d |
if ($memberName eq $rootZipName) { $memberName = $dest }
|
|
Packit |
0bf95d |
else { $memberName =~ s{$pattern}{$dest} }
|
|
Packit |
0bf95d |
next if $memberName =~ m{^\.?/?$}; # skip current dir
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
$done{$memberName} = 1;
|
|
Packit |
0bf95d |
my $changedMember = $self->updateMember($memberName, $fileName);
|
|
Packit |
0bf95d |
$changedMember->desiredCompressionLevel($compressionLevel);
|
|
Packit |
0bf95d |
return _error("updateTree failed to update $fileName")
|
|
Packit |
0bf95d |
unless ref($changedMember);
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
# @done now has the archive names corresponding to all the found files.
|
|
Packit |
0bf95d |
# If we're mirroring, delete all those members that aren't in @done.
|
|
Packit |
0bf95d |
if ($mirror) {
|
|
Packit |
0bf95d |
foreach my $member ($self->members()) {
|
|
Packit |
0bf95d |
$self->removeMember($member)
|
|
Packit |
0bf95d |
unless $done{$member->fileName()};
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
return AZ_OK;
|
|
Packit |
0bf95d |
}
|
|
Packit |
0bf95d |
|
|
Packit |
0bf95d |
1;
|