#!/usr/bin/perl -w
# Copyright © 2002-2006 Jamie Zawinski <jwz@dnalounge.com>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created: 18-Apr-2002.
#
# Script for automating the conversion of outside promoters' jpegs.
# Creates the right file names, front and back images, and thumbnails,
# all with a 40% gray 1 pixel border.

require 5;
use diagnostics;
use strict;

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.43 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;
my $debug_p = 0;


my $flyer_dir = "flyers";

my @months = ("January", "February", "March", "April", "May", "June", "July",
              "August", "September", "October", "November", "December");
my %monthvals = (
  'jan' => 1, 'january' => 1, 'february' => 2, 'feb' => 2, 'march' => 3,
  'mar' => 3, 'april' => 4, 'apr' => 4, 'may' => 5, 'jun' => 6, 'june' => 6,
  'jul' => 7, 'july' => 7, 'august' => 8, 'aug' => 8, 'sep' => 9, 'sept' => 9,
  'september' => 9, 'oct' => 10, 'october' => 10, 'nov' => 11,
  'november' => 11, 'dec' => 12, 'december' => 12
);


sub image_size($) {
  my ($file) = @_;
  error ("$file does not exist") unless -f $file;
  return (0, 0) unless -f $file;
  my $cmd = ("convert -density 300x300 '$file' " .
#             ($file =~ m/\.(ps|eps|epsf|pdf)$/i ? "-trim " : "") .
             "info:");
  print STDERR "$progname: executing: $cmd\n" if ($verbose > 2);
  my $result = `$cmd`;
  print STDERR "$progname:   ==> $result\n" if ($verbose > 2);
  my ($w, $h) = ($result =~ m/ (\d+)x(\d+) /);
  error ("no size: $file") unless ($w && $h);
  return ($w, $h);
}


sub date_to_dir($) {
  my ($date) = @_;
  my ($dotm, $month, $year);

  if ($date =~ m!^(\d\d\d\d)[-/ ](\d\d)[-/ ](\d\d?)$!s) {
    ($dotm, $month, $year) = ($3, $2, $1);
  } elsif ($date =~ m!^(\d\d?)[-/ ]([a-z]+)[-/ ](\d\d\d\d)$!s) {
    ($dotm, $month, $year) = ($1, $2, $3);
    $month =~ s/^(...).*$/$1/;
    $month =~ tr/A-Z/a-z/;
    $month = $monthvals{$month};
    error ("unparsable date: $date") unless defined ($month);
  } else {
    error ("unparsable date: $date");
  }

  error ("unparsable date: $date")
    if ($dotm == 0 || $dotm > 31 ||
        $month == 0 || $month > 12 ||
        $year < 1970);

  {
    my @now = localtime();
    my $d1 = sprintf("%04d%02d", $year, $month);
    my $d2 = sprintf("%04d%02d", $now[5]+1900, $now[4]+1);
    my $n = $d2 - $d1;
    error ("$date was $n months ago, dumbass.") 
      if ($n >= 4);
  }

  error ("$flyer_dir: no such directory") unless (-d $flyer_dir);
  my $year_dir = sprintf ("%s/%04d", $flyer_dir, $year);
  error ("$year_dir: no such directory") unless (-d $year_dir);
  my $month_dir = sprintf ("%s/%02d", $year_dir, $month);
  error ("$month_dir: no such directory") unless (-d $month_dir);

  return ($month_dir, $dotm);
}


# Returns the highest numbered existing flyer file (0 if none.)
# Also returns the file name.
#
sub existing_number($$$) {
  my ($dir, $dotm, $name) = @_;
  my $last_n = 0;
  my $last_f = undef;
  for (my $n = 0; $n < 9; $n++) {
    my $file = sprintf ("%s/%02d-%s-%s.jpg", $dir, $dotm, $name, $n);
    if (-f $file) {
      $last_n = $n;
      $last_f = $file;
    }
  }
  return ($last_n, $last_f);
}


