Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Perl unzip example with IO::Uncompress::Unzip
#!/usr/bin/perl
# example perl code, this may not actually run without tweaking, especially on Windows
use strict;
use warnings;
=pod
IO::Uncompress::Unzip works great to process zip files; but, it doesn't include a routine to actually
extract an entire zip file.
Other modules like Archive::Zip include their own unzip routines, which aren't as robust as IO::Uncompress::Unzip;
eg. they don't work on zip64 archive files.
So, the following is code to actually use IO::Uncompress::Unzip to extract a zip file.
=cut
use File::Spec::Functions qw(splitpath);
use IO::File;
use IO::Uncompress::Unzip qw($UnzipError);
use File::Path qw(mkpath);
# example code to call unzip:
unzip(shift);
=head2 unzip
Extract a zip file, using IO::Uncompress::Unzip.
Arguments: file to extract, destination path
unzip('stuff.zip', '/tmp/unzipped');
=cut
sub unzip {
my ($file, $dest) = @_;
die 'Need a file argument' unless defined $file;
$dest = "." unless defined $dest;
my $u = IO::Uncompress::Unzip->new($file)
or die "Cannot open $file: $UnzipError";
my $status;
for ($status = 1; $status > 0; $status = $u->nextStream()) {
my $header = $u->getHeaderInfo();
my (undef, $path, $name) = splitpath($header->{Name});
my $destdir = "$dest/$path";
unless (-d $destdir) {
mkpath($destdir) or die "Couldn't mkdir $destdir: $!";
}
if ($name =~ m!/$!) {
last if $status < 0;
next;
}
my $destfile = "$dest/$path/$name";
my $buff;
my $fh = IO::File->new($destfile, "w")
or die "Couldn't write to $destfile: $!";
while (($status = $u->read($buff)) > 0) {
$fh->write($buff);
}
$fh->close();
my $stored_time = $header->{'Time'};
utime ($stored_time, $stored_time, $destfile)
or die "Couldn't touch $destfile: $!";
}
die "Error processing $file: $!\n"
if $status < 0 ;
return;
}
1;
Owner

eqhmcow commented Apr 15, 2013

above code is licensed under GPL 2 and/or Artistic license; aka free perl software

volomike commented Dec 3, 2015

I zipped a folder on my hard drive called "Install Norton Security.localized" that had several subfolders inside on my new-ish Mac. I then renamed it to /tmp/mytest.zip. I tried your snippet but it died with the following error:

bash-3.2# perl test7.pl
Couldn't write to /tmp/mytest/Install Norton Security.localized//: Is a directory at test7.pl line 42.
b

That line was:

my $fh = IO::File->new($destfile, "w")
  or die "Couldn't write to $destfile: $!";

volomike commented Dec 3, 2015

I found a better one for you that is shorter and works well, even on an older OSX system:

https://gist.github.com/mshock/4156726

mgx259 commented Mar 11, 2016

I found a better one for you that is shorter and works well, even on an older OSX system: https://gist.github.com/mshock/4156726

It's not really better as Archive::Zip library has problems with large files (more than 4 GB)

tferic commented Mar 30, 2016

I'm having an issue with this sub on Windows (7 & 8).
The sub does unzip a ZIP archive completely, but the resulting unzipped files are binary different compared to the files unzipped by right-click-unzip in Explorer.
i.e. unzipped exe files will not execute causing an error.
Also file properties look different.
Am I the only one having this issue?

alambike commented Apr 9, 2016

In line 56 I have to set slash optional to enter in conditional when it was extracting a directory:

        if ($name =~ m!/?$!) {

Did some work on getting this to work on my Windows box... here's my take on this one. Thanks for the help getting it running!

use strict;
use warnings;
use IO::Compress::Zip;

use File::Spec::Functions qw(splitpath);
use IO::File;
use IO::Uncompress::Unzip qw($UnzipError);
use File::Path qw(mkpath);

...

sub unzipThisZipToThisDirectory {
my ($zipFilename, $destinationDir) = @_;

unless ($zipFilename and $destinationDir) {
	$! = "zipFilename and destinationDir must be supplied";
	return;
}

my $zipFile = IO::Uncompress::Unzip->new($zipFilename);

unless ($zipFile) {
	$! = "Could not open $zipFilename as zipFile";
	return;
}


# Status should always be 1 for each entry in the zip...
while (my $status = $zipFile->nextStream()) {

	my $zipEntryHeader = $zipFile->getHeaderInfo();
	my $pathAndFilename = $zipEntryHeader->{Name};

	# Returns from splitPath are volume, path, and filename...
	# We don't care about path (and it shouldn't be there, anyway)
    	my (undef, $path, $filename) = splitpath($pathAndFilename);

	# Make sure we have a filename...skip directories...
	$filename or next;

	my $fullOutputDir = $destinationDir . "/" . $path;
	mkpath($fullOutputDir);

	my $unzippedFilename = $fullOutputDir . $filename;

	my $outputFh;
	unless (open($outputFh, ">", $unzippedFilename)) {
		$! = "Could not open $unzippedFilename for writing";
		return;
	}

	binmode($outputFh);

	my $buffer;
    	while (($status = $zipFile->read($buffer))) {
		print $outputFh $buffer;
    	}

    	close($outputFh);

	print STDERR "Output $unzippedFilename " . -s $unzippedFilename, " bytes\n\n";
}

return 1;

}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment