Category: | Utility Scripts |
Author/Contact Info | Flavio Poletti (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))') |
Description: | A little utility which includes some options from Info-ZIP's unzip program (available at http://www.info-zip.org/pub/infozip/). Help message:
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). 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... 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. See also Create/Extract Zip Archives from #include for a bidirectional utility (but with less options for unzipping). |
#!/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 ext +ract $config{include} = [grep { !(exists $config{exclude}{$_}) } @ARG +V]; 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, t +o exdir. If list is not provided, all files are extracted, except those in xl +ist. 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; } |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: unzip
by ghenry (Vicar) on May 15, 2005 at 10:55 UTC | |
by polettix (Vicar) on May 16, 2005 at 08:35 UTC | |
by ghenry (Vicar) on May 16, 2005 at 08:50 UTC | |
by polettix (Vicar) on May 16, 2005 at 08:57 UTC | |
by elwarren (Priest) on May 17, 2005 at 19:10 UTC |
Back to
Code Catacombs