# Given the size of an image, pick the size to which we should scale it.
# This is used for converting "raw" images to "full sized" images; and
# for converting "full sized" images to thumbnails.
#
sub pick_image_size($$$) {
  my ($ow, $oh, $thumb_p) = @_;

  my $square_p = (int (($ow / 10) + 0.5) ==       # within 10% of square
                  int (($oh / 10) + 0.5));
  my $tall_p = ($oh > $ow);    # portrait = 1, landscape = 0

  my $square_size;  # size of square images
  my $max_size;     # max size of largest dimension of a rectangular image
  my $min_size;     # min size of smallest dimension of a rectangular image

  if (!$thumb_p) {
    $square_size = 600;
    $max_size    = 800;
    $min_size    = 360;

  } else {

    $square_size = 120;
    $max_size    = ($tall_p ? 300 : 220); # very tall is ok, very wide is not.
    $min_size    = 120;

    # If it's approximately 1x2 (or 2x1) then reduce min size.
    my $r = int($ow/5) / int($oh/5);
    if ($r == 0.5 || $r == 2.0) {
      $min_size = 100;
    }
  }

  my ($nw, $nh);

  if ($square_p) {		# square is the same for both.
    $nw = $square_size;
    $nh = $square_size;

  } elsif ($thumb_p) {		# with thumbs, aim for min size.

    $nw = ($tall_p
           ? $min_size
           : int ($min_size * ($ow / $oh)));
    $nh = ($tall_p
           ? int ($min_size * ($oh / $ow))
           : $min_size);

  } else {			# with non-thumbs, aim for max size.

    $nw = ($tall_p
           ? int ($max_size * ($ow / $oh))
           : $max_size);
    $nh = ($tall_p
           ? $max_size
           : int ($max_size * ($oh / $ow)));
  }


  # Enforce max size for both.
  #
  if ($nw > $max_size) {
    $nw = $max_size;
    $nh = int ($max_size * ($oh / $ow));
  } elsif ($nh > $max_size) {
    $nw = int ($max_size * ($ow / $oh));
    $nh = $max_size;
  }

  # Enforce min size (only for non-thumbs).
  #
  if ($thumb_p) {
  } elsif ($nw < $min_size) {
    $nw = $min_size;
    $nh = int ($min_size * ($oh / $ow));
  } elsif ($nh < $min_size) {
    $nw = int ($min_size * ($ow / $oh));
    $nh = $min_size;
  }



  return ($nw, $nh);
}


