#!/usr/bin/perl
#desc{ a friendly wrapper around 'zip', with sanity-checking }
#======================================================================
my $VERSION = "2.01"; #Time-stamp: "2008-08-19 19:17:22 AKDT sburke@cpan.org"
# Note:
#  If ZIPOPT is set, we obey it, for general compression or for -n exclusions.
#======================================================================
die "Usage:   pack dirspec
                                        [sburke\@cpan.org, version $VERSION]
" unless @ARGV == 1;

use strict;
use warnings;
use constant DEBUG => 0;
my $In = $ARGV[0];
my $Out;
my $Exit_val = 0;
my $Compression = "2";  # <--- fast, and efficient-enough, I think

sanity_check();
config_options();
go_ahead();
exit $Exit_val;

#======================================================================

sub sanity_check {
  die "There's no such directory as $In!\n Aborting" unless -e $In and -d _;
  die "I can't read $In!\n Aborting" unless -x _ and -r _;

  $In =~ s</+$><>s;
  die "But you can't pack '$In'!" if $In =~ m{\A \. \.+ \z}x;
  $Out = "$In.zip";
  die "But $Out already exists!\n Aborting" if -e $Out;
  return;
}

#======================================================================

sub config_options {
  # We assume your ZIPOPT doesn't (stupidly) have clustering, like "-0rn .mp3"
  # So keep 'em separate, like: "-0" and "-n .gif:.zip"

  my $zipopt = $ENV{'ZIPOPT'} || '';
  $zipopt = " $zipopt ";

  if($zipopt =~ m< \s -(\d) \s>x ) {  # like "-2"
    $Compression = $1;
    DEBUG and print "Trusting compr=$Compression from zipopt [$zipopt]\n";
  }

  if($zipopt =~ m< \s -n \s>x ) { # like "-n .gif:.zip"
    # trust Zipopts's list of non-compressables
    DEBUG and print "Trusting -n... list from zipopt [$zipopt]\n";
  } else {
    scan_that_structure();  
  }
  return;
}

#======================================================================
# Now do it all

sub go_ahead {
  my @options = (
    ((DEBUG > 1) ? () : "-q"),
    "-r",             # recurse
    "-$Compression",  # appropriate compression
    $Out, $In
  );
  DEBUG and print "Running: zip ", join(' ', @options), "\n";
  system "zip", @options, "-x", "*~*";
  sleep 0;

  if(-e $Out) {
    my $s = -s _;
    print " Output: $Out = ", commify($s), " bytes.\n";
  } else {
    print "What, $Out doesn't exist?!";
    $Exit_val = 1;
  }
  return;
}

#======================================================================

sub scan_that_structure {
  my $goo_count   = 0;
  my $pseudototal_count = 0;

  # Problem: if given a huge dir structure, this recursion could
  #  take a while.  But on the other hand, zipping it will probably
  #  take not much longer.
  # I guess I could do a non-local exit with eval{}, but that seems
  #  pretty shady, and I've never tried that.

  require File::Find;
  DEBUG and print "About to scan $In...\n";
  File::Find::find( {
    no_chdir => 1,
    wanted => sub {
      m{\.(
            zip  # Extensions that I'm pretty sure aren't worth compressing:
          | gz jpg wav mp3 gif msf wma
          | mov wmv swf avi mpg pdf mpeg
	  | ogg png Z

         )$}ixs && ++$goo_count;
      ++$pseudototal_count;
      DEBUG > 3 and print " [$_]\n";
      return;
    },
  }, $In );
  print "Done scanning $In\n";

  $pseudototal_count -= 5;
  $pseudototal_count = 1 if $pseudototal_count < 1;
  if( $goo_count > 20 or ($goo_count / $pseudototal_count) > .3 ) {
    $Compression = "0";
    print "Using null compression.\n";
  }

  DEBUG and print " Pseudototal items: $pseudototal_count.", 
    "     Goo count: $goo_count\n";

  return;
}

#======================================================================

sub commify {
  my $x = $_[0];
  1 while $x =~ s/^([-+]?\d+)(\d{3})/$1,$2/;
  return $x;
}

#======================================================================
__END__