Created

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Perl unzip example with IO::Uncompress::Unzip

View unzip.pl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
#!/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

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.