# Converts the raw source images, to the "full sized" images.
# Returns a list of the image files written.
#
sub make_images($$$$$$$$$) {
  my ($dir, $dotm, $name, $n, $thumb_p, $border_p, $qual, $front, $back) = @_;

  my ($fw, $fh)  = image_size ($front);
  my ($bw, $bh)  = image_size ($back) if ($back);

  my ($fw2, $fh2) = pick_image_size ($fw, $fh, $thumb_p);
  my ($bw2, $bh2) = pick_image_size ($bw, $bh, $thumb_p) if ($back);

  # If the source images are not exactly the same shape, but are *very close*,
  # then just pretend the back image was the size of the front image, and
  # deform it to fit.
  #
  if ($back &&
      !($fw2 == $bw2 && $fh2 == $bh2) &&
      !($fw2 == $bh2 && $fh2 == $bw2)) {

    my $fudge = 5;
    my $o1 = "${fw2}x$fh2 (${fw}x$fh)";
    my $o2 = "${bw2}x$bh2 (${bw}x$bh)";
    my $rotated_p = (($fw2/$fh2 < 1) !=   # rotate if aspect ratios differ
                     ($bw2/$bh2 < 1));
    my $ok = (!$rotated_p
              ? ((abs ($fw2 - $bw2) < $fudge) &&
                 (abs ($fh2 - $bh2) < $fudge))
              : ((abs ($fw2 - $bh2) < $fudge) &&
                 (abs ($fh2 - $bw2) < $fudge)));
    if ($ok) {
      print STDERR "$progname: fudging close-enough image sizes:\n" .
                   "$progname: $front is $o1;\n" .
                   "$progname: $back was $o2.\n";

      if (!$rotated_p) {
        ($bw2, $bh2) = ($fw2, $fh2);
      } else {
        ($bw2, $bh2) = ($fh2, $fw2);
      }
    }
  }

  # If the source images are small, then don't scale them.
  #
  if ($fw < $fw2 || $fh < $fh2) {
    print STDERR "$progname: $front: not scaling small flyer ($fw x $fh)\n";
    $fw2 = $fw;
    $fh2 = $fh;
    $bw2 = $bw;
    $bh2 = $bh;
  }


  # The resultant images should be the exact same dimensions, modulo rotation.
  #
  if ($back &&
      !($fw2 == $bw2 && $fh2 == $bh2) &&
      !($fw2 == $bh2 && $fh2 == $bw2)) {
    error (            "$front is ${fw}x$fh (${fw2}x$fh2);\n" .
           "$progname: $back is ${bw}x$bh (${bw2}x$bh2)");
  }


  # When making thumbnails:
  #   If the back image seems to be rotated 90 degrees from the front image,
  #   (and is not square) then rotate it so that they are the same.
  # For non-thumbnails, leave it as-is.
  #
  my $rotate_back_p = ($back &&
                       $thumb_p &&
                       ($fw2 == $bh2 &&
                        $fh2 == $bw2 &&
                        $fw2 != $fh2));
  my @files = ();
  my $n1 = $n     . ($thumb_p ? "-thumb" : "");
  my $n2 = ($n+1) . ($thumb_p ? "-thumb" : "");

  push @files, scale_image ($front, $dir, $dotm, $name, $n1,
                            $border_p, $qual, 0,
                            $fw, $fh, $fw2, $fh2);
  push @files, scale_image ($back,  $dir, $dotm, $name, $n2,
                            $border_p, $qual, $rotate_back_p,
                            $bw, $bh, $bw2, $bh2)
    if ($back);
  return @files;
}



sub flyerize($$$$$$$) {
  my ($date, $name, $border_p, $qual, $add_p, $front, $back) = @_;
  my @files = ();

  my ($dir, $dotm) = date_to_dir ($date);

  my ($last_n, $last_file) = existing_number ($dir, $dotm, $name);

  my $n = (!$add_p ? 1 : (($last_n + 1) | 1));

  error ("-2 was specified, but no flyers exist already")
    if ($add_p && $n == 1);

  my $tqual = 95;  # thumbs are always high quality (they're small regardless.)

  my (@main)  = make_images ($dir, $dotm, $name, $n, 0, $border_p, $qual,
                             $front, $back);
  my (@thumb) = make_images ($dir, $dotm, $name, $n, 1, $border_p, $tqual,
                             $main[0], $main[1]);
  return (@main, @thumb);
}


