| Subject: | extractToFileNamed Fails for Symlink to Directory |
| Date: | Sat, 11 Jun 2016 00:15:04 -0700 |
| To: | bug-Archive-Zip [...] rt.cpan.org |
| From: | "David E. Wheeler" <dwheeler [...] cpan.org> |
Given the script below, if you download and run it on this file:
http://api.pgxn.org/dist/cat_tools/0.1.0/cat_tools-0.1.0.zip
You’ll see warnings like this:
binmode() on closed filehandle GEN69 at /Users/david/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/darwin-2level/IO/File.pm line 199.
print() on closed filehandle GEN69 at /Users/david/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/darwin-2level/IO/Handle.pm line 420.
IO error: write error during copy : Bad file descriptor
at /Users/david/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Archive/Zip/Member.pm line 1107.
Archive::Zip::Member::_writeData(Archive::Zip::ZipFileMember=HASH(0x7ffc6c9d3918), IO::File=GLOB(0x7ffc6c02c388)) called at /Users/david/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Archive/Zip/Member.pm line 1033
Archive::Zip::Member::extractToFileHandle(Archive::Zip::ZipFileMember=HASH(0x7ffc6c9d3918), IO::File=GLOB(0x7ffc6c02c388)) called at /Users/david/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/Archive/Zip/Member.pm line 498
Archive::Zip::Member::extractToFileNamed(Archive::Zip::ZipFileMember=HASH(0x7ffc6c9d3918), "/var/folders/zb/_t6g74x117qb5yq9tpqd259r0000gq/T/nbCmm9gICo/c"...) called at /Users/david/bin/try line 21
It appears to choke on the symlink `cat_tools-0.1.0/test/pgxntool`, which points to a directory within the zip file, `../pgxntool/test/pgxntool`. Maybe FileMember needs some smarts for handling a symlink to a directory? Here’s the script:
#!/usr/bin/env perl -w
use v5.20;
use warnings;
use utf8;
use Archive::Zip qw(:ERROR_CODES);
use File::Temp qw(tempdir);
use File::Spec::Functions qw(catfile);
my $file = shift or die "Usage: $0 ZIPFILE\n";
my $zip = Archive::Zip->new;
if ($zip->read($file) != AZ_OK) {
die "Error reading $file\n";
}
my $dest_dir = tempdir;
foreach my $member ($zip->members) {
my $fn = catfile $dest_dir, split m{/} => $member->fileName;
if ($member->extractToFileNamed($fn) != AZ_OK) {
die "Error extracting $file\n";
}
}