Perl unzip example with IO::Uncompress::Unzip - unzip all zip files in a folder
#!/usr/bin/perl
use strict;
use warnings;
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);
#-------------------------------------------------------------------------------
# Build Date: 2016-02-22
# Description:
# This script uncompresses all zip files in a folder
# Dependencies:
# - n/a
# Arguments:
# - folder location (including UNC paths), ie. c:\windows
#-------------------------------------------------------------------------------
# Credits: Daniel Sterling
# Unzip contents to disk - https://gist.github.com/eqhmcow/5389877
# ------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# Extract a zip file, using IO::Uncompress::Unzip.
# Arguments: Folder containing zip files
# Eg: perl <script> <Folder path>
#-------------------------------------------------------------------------------
sub unzip {
my ($folder, $dest) = @_;
die 'Please enter the path of the folder containing the .zip files as an argument -' unless defined $folder;
$dest = "." unless defined $dest;
my @file = glob "$folder\\*.zip";
foreach my $a(@file){
my $u = IO::Uncompress::Unzip->new($a)
or die "Cannot open $a: $UnzipError";
print "Extracting zip - $a \n";
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: $!";
}
print "---Done \n";
die "Error processing $a: $!\n"
if $status < 0 ;
}
}
1;