sub scale_image($$$$$$$$$$$$) {
  my ($file, $dir, $dotm, $name, $n, $border_p, $qual, $rotate_p,
      $ow, $oh, $w2, $h2) = @_;

  error ("$dir: no such directory") unless (-d $dir);

  my $bdcolor = "#666666";
  my $outfile = sprintf ("%s/%02d-%s-%s.jpg", $dir, $dotm, $name, $n);

#  error ("$outfile already exists") if (-f $outfile);

  if ($rotate_p) {
    ($w2, $h2) = ($h2, $w2);
  }

  my ($w2i, $h2i) = ($w2, $h2);  # internal size (not counting border)
  if ($border_p) {
    $w2i -= 2;
    $h2i -= 2;
  }

  $qual = int($qual);
  error ("bogus quality: $qual") if ($qual <= 50 || $qual > 100);

  my @cmd = ("convert", 
             "-density", "300x300",
             $file
             );

#  push @cmd, "-trim" if ($file =~ m/\.(ps|eps|epsf|pdf)$/i);

  push @cmd, ("-rotate", "-90") if ($rotate_p);

  if ($ow != $w2i || $oh != $h2i) {
    push @cmd, ("-resize", "${w2i}x${h2i}!");
    print STDERR "$progname: $file: scaling" . ($rotate_p ? "/rotating" : "") .
                 " ${ow}x${oh} -> ${w2}x${h2}\n"
      if ($verbose > 1);
  }

  push @cmd, ("-bordercolor", $bdcolor, "-border", "1") if ($border_p);

  push @cmd, ("-colorspace", "RGB",
              "-quality", $qual,
              $outfile);

  if ($debug_p) {
    print STDERR "$progname: not running: " . join(' ', @cmd) . "\n"
      if ($verbose > 2);
    print STDERR "$progname: not writing $outfile (${w2} x $h2)\n"
      if ($verbose);

    if (-f $outfile) {
      my ($oow, $ooh) = image_size ($outfile);
#      if ($border_p) { $oow -= 2; $ooh -= 2; }
      $oow = $w2 if ($oow == $w2+1 || $oow == $w2-1); # ignore off-by-1
      $ooh = $h2 if ($ooh == $h2+1 || $ooh == $h2-1);
      if ($w2 != $oow || $h2 != $ooh) {
        print STDERR "$progname: WARNING: would have changed $outfile\n" .
                     "$progname: WARNING: from $oow x $ooh to $w2 x $h2\n";
      }
    }

    return $outfile;
  }

  print STDERR "$progname: executing: " . join(' ', @cmd) . "\n"
    if ($verbose > 2);

  system (@cmd);
  my $exit_value  = $? >> 8;
  my $signal_num  = $? & 127;
  my $dumped_core = $? & 128;
  error ("$cmd[0]: core dumped!") if ($dumped_core);
  error ("$cmd[0]: signal $signal_num!") if ($signal_num);
  error ("$cmd[0]: exited with $exit_value!") if ($exit_value);

  error ("$cmd[0] failed: $outfile does not exist") unless (-f $outfile);
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = stat($outfile);
  my $k = int (($size + 1023) / 1024);

  ($w2, $h2) = image_size ($outfile);  # be truthful, ok?

  print STDERR "$progname: wrote $outfile (${k}K, ${w2} x $h2)\n"
    if ($verbose);

  return $outfile;
}


# Regenerate all thumbnails of the given event.
#
sub rethumb($$$$) {
  my ($dir, $dotm, $name, $border_p) = @_;

  my $tqual = 90;  # thumbs are always 90% (they're small regardless.)

  my @files;
  foreach my $file (glob("$dir/$dotm-$name-*")) {
    if ($file =~ m@/\d\d-[^-./]+-(\d+)\.[^-./]+$@) {
      my $n = $1;
      $files[$n] = $file;
    }
  }

  for (my $n = 1; $n <= $#files; $n += 2) {
    my $front = $files[$n];
    my $back  = $files[$n+1];
    my (@thumbs) = make_images ($dir, $dotm, $name, $n, 1,
                                $border_p, $tqual,
                                $front, $back);
  }
}


# Regenerate all thumbnails of the given date.
#
sub rethumb_date($$) {
  my ($date, $border_p) = @_;
  my ($dir, $dotm) = date_to_dir ($date);
  $dotm = sprintf("%02d", $dotm);

  print STDERR "$progname: rethumbing: $dir/$dotm-*\n" if ($verbose > 2);

  my %names;
  foreach (glob ("$dir/$dotm-*")) {
    $names{$1} = 1 if (m@/\d\d-([^-.]+)[^/]*$@i);
  }
  
  foreach my $name (sort (keys %names)) {
    rethumb ($dir, $dotm, $name, $border_p);
  }
}


