#!/usr/bin/perl
use warnings;
use strict;
use Archive::Zip qw( :ERROR_CODES );
my $File = shift or die "Must supply a file name.\n";
Archive::Zip::setErrorHandler sub { die @_ }; # Make errors fatal
my $zip = Archive::Zip->new();
$zip->read($File);
my $flag;
# Flag if there is more than one "root item", be it file or subdir
my $first = ($zip->members())[0]->fileName() =~ m{^([^/]*)/} && $1;
for ($zip->members()) {
if(
# Flag if it's not under a subdir...
$_->fileName() !~ m{/} or $_->fileName() =~ m{^\./[^/]+$} or
# ...or if it's under a different subdir
($_->fileName() =~ m{^([^/]*)/} and $1 ne $first)
) {
$flag = 1;
last;
}
}
# Alternatively, you could just...
# Flag if any files are not under a directory
# (you could still have multiple subdirs extracted)
#for ($zip->members()) {
# if($_->fileName() !~ m{/} or $_->fileName() =~ m{^\./[^/]+$}) {
# $flag = 1;
# last;
# }
#}
if($flag) {
(my $folder = $File) =~ s/\.zip$//;
# Relocate all members into a subdir who's name is based on the zip
+file
for my $member ($zip->members()) {
$member->fileName($folder . '/' . $member->fileName());
}
}
# Now that we know it's safe, go ahead and unpack it
# Normally, would just use $zip->extractTree() but there seems to
# be a bug that adds a single . to the begining of all the top-level
# files. This, of course, makes them hidden (by default) under *nix.
$zip->extractMember($_) for $zip->members;
# Or, of course, you could just $zip->overwrite() to save it back.
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
|
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.
|
|