sourcecode
polettix
<code>
#!/usr/bin/perl
# Script that aims to include the most useful features of unzip, to be
# used where this utility is missing.
#
# Copyright (C) 2005 by Flavio Poletti
# License: same as Perl as of version 5.8.6
use warnings;
use strict;
use Getopt::Std 'getopts';
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Basename 'basename';
use File::Spec;
# Get configurations from @ARGV
my %config;
get_config();
# Open ZIP file
my $zip = Archive::Zip->new($config{zipfile})
or die "$config{zipfile}: read error, stopped";
# Get list of members to work on if it was not provided by the user
$config{include} =
[grep { !(exists $config{exclude}{$_}) } $zip->memberNames()]
unless (exists $config{include});
# Header of feedback, if needed
print "Archive: $config{zipfile}\n" if $config{verbose};
# Go ahead
$config{header}() if $config{header};
$config{action}($zip, $_) foreach (@{$config{include}});
$config{footer}() if $config{footer};
#########################################################################
# Action functions: extraction
sub extract_file {
my ($zip, $filename) = @_;
print " inflating: $filename\n" if $config{verbose};
my $member = $zip->memberNamed($filename);
my $outfilename = $filename;
$outfilename =
File::Spec->catdir($config{directory}, basename($filename))
if ($config{directory});
$zip->extractMember($member, $outfilename);
# Restore permissions
chmod $member->unixFileAttributes() & 0777, $outfilename;
} ## end sub extract_file
#########################################################################
# Action functions: dump to standard output
{
my $stdout;
sub dump_header {
open $stdout, ">&STDOUT" or die "can't dup STDOUT: $!, stopped";
}
sub dump_file {
my ($zip, $filename) = @_;
my $status =
$zip->memberNamed($filename)->extractToFileHandle($stdout);
die "error extracting $filename: $status, stopped"
unless $status == AZ_OK
} ## end sub dump_file
}
#########################################################################
# Action functions: list of files
{
my ($nfiles, $totlength);
sub list_header {
print " Length Date Time Name\n";
print " -------- ---- ---- ----\n";
}
sub list_file {
my ($zip, $filename) = @_;
my $member = $zip->memberNamed($filename);
++$nfiles;
$totlength += $member->uncompressedSize();
my ($min, $hour, $mday, $month, $year) =
(localtime($member->lastModTime()))[1 .. 5];
++$month;
$year %= 100;
printf " %8d %02d-%02d-%02d %02d:%02d %s\n",
$member->uncompressedSize(), $month, $mday, $year, $hour, $min,
$filename;
} ## end sub list_file
sub list_footer {
print " -------- ---- ---- ----\n";
printf " %8d %d file%s\n", $totlength, $nfiles,
($nfiles == 1 ? '' : 's');
}
}
#########################################################################
# Configuration from command line
sub get_config {
my $href = shift;
# Set defaults
%config = (
header => undef,
footer => undef,
action => \&extract_file,
directory => undef,
verbose => 1
);
my %cmdline;
getopts('d:hlpqx:', \%cmdline);
HELP_MESSAGE() if exists $cmdline{h};
if (exists $cmdline{p}) {
$config{header} = \&dump_header;
$config{action} = \&dump_file;
}
$config{verbose} = 0 if $cmdline{'q'} || $cmdline{p};
$config{directory} = $cmdline{d} if exists $cmdline{d};
$config{exclude} = {map { $_ => undef } split /,/, $cmdline{x}}
if exists $cmdline{x};
if (exists $cmdline{l}) {
$config{header} = \&list_header;
$config{action} = \&list_file;
$config{footer} = \&list_footer;
$config{verbose} = 1;
} ## end if (exists $cmdline{l})
HELP_MESSAGE("no input filename given") unless @ARGV;
my $filename = $config{zipfile} = shift @ARGV;
unless (-f $config{zipfile}) { # Try to append .zip extension
$config{zipfile} .= ".zip";
HELP_MESSAGE("Could not find either $filename or $filename.zip")
unless (-f $config{zipfile});
}
if (@ARGV) { # Remaining items are file to extract
$config{include} = [grep { !(exists $config{exclude}{$_}) } @ARGV];
delete $config{exclude};
}
} ## end sub get_config
#########################################################################
# Help messages
sub HELP_MESSAGE {
my $errmsg = shift;
print <<EOF ;
Usage $0 [-l|-p] [-q] [-x xlist] [-d exdir] file[.zip] [list]
Default action is to extract files in list, except those in xlist, to exdir.
If list is not provided, all files are extracted, except those in xlist.
Extraction re-creates subdirectories, except when exdir is provided.
-d extract to provided directory, no directory structure.
-h this help message
-l list files (short format)
-p extract files to stdout, no messages
-q quiet mode, no messages
-x exclude files that follow in xlist, comma-separated (Note 1)
Note 1: files with commas aren't allowed yet :)
EOF
if ($errmsg) {
print STDERR "\n$errmsg\n";
exit 1;
}
exit 0;
}
</code>
A little utility which includes some options from Info-ZIP's unzip program (available at http://www.info-zip.org/pub/infozip/). Help message:
<code>
Usage ../unzip.pl [-l|-p] [-q] [-x xlist] [-d exdir] file[.zip] [list]
Default action is to extract files in list, except those in xlist, to exdir.
If list is not provided, all files are extracted, except those in xlist.
Extraction re-creates subdirectories, except when exdir is provided.
-d extract to provided directory, no directory structure.
-h this help message
-l list files (short format)
-p extract files to stdout, no messages
-q quiet mode, no messages
-x exclude files that follow in xlist, comma-separated (Note 1)
Note 1: files with commas aren't allowed yet :)
</code>
The utility is primarily intended as a quick replacement for unzip on systems where this utility isn't available. I've implemented the options I use most, like seeing what's inside the file (-l option) and extracting to a directory without structure (-d option, even if I'm not really sure of this). I also find extraction to standard output quite useful some time to time, so I put it in (-p option).
<p>As an added bonus, you can provide a list of files to extract (default is all files) and of files to avoid to extract (-x option). Testing will be implemented in the future, if I remember...
<p>The command line differs from that of Info-ZIP unzip because the order for the options is different. Here I expect all options listed at the beginning, then the zip file name, then the names of the files to extract (if any). That's basically how Getopt::Std::getopts works, sorry for this.
<p>See also [Create/Extract Zip Archives] from [#include] for a bidirectional utility (but with less options for unzipping).
Utility Scripts
Flavio Poletti (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))')