public
Created

Perl unzip example with IO::Uncompress::Unzip

  • Download Gist
unzip.pl
Perl
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;

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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.