#!/usr/bin/perl
# Filename:	thumb
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Requires:	convert
# Description:	Makes scaled/cropped thumbnails from image files
use strict;

##################################################
# Setup the variables
##################################################
my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $CONVERT	= "convert";
my $IDENTIFY	= "identify";	# Undef if you don't have identify
my $THUMB_DIR;
my $THUMB_POST;
my $THUMB_TYPE	= "gif";

# Size of the thumbnails
my $TN_X	= 100;
my $TN_Y	= 100;

# Crop the thumbnails?
my $CROP	= 0;

my $FORCE	= 0;

##################################################
# Usage
##################################################
sub usage {
  my $msg;
  foreach $msg (@_) { print "ERROR:  $msg\n"; }
  print "\n";
  print "Usage:\t$PROGNAME [-d] [-geom <x>x<y>] [-crop] [-dir <path>] <images>\n";
  print "\tMakes thumbnails from images\n";
  print "\n";
  print "\t-geom\tSize of thumbnail [default ${TN_X}x${TN_Y}]\n";
  print "\t-crop\tCrop the image to fit thumbnail size.\n";
  print "\t\tElse aspect will be maintained\n";
  print "\t-dir\tThumbnail directory\n";
  print "\t-post\tThumbnail postfix\n";
  print "\t-f\tForce overwrite of existing thumbnails\n";
  print "\t\tElse existing thumbnails are only written when the image changes\n";
  print "\t-type\tType of thumbnails (gif, jpg, tiff,...)\n";
  print "\t-d\tSet debug mode\n";
  print "\n";
  exit -1;
}

sub set_size {
  my ($size) = @_;
  return ($TN_X,$TN_Y) = ($1,$2) if ($size =~ /^(\d+)x(\d+)$/);
  usage("Can't understand geometry [$size]");
}

sub parse_args {
  my @images;
  my $arg;
  while ($#ARGV>=0) {
    $arg=shift(@ARGV);
    if ($arg =~ /^-h$/) { usage(); }
    if ($arg =~ /^-d$/) { $MAIN::DEBUG = 1; next; }
    if ($arg =~ /^-crop$/) { $CROP = 1; next; }
    if ($arg =~ /^-f(orce)?$/) { $FORCE = 1; next; }
    if ($arg =~ /^-dir$/) { $THUMB_DIR = shift(@ARGV); next; }
    if ($arg =~ /^-post$/) { $THUMB_POST = shift(@ARGV); next; }
    if ($arg =~ /^-type$/) { $THUMB_TYPE = shift(@ARGV); next; }
    if ($arg =~ /^-g(eom(etry)?)?(=(.+))?$/) { set_size($4 ? $4 : shift(@ARGV)); next; }
    if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
    usage("Can't find image $arg") unless (-f $arg);
    push(@images,$arg);
  }
  usage("You need to specify an image") unless (@images);

  (@images);
}

##################################################
# Code
##################################################
sub thumb_name {
  my ($img) = @_;

  # Remove postfix
  $img =~ s/\.[^\.\/]+$//;

	my $post = $THUMB_POST || ".tn.$THUMB_TYPE";
  return $img.$post unless ($THUMB_DIR);

  my $dir = $THUMB_DIR;
  ($dir,$img) = ("$`/$THUMB_DIR",$1) if ($img =~ m|/([^/]*)$|);

  (-d $dir) || mkdir($dir,0755) || die("[$PROGNAME] Couldn't make directory [$dir]\n");

  return "$dir/$img$post";
}

