Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Ensure Zip files always unpack to a single subdirectory

by bbfu (Curate)
on Jan 07, 2003 at 08:28 UTC ( #224907=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info /msg bbfu
Description: hardburn requested a utility that would ensure that Zip files did not "explode", or unpack files into the current directory, by extracting into a subdirectory if the Zip file was not already set up to do so.
#!/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.

Comment on Ensure Zip files always unpack to a single subdirectory
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://224907]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (7)
As of 2014-09-19 20:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (145 votes), past polls