#!/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;
}