sub get_size {
  my ($img) = @_;
  my ($qimg) = "\Q$img\E";

  return (0,0) unless (-f $img);

  # Try to use identify if we have it
  if ($IDENTIFY) {
    print STDERR "get_size() run: $IDENTIFY -ping $img\n" if ($MAIN::DEBUG);
    open(SIZE,"$IDENTIFY -ping $qimg 2>&1 |") ||
      die("[$PROGNAME] Couldn't run identify!  [$IDENTIFY]\n");
    while(<SIZE>) {
      print STDERR "get_size(): $_" if ($MAIN::DEBUG);
      if(/\s(\d+)x(\d+)(\s|\+)/) {
        close(SIZE);
        return ($1,$2);
      }
    }
    die("[$PROGNAME] Can't get [$img] size from 'identify -ping' output\n");
  }

  # Kludgy way to get size, but works with all images that convert reads
  print STDERR "get_size() run: $CONVERT -verbose $img /dev/null\n" if ($MAIN::DEBUG);
  open(SIZE,"$CONVERT -verbose $qimg /dev/null 2>&1 |") ||
    die("[$PROGNAME] Couldn't run convert!  [$CONVERT]\n");
  while(<SIZE>) {
    print STDERR "get_size(): $_" if ($MAIN::DEBUG);
    if(/\s(\d+)x(\d+)(\s|\+)/) {
      close(SIZE);
      return ($1,$2);
    }
  }
  die("[$PROGNAME] Can't get [$img] size from 'convert -verbose' output\n");
}

sub scale {
  my ($img,$x,$y,$new) = @_;
  my ($qimg) = "\Q$img\E";
  my ($qnew) = "\Q$new\E";

  print STDERR "scale() run: $CONVERT -verbose $img -sample ${x}x${y} $new\n"
    if ($MAIN::DEBUG);
  open(SIZE,"$CONVERT -verbose $qimg -sample ${x}x${y} $qnew 2>&1 |") ||
    die("[$PROGNAME] Couldn't run convert!  [$CONVERT]\n");
  while(<SIZE>) {
    print STDERR "scale(): $_" if ($MAIN::DEBUG);
    if(/=>(\d+)x(\d+)\s/) {
      close(SIZE);
      return ($1,$2);
    }
  }
  close(SIZE);

  # Sometimes convert doesn't give us the new size information
  #print STDERR "[$PROGNAME] Error scaling $img\n";
  get_size($new);
}

sub crop {
  my ($img,$x,$y,$off_x,$off_y,$new) = @_;
  my ($qimg) = "\Q$img\E";
  my ($qnew) = "\Q$new\E";

  print STDERR "crop() run: $CONVERT $img -crop ${x}x${y}+${off_x}+${off_y} $new\n"
    if ($MAIN::DEBUG);
  system("$CONVERT $qimg -crop ${x}x${y}+${off_x}+${off_y} $qnew");
  return unless ($?);
  print STDERR "[$PROGNAME] Error cropping $img\n";
}

##################################################
# Main code
##################################################
sub main {
  foreach my $img ( parse_args() ) {

    print STDERR "\nIMAGE: $img\n" if ($MAIN::DEBUG);

    my ($thumb) = thumb_name($img);

    if (-f $thumb && !$FORCE && -M $thumb < -M $img) {
      print "$thumb\n";
      next;
    }

    my ($x,$y) = get_size($img);

    # Which way do we need to shrink?  convert will scale down w/ aspect
    # as much as is needed to *fit* inside the geometry we give it
    # Hack:  Assume the image is larger than a thumbnail
    my ($scale_x,$scale_y) = ($TN_X,$TN_Y);
    if ($CROP) {
      if ( $x/$TN_X < $y/$TN_Y ) {
        # Make vertical bigger so that we don't scale horizontal past $TN_X
        $scale_y = $y;
      } else {
        $scale_x = $x;
      }
    }
    ($x,$y) = scale($img,$scale_x,$scale_y,$thumb);
    next unless $x;

    if ($CROP) {
      # Now crop the other dimension
      my ($off_x,$off_y) = (0,0);
      if ( $x > $TN_X ) {
        $off_x = int(($x-$TN_X)/2);
      }
      if ($y > $TN_Y) {
        $off_y = int(($y-$TN_Y)/2);
      }
      crop($thumb,$TN_X,$TN_Y,$off_x,$off_y,$thumb)
        unless ($x==$TN_X && $y==$TN_Y);
    }

    print "$thumb\n";
  }
}
main();