# Regenerate all thumbnails under flyers/.
#
sub rethumb_all($) {
  my ($border_p) = @_;

  foreach my $dir (sort { $b cmp $a } glob "flyers/*/*") {
    my %dotms;
    foreach (glob ("$dir/*")) {
      $dotms{$1} = 1 if (m@/(\d\d)-[^/]*$@i);
    }
    foreach my $dotm (sort keys (%dotms)) {
      my %names;
      foreach (glob ("$dir/$dotm-*")) {
        $names{$1} = 1 if (m@/\d\d-([^-.]+)[^/]*$@i);
      }
      foreach my $name (sort (keys %names)) {
        next if ("$dir/$dotm" eq "flyers/2001/07/14"); # die-cut redsquare
        next if ("$dir/$dotm" eq "flyers/2001/08/18"); # die-cut redsquare
        next if ("$dir/$dotm" eq "flyers/2001/09/15"); # die-cut redsquare
        next if ("$dir/$dotm" eq "flyers/2001/11/02"); # die-cut atomic
        next if ("$dir/$dotm" eq "flyers/2002/07/20"); # die-cut qool
        next if ("$dir/$dotm" eq "flyers/2002/08/10"); # die-cut thump
        next if ("$dir/$dotm" eq "flyers/2002/08/23"); # die-cut atomic
        next if ("$dir/$dotm" eq "flyers/2003/09/13"); # die-cut thump
        rethumb ($dir, $dotm, $name, $border_p);
      }
    }
  }
}


sub error($) {
  my ($err) = @_;
  print STDERR "$progname: $err\n";
  exit 1;
}

sub usage() {
  print STDERR "usage: $progname [--verbose] [--no-border] [--quality NN]\n" .
    "\t\t   [--rethumb] [--debug]\n" .
    "\t\t   dd-mmm-yyy name front.jpg [back.jpg]\n";
  exit 1;
}

sub main() {
  my ($date, $name, $front, $back, $border_p, $qual);

  $qual = 90;

  $verbose = 1;
  $border_p = 1;
  my $add_p = 0;
  my $rethumb_p = 0;

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif ($_ eq "--debug") { $debug_p++; }
    elsif ($_ eq "--rethumb") { $rethumb_p++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--no-border") { $border_p = 0; }
    elsif (m/^--?q(u(a(l(i(t(y)?)?)?)?)?)?$/) { $qual = shift(@ARGV); }
    elsif ($_ eq "-2" || $_ eq "--2")     { $add_p++; }
    elsif (m/^-./) { usage; }
    elsif (!defined($date))  { $date = $_; }
    elsif (!defined($name))  { $name = $_; }
    elsif (!defined($front)) { $front = $_; }
    elsif (!defined($back))  { $back = $_; }
    else { usage; }
  }

  if ($rethumb_p) {
    usage unless ($date);
    if ($date eq 'all') {
      return rethumb_all ($border_p);
    } else {
      return rethumb_date ($date, $border_p);
    }
  }

  usage unless ($date && $name && $front);
  usage unless ($name =~ m/^[-_a-z\d]+$/i);

  usage if ($name =~ m/^\d+$/s);
  usage if ($front =~ m/^\d+$/s);

  error ("you're in the wrong directory: no $flyer_dir/ subdir")
    unless -d $flyer_dir;

  my @files = flyerize ($date, $name, $border_p, $qual, $add_p, $front, $back);


  my ($dir, $dotm) = date_to_dir ($date);
  $dotm = sprintf("%02d", $dotm);

  $back = '' unless $back;

  $front = "'$front'" if ($front =~ m/[\s()\[\]]/);
  $back  = "'$back'"  if ($back  =~ m/[\s()\[\]]/);

  print STDOUT ("\n" .
                "Might I recommend:\n" .
                "\n" .
                "  make flyers cal\n" .
                "\n" .
                "  cvs add -kb " . join(" ", @files) .
                " ; cvs add $dir/$dotm-$name.html\n" .
                "\n" .
                "  rm $front $back\n" .
                "\n")
    unless ($debug_p);
}

main();
exit 0;