Thursday, April 23, 2009

Unzip an archive with Perl

I keep this template around to work with zipped archives. Helps...

use Cwd;
use File::Find;
use File::Basename;
use Archive::Zip;
use File::Copy;

$working = getcwd();
find(\&process,$working);
sub process(){
my(undef, undef, $ftype) = fileparse($_,qr"\..*");
if ( (-f $File::Find::name) & ($ftype eq "\.zip") ){
my $zipname = $File::Find::name;
my $dest = "$working"."/temp";
my $zip = Archive::Zip->new($zipname);
foreach my $member ($zip->members)
{
(my $extractName = $member->fileName) =~ s{.*/}{};
print $extractName;
#do some stuff here
}
unlink ($dest);
}
}

No comments:

Post a Comment