Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 about the Monastery: (16)
As of 2015-07-02 17:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (44 votes), past polls