Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
"be consistent"
 
PerlMonks  

unzip

by polettix (Vicar)
on May 14, 2005 at 23:33 UTC ( #457135=sourcecode: print w/ replies, xml ) Need Help??

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:
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, 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 :)
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;
}

Comment on unzip
Download Code
Re: unzip
by ghenry (Vicar) on May 15, 2005 at 10:55 UTC

    Very nice work, but I'm not sure of the point of this quick replacement?

    Archive::Zip, is not part of core perl, so you'd have to go and install this. So in my eyes, you might as well install the unzip package itself.

    Just a thought.

    Walking the road to enlightenment... I found a penguin and a camel on the way.....
    Fancy a yourname@perl.me.uk? Just ask!!!
      Archive::Zip gives you the flexibility to deal with zip files inside your Perl scripts without resorting to a system/fork, which is sometimes useful for me. Moreover, installing Archive::Zip is easier - you don't have to look for it, it's already at your -MCPAN -e shell :)

      But you're right - the actual point is that I was messing a bit with Archive::Zip and Getopt::Std to take confidence and I wanted to share the results. BTW, I think that I'll look for alternatives to Getopt::Std - it does not give me the possibility to replicate unzip's argument schema in toto...

      Thanks for the thought.

      Flavio (perl -e 'print(scalar(reverse("\nti.xittelop\@oivalf")))')

      Don't fool yourself.

        No problem.

        It's always good to play with things, as it's the best way to get them into your head.

        -MCPAN -e shell

        But if you've not run that before, it takes ages, and you've got to wait for everything to compile etc. But a apt-get install unzip is quicker ;-)

        Walking the road to enlightenment... I found a penguin and a camel on the way.....
        Fancy a yourname@perl.me.uk? Just ask!!!
      For good or bad, on windows, installing Archive::Zip with PPM slides right through the firewall at work. Installing an exe is forbidden.

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (8)
As of 2014-04-21 10:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (492 votes), past polls