#!/usr/bin/perl -w
# Copyright © 2003-2011 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:  8-Feb-2003.

require 5;
use diagnostics;
use strict;
use Encode;
use bytes;

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

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

BEGIN { push @INC, "utils/"; }
use Menuify;

$ENV{PATH} .= ":/opt/local/bin";	# for cron


# These pictures have boobies in them.  Let's keep them off the front page.
my $excluded_file = "excluded.txt";
my %excluded;

my $rss_file = "calendar/dnalounge.rss";

my @all_images;			# list of .jpgs.

my %images_to_keywords;		# maps .jpg file names to metadata.
				# key: "YYYY/MM-DD/NNN.jpg"
				# val: \("event title", "performer" )

my %keywords_to_images;		# maps titles/performers to images.
				# key: "performer"
				# val: \("YYYY/MM-DD/NNN.jpg", ... )

my @upcoming_events;		# List of upcoming N events:
				# ( \( "YYYY-MM-DD", "title", "performer" ... )
				#    ... )


my @months = ("January", "February", "March", "April", "May", "June", "July",
              "August", "September", "October", "November", "December");
my @days   = ("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
              "Saturday");

# maps lower cased month names to numbers (1-12).
#
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
);


my %entity_table = (
   "apos"  => "'",
   "quot"   => '"', "amp"    => '&', "lt"     => '<', "gt"     => '>',
   "nbsp"   => ' ', "iexcl"  => '¡', "cent"   => '¢', "pound"  => '£',
   "curren" => '¤', "yen"    => '¥', "brvbar" => '¦', "sect"   => '§',
   "uml"    => '¨', "copy"   => '©', "ordf"   => 'ª', "laquo"  => '«',
   "not"    => '¬', "shy"    => '­', "reg"    => '®', "macr"   => '¯',
   "deg"    => '°', "plusmn" => '±', "sup2"   => '²', "sup3"   => '³',
   "acute"  => '´', "micro"  => 'µ', "para"   => '¶', "middot" => '·',
   "cedil"  => '¸', "sup1"   => '¹', "ordm"   => 'º', "raquo"  => '»',
   "frac14" => '¼', "frac12" => '½', "frac34" => '¾', "iquest" => '¿',
   "Agrave" => 'À', "Aacute" => 'Á', "Acirc"  => 'Â', "Atilde" => 'Ã',
   "Auml"   => 'Ä', "Aring"  => 'Å', "AElig"  => 'Æ', "Ccedil" => 'Ç',
   "Egrave" => 'È', "Eacute" => 'É', "Ecirc"  => 'Ê', "Euml"   => 'Ë',
   "Igrave" => 'Ì', "Iacute" => 'Í', "Icirc"  => 'Î', "Iuml"   => 'Ï',
   "ETH"    => 'Ð', "Ntilde" => 'Ñ', "Ograve" => 'Ò', "Oacute" => 'Ó',
   "Ocirc"  => 'Ô', "Otilde" => 'Õ', "Ouml"   => 'Ö', "times"  => '×',
   "Oslash" => 'Ø', "Ugrave" => 'Ù', "Uacute" => 'Ú', "Ucirc"  => 'Û',
   "Uuml"   => 'Ü', "Yacute" => 'Ý', "THORN"  => 'Þ', "szlig"  => 'ß',
   "agrave" => 'à', "aacute" => 'á', "acirc"  => 'â', "atilde" => 'ã',
   "auml"   => 'ä', "aring"  => 'å', "aelig"  => 'æ', "ccedil" => 'ç',
   "egrave" => 'è', "eacute" => 'é', "ecirc"  => 'ê', "euml"   => 'ë',
   "igrave" => 'ì', "iacute" => 'í', "icirc"  => 'î', "iuml"   => 'ï',
   "eth"    => 'ð', "ntilde" => 'ñ', "ograve" => 'ò', "oacute" => 'ó',
   "ocirc"  => 'ô', "otilde" => 'õ', "ouml"   => 'ö', "divide" => '÷',
   "oslash" => 'ø', "ugrave" => 'ù', "uacute" => 'ú', "ucirc"  => 'û',
   "uuml"   => 'ü', "yacute" => 'ý', "thorn"  => 'þ', "yuml"   => 'ÿ',

   # HTML 4 entities that do not have 1:1 Latin1 mappings.
   "bull"  => "*",   "hellip"=> "...",  "prime" => "'",  "Prime" => "\"",
   "frasl" => "/",   "trade" => "[tm]", "larr"  => "<-", "rarr"  => "->",
   "harr"  => "<->", "lArr"  => "<=",   "rArr"  => "=>", "hArr"  => "<=>",
   "empty" => "Ø",   "minus" => "-",    "lowast"=> "*",  "sim"   => "~",
   "cong"  => "=~",  "asymp" => "~",    "ne"    => "!=", "equiv" => "==",
   "le"    => "<=",  "ge"    => ">=",   "lang"  => "<",  "rang"  => ">",
   "loz"   => "<>",  "OElig" => "OE",   "oelig" => "oe", "Yuml"  => "Y",
   "circ"  => "^",   "tilde" => "~",    "ensp"  => " ",  "emsp"  => " ",
   "thinsp"=> " ",   "ndash" => "-",    "mdash" => "--", "lsquo" => "`",
   "rsquo" => "'",   "sbquo" => "'",    "ldquo" => "\"", "rdquo" => "\"",
   "bdquo" => "\"",  "lsaquo"=> "<",    "rsaquo"=> ">",
);


# Convert any HTML entities to Latin1 characters.
#
sub de_entify($) {
  my ($text) = @_;
  $text =~ s/(&([[:alpha:]]+);?)/
    {
     my $c = $entity_table{$2};
     print STDERR "$progname: warning: unknown HTML character entity \"$1\"\n"
     unless $c;
     ($c ? $c : "[$2]");
    }
   /gexi;
  return $text;
}


# Given a date, returns the day of the week on which it falls (0-6, sun-sat)
#
sub dotw($$$) {
  my ($dotm, $month, $year) = @_;

  # From the sci.math FAQ:
  #
  #  The following formula, which is for the Gregorian calendar only, may be
  #  more convenient for computer programming.  Note that in some programming
  #  languages the remainder operation can yield a negative result if given
  #  a negative operand, so "mod 7" may not translate to a simple remainder.
  #
  #      W == (k + [2.6m - 0.2] - 2C + Y + [Y/4] + [C/4]) mod 7
  #         where [] denotes the integer floor function (round down),
  #         k is day (1 to 31)
  #         m is month (1 = March, ..., 10 = December, 11 = Jan, 12 = Feb)
  #                       Treat Jan & Feb as months of the preceding year
  #         C is century (1987 has C = 19)
  #         Y is year    (1987 has Y = 87 except Y = 86 for Jan & Feb)
  #         W is week day (0 = Sunday, ..., 6 = Saturday)
  #
  #  Here the century & 400 year corrections are built into the formula.
  #  The [2.6m-0.2] term relates to the repetitive pattern that the 30-day
  #  months show when March is taken as the first month.

  my $k = $dotm;
  my $m = 1 + (($month + 9) % 12);    # (1-12) => (11, 12, 1-10)
  my $y = $year - ($m >= 11 ? 1 : 0); # subtract a year for jan/feb
  my $C = int ($y/100);
  my $Y = int ($y%100);
  my $W = (($k +
            int ((2.6 * $m) - 0.2)
            - (2 * $C)
            + $Y
            + int ($Y / 4)
            + int ($C / 4)
            + 7)
           % 7);
  return $W;
}


# Permutes the array (reference) in place.  "Fisher Yates Shuffle".
#
sub shuffle_array($) {
  my ($array) = @_;
  error ("no array") unless defined ($array);
  my $n = @$array;
  return if ($n <= 1);  # empty array
  for (my $i = $n; --$i;) {
    my $j = int rand ($i+1);
    next if ($i == $j);
    @$array[$i,$j] = @$array[$j,$i];
  }
}

# loads excluded.txt and populates %excluded.
#
sub load_excluded($) {
  my ($file) = @_;
  $file =~ s@//+@/@g;
  open (my $in, '<', $file) || error ("$file: $!");
  my $n = 0;
  while (<$in>) {
    s/\n$//;
    $excluded{$_} = 1;
    $n++;
  }
  close $in;
  print STDERR "$progname: read $file ($n entries)\n" if ($verbose);
}



# Populates @all_images with the contents of the gallery directory.
# Calls scan_image() on each image file.
#
sub scan_gallery($) {
  my ($gallery_dir) = @_;
  local *GDIR;
  opendir (GDIR, $gallery_dir) || error ("$gallery_dir: $!");
  foreach my $year (sort readdir (GDIR)) {
    next unless ($year =~ m/^\d{4}$/);
    local *YDIR;
    print STDERR "$progname: scanning $gallery_dir/$year/\n" if ($verbose);
    opendir (YDIR, "$gallery_dir/$year") || error ("$gallery_dir/$year: $!");
    foreach my $day (sort readdir (YDIR)) {
      next unless ($day =~ m/^\d\d-\d\d$/);
      if ($excluded{"$year/$day/"}) {
        print STDERR "$progname: excluding dir: $year/$day/\n"
          if ($verbose > 4);
        next;
      }
      print STDERR "$progname: scanning dir: $year/$day/\n" if ($verbose > 5);

      local *DDIR;
      opendir (DDIR, "$gallery_dir/$year/$day") || 
        error ("$gallery_dir/$year/$day: $!");
      foreach my $file (sort readdir (DDIR)) {
        next unless ($file =~ m/\.(gif|jpg)$/);
        next if ($file =~ m/thumb/);
        next if ($file =~ m/[a-z]\./);  # exclude "001b.jpg"
        $file = "$year/$day/$file";
        if ($excluded{$file}) {
          print STDERR "$progname: excluding: $file\n" if ($verbose > 4);
          next;
        }
        print STDERR "$progname:            $file\n" if ($verbose > 6);
        $file = "$gallery_dir/$file";
        push @all_images, $file;
        scan_image ($file);
      }
      closedir DDIR;
    }
    closedir YDIR;
  }
  closedir GDIR;
}


# Populates %images_to_keywords and %keywords_to_images with metadata
# corresponding to this image.
# 
sub scan_image($) {
  my ($jpg) = @_;
  my $html = $jpg;
  $html =~ s/\.[^.]+$/.html/;
  my $in;
  if (! open ($in, '<', $html)) {
    $html =~ s@/[^/.]+\.html$@/index.html@;
    error ("$html: $!")
      unless open ($in, '<', $html);
  }
  my $body = '';
  sysread ($in, $body, 512);  # read first N bytes of file
  close $in;
  my ($html_title) = ($body =~ m@<TITLE>(.*?)</TITLE>@si);
  error ("$html: no title") unless $html_title;
  $html_title =~ s/\s*:\s*\d+(\.[^.]+)?\s*$//;
  $html_title =~ s/^DNA Lounge:\s*//i;
  $html_title =~ s/, \d\d? [A-Z][a-z][a-z] \d{4}$//;  # lose date

  my @val = ();

  if ($html_title =~ m@^(.*?)\s*[:+]\s+(.*)$@si) {
    push @val, $1;
    $html_title = $2;
  } else {
    push @val, $html_title;
    $html_title = '';
  }

  push @val, split (m@\s*[:&+/]\s+@, $html_title);

  $images_to_keywords{$jpg} = \@val;

  foreach my $kwd (@val) {
    my $listP = $keywords_to_images{lc($kwd)};
    my @list = (defined ($listP) ? @$listP : ());
    push @list, $jpg;
    $keywords_to_images{lc($kwd)} = \@list;
  }
}


sub print_tables() {
  my @keys = keys %keywords_to_images;
  if ($verbose) {
    print STDERR "$progname: total images:   " . ($#all_images+1) . "\n";
    print STDERR "$progname: total keywords: " . ($#keys+1) . "\n";
  }
  if ($verbose > 3) {
    print STDERR "\n$progname: keywords:\n\n";
    foreach my $key (sort @keys) {
      my @imgs = @{$keywords_to_images{lc($key)}};
      print STDERR sprintf ("  %-55s %4d images\n", "$key:", $#imgs+1);
    }
  }
}


# Populates @upcoming_events based on the RSS file.
#
sub scan_upcoming_events() {
  error ("$rss_file: $!") unless open (my $in, '<', $rss_file);
  local $/ = undef;  # read entire file
  my $body = <$in>;
  close $in;
  print STDERR "$progname: read $rss_file\n" if ($verbose);

  $body =~ s/\s+/ /gsi;
  $body =~ s/(<item>)/\n$1/gsi;

  my @now = localtime;
  my $now = sprintf("%04d%02d%02d", $now[5]+1900, $now[4]+1, $now[3]);

  my $i = 0;
  foreach (split (/\n/, $body)) {
    my ($event) = m@<item>(.*?)</item>@si;
    next unless $event;

    # skip this event if it is in the past
    my ($date) = ($event =~ m@<dnalounge:date>([^<>]*)</@s);
    error ("no date?") unless defined ($date);
    my ($dd, $mmm, $yyyy, $dotm) =
      ($date =~ m@^(\d+)[- ]([a-z]+)[- ](\d+) \(([a-z]+)\)$@i);
    $mmm = $monthvals{lc($mmm)};
    $date = sprintf("%04d%02d%02d", $yyyy, $mmm, $dd);
    next if ($date < $now);

    $event =~ s/\s+/ /gsi;
    $event =~ s/(<[a-z])/\n$1/gsi;
    my @titles = ();
    push @titles, sprintf("%04d-%02d-%02d", $yyyy, $mmm, $dd);
    foreach (split (/\n/, $event)) {
      next unless m@^<(dnalounge:(title|dj|band|performer))[^<>]*>(.*?)</\1>@si;
      my $name = $3;
      $name =~ s/: .*$//s;  # Lose subtitle on event name

      # Don't put up e.g. two Booties if they have slightly different names.
      $name =~ s/^(bootie|meat|death guild)\b.*/$1/si;

      push @titles, $name;
    }
    push @upcoming_events, \@titles;
  }
}


my %image_size_cache = ();

sub image_size($) {
  my ($file) = @_;

  my $cache = $image_size_cache{$file};
  return @{$cache} if $cache;

  error ("$file does not exist") unless -f $file;
  return (0, 0) unless -f $file;
  my $cmd = ("identify -define jpeg:size=1x1 -format '%[width]x%[height]'" .
             " '$file'");
  print STDERR "$progname: executing: $cmd\n" if ($verbose > 7);
  my $result = `$cmd`;
  print STDERR "$progname:   ==> $result\n" if ($verbose > 7);
  my ($w, $h) = ($result =~ m/^(\d+)x(\d+)$/);
  error ("no size: $file") unless ($w && $h);

  my @c = ($w, $h);
  $image_size_cache{$file} = \@c;

  return ($w, $h);
}


sub safe_system_retry($) {
  my ($cmd) = @_;

  # WTF.  Sometimes 'convert' hangs, but running again with same args works.
  # Make the sh subprocess bail if it took more than N CPU-seconds, and retry
  # up to N times.

  my $count = 0;
  my $max = 4;
  my $cpu_secs = 10;

  $cmd = "ulimit -t $cpu_secs; $cmd";

  while (1) {
    print STDERR "$progname: executing: $cmd\n" if ($verbose > 1);
    #  system ("/bin/sh", "-c", $cmd);
    system ("$cmd");
    my $exit_value  = $? >> 8;
    my $signal_num  = $? & 127;
    my $dumped_core = $? & 128;

    last if (! ($dumped_core || $signal_num || $exit_value));

    $count++;
    my $e = ("$cmd: " .
             ($dumped_core ? "core dumped" :
              $signal_num  ? "signal $signal_num" :
              "exited with $exit_value"));
    if ($count > $max) {
      error ("$e (after $count tries)");
    } else {
      print STDERR "$progname: $e (retrying)\n";
    }
  }

  print STDERR "$progname: success.\n" if ($count > 0);
}



# Creates a W x H thumbnail jpeg of the given file in the given directory.
# 
sub make_thumbnail($$$$$$$$) {
  my ($dir, $file, $count, $ow, $oh, $cw, $ch, $caption) = @_;

  my $thumb = "thumb" . ($count + 1) . ".jpg";
  my $tmp = "$dir/$thumb.tmp";
  my $cmd;

  my $bd2 = 3;
  my $ow2 = $ow * 2;
  my $oh2 = $oh * 2;
  my $cw2 = $cw * 2 - $bd2*2;
  my $ch2 = $ch * 2 - $bd2*2;
  my $cw4 = $cw * 4;
  my $ch4 = $ch * 4;
  my $ps  = 14  * 2;

  my $cbd = 8;
  my $cw3 = $cw2 - $cbd*2;

# my $f   = "Helvetica-Bold";	# on MacOS 10.5.1, this worked.
# my $f   = "HelveticaBold";	# on MacOS 10.5.2, this works, with warning.
  my $f   = "Helvetica Bold";	# on MacOS 10.5.4, with "caption:", this
				# works.  Because not using GhostScript now?
  my $fg   = "#0DF";
  my $bg   = "#0000";		# Goes opaque if both background color and
  my $cbdc = "#0004";		#  border color have non-zero alpha!
  my $bdc  = "#0F0";


  $caption = de_entify($caption);
  $caption =~ s@\\([\"\'])@$1@gs;
  $caption =~ s/([\"])/\\$1/gs;
  $caption =~ s@: @\\n@gsi;
  $caption =~ s@\n@\\n@gi;
  $caption = encode_utf8($caption);    # ImageMagick pukes on Latin1 now.

  # The "caption" option does line-wrapped text.  It makes a canvas of
  # the given width and sufficient height, which can then be composited
  # onto another image.  However, there's no option for adding some
  # padding around the text: we have to use -border to do that.  But
  # the -border command modifies all currently-loaded images, so we
  # have to do the text first, then set -border 0, then load the image.
  #
  # I wasn't able to figure out how to have one block of text at the top,
  # and one block of text at the bottom, and have them both have a border.
  # ImageMagick has defeated me on this.  So, only one block of text now.
  # 
  $cmd = ("convert " .
          ($caption
           ? ("-font \"$f\" " .
              "-pointsize $ps " .
              "-background \"$bg\" " .
              "-bordercolor \"$cbdc\" " .
              "-fill \"$fg\" " .
            # "-compose copy " .
              "-border $cbd " .
              "-size ${cw3}x " .
              "-gravity southeast " .
              "caption:\"$caption\" " .
              "-border 0 ")
           : "") .

          "'(' " .
          "-define jpeg:size=${cw4}x${ch4} " .	# speed up jpeg load
          "$file " .
          "-thumbnail ${cw2}x${ch2}\\^ " .	# min w/h, preserve aspect
          "-gravity north " .
          "-extent ${cw2}x${ch2} " .		# center crop
          "')' " .

          ($caption
           ? ("+swap " .
              "-gravity south " .
              "-composite ")
           : "") .
          "-bordercolor \"$bdc\" " .
          "-border $bd2 " .
          "-resize ${cw}x${ch} " .
          "-quality 90 " .
          "-strip " .
          "$tmp");

  if ($debug_p) {
    if ($verbose > 1) {
      print STDERR "$progname: debug: not executing: $cmd\n";
    } else {
      my $c = $caption;
      $c =~ s/\n/; /gs;
      print STDERR "$progname: debug: not creating $thumb ${cw}x${ch} ($c)\n";
    }
    return $thumb;
  }

#  # I'm sick of seeing "convert: unable to read font `HelveticaBold'."
#  $cmd .= " 2>/dev/null" unless ($verbose > 1);

  safe_system_retry ($cmd);

  if ($verbose) {
    my $c = $caption;
    $c =~ s/\n/; /gs;
    print STDERR sprintf ("$progname: wrote $thumb (%3d x %3d)" .
                          " for $file ($c)\n",
                          $cw, $ch)
  }
  return ($thumb, $tmp);
}


sub pick_random_image() {
  return $all_images [int (rand ($#all_images+1))];
}


# Returns a random image that contains any of the given keywords.
#
sub pick_random_image_by_keywords(@) {
  my @kwds = @_;

  # Instead of picking a random keyword and then picking a random image,
  # gather up all images for the keywords and then pick one.  That gives
  # a wider range of results in the case where one keyword has a small
  # number of images and another keyword has a large number.

  print STDERR "$progname: searching keywords: \"" . 
               join('" "', @kwds) . "\"\n"
      if ($verbose > 2);
  my @all = ();
  my %dups;
  my $total = 0;
  foreach my $kwd (@kwds) {
    my $listP = $keywords_to_images{lc($kwd)};
    next unless ($listP);
    my @list = @$listP;
    print STDERR "$progname:   $kwd: " . ($#list+1) . "\n" if ($verbose > 2);
    foreach my $img (@list) {
      $total++;
      push @all, $img unless ($dups{$img});
      $dups{$img} = 1;
    }
  }
  print STDERR "$progname: total: $total; unique: " . ($#all+1) . "\n"
    if ($verbose > 2);

  if ($#all >= 0 && $#all < 10) {
    print STDERR "$progname: that's too few; skipping.\n" if ($verbose > 2);
    # If we only have N shots related to any performers at an upcoming event,
    # don't use any.  Better to skip it than to have the same three pictures
    # there every day for a week.
    @all = ();
  }

  print STDERR "\n" if ($verbose > 2);

  return $all [int (rand ($#all+1))];
}


# Convert "YYYY-MM-DD" to either "DOTW, MMM DD" or "MMM YYYY".
#
sub format_date($$) {
  my ($d, $upcoming_p) = @_;
  my ($yyyy, $mm, $dd) = ($d =~ m@^(\d{4})-(\d\d)-(\d\d)$@);
  error ("unparsable date: $d") unless $yyyy;
  my $mmm = $months[$mm-1];
  $mmm =~ s/^(...).*$/$1/s;

  if ($upcoming_p) {
    my $dotw = dotw ($dd, $mm, $yyyy);
    $dotw = $days[$dotw];
    $dotw =~ s/^(...).*$/$1/s;
    return "$dotw, $mmm $dd";
  } else {
    return "$mmm $yyyy";
  }
}

# Returns the caption that should be used for this image.
#
# If any of this image's keywords are present in an upcoming event,
# then the caption will be
#
#     "Next UPCOMING-EVENT-NAME \n DOTW, MMM DD".
#
# or
#
#     "PERFORMER \n Next UPCOMING-EVENT-NAME \n DOTW, MMM DD".
#
# Otherwise, it will be
#
#     "MMM YYYY \n PAST-EVENT-NAME \n PERFORMER ...etc..."
#
# Note that UPCOMING-EVENT-NAME and PAST-EVENT-NAME may differ.
#
# It's returned in two forms: ( "full caption", "event title only" )
#
#
# Here's why this is hard:
#
#  - We have an upcoming event called "Pop Roxx" with band "IO Echo".
#  - We have an image titled, "Pop Roxx: Rocket".
#  - We want to caption that image, "Next Pop Roxx: MM-DD-YYYY".
#  - We do not want to caption it "Next Rocket", because Rocket isn't playing.
#  - WHAT WE DO: Caption it "Next Pop Roxx".
#
# BUT!
#
#  - We have an upcoming event called "Bootie" with band "Rocket".
#  - We have an image titled, "Pop Roxx: Rocket".
#  - We want to caption that image, "Next Rocket: MM-DD-YYYY".
#  - We do not want to caption it "Next Pop Roxx", because it's not.
#  - We could caption it, "Next Bootie: MM-DD-YYYY", but "Rocket" is better.
#  - WHAT WE DO: Caption it "Next Bootie".
#
# Also:
#
#  - We have an upcoming "Jill Tracy" event, with "The Indra" performing.
#  - We have an image titled "Hubba Hubba Revue: The Indra".
#  - Do we caption that image "Next Jill Tracy"?  But it's a picture of Indra.
#  - Do we caption that image "Next The Indra"?  But nobody cares about that,
#    she's a minor part of the show, not an opening band.
#  - WHAT WE DO: Caption it "Next Jill Tracy".
#
#
# Bad:
#
#  - Upcoming "Gorgeous Frankenstein" show, with "Bella Morte" opening.
#  - We have a photo titled "Bella Morte".
#  - What we should do: Caption it "Next Bella Morte".
#  - WHAT WE DO: Caption it "Next Gorgeous Frankenstein".  Auugh!
#
#  - Upcoming "Bohemian Carnival" event.
#  - We have a photo titled "Bohemian Carnival: Luxxury".
#  - What we should do: Caption it "Next Bohemian Carnival".
#  - WHAT WE DO: Caption it "Luxxury\n Next Bohemian Carnival".
#    But Luxxury is not playing at the next Bohemian Carnival.
#
#
sub image_caption($) {
  my ($img) = @_;
  my @kwds = @{$images_to_keywords{$img}};
  my %kwds;
  my $title = $kwds[0];
  foreach my $k (@kwds) {
    $kwds{lc($k)} = 1;
  }

  my $upcoming = 0;
  foreach my $evP (@upcoming_events) {
    my @ev = @$evP;
    my $date = shift @ev;
    foreach my $k (@ev) {
      if (!$upcoming && $kwds{lc($k)}) {
        $upcoming = $date;
        $title = $ev[0];    # use title of upcoming event, not past event
      }
    }
  }

  $title =~ s/:\s+.*$//si;  # lose sub-titles after colon
  my $title2;
  if ($upcoming) {
    my $date = format_date ($upcoming, 1);
    $title2 = "Next $title\n$date";
    my $performer = $kwds[1];
    $title2 = "$performer\n$title2" 
      if ($performer && $performer ne $title);
  } else {
    my ($yyyy, $mm, $dd) = ($img =~ m@/(\d{4})/(\d\d)-(\d\d)/@);
    my $date = format_date ("$yyyy-$mm-$dd", 0);
    $title2 = join ("\n", ($date, @kwds));
  }

  $title2 =~ s/^(Next )The /$1/gsi;

  return ($title2, $title);
}


# Picks some images and returns a list of them.
# There will never be two images from the same directory.
# There will never be two images with the same event name.
# Returned list is ( \( jpg caption ) ... )
#
sub pick_images($$$$$) {
  my ($n, $max_upcoming, $dirs_used, $titles_used, $prev_imgs_used) = @_;

  my %titles_used_this_line;

  print STDERR "\n" if ($verbose);

  my @result = ();
  my $upcoming_event_count = 0;

  my @upcoming_events_2 = @upcoming_events;  # modify copy of list

  # We can loop if the only pictures available for event N have the same
  # keywords as event N-1, so they get found and excluded repeatedly.
  # If we are looping, we just skip that second event.
  #
  my $looping = 0;

  while ($#result < $n-1) {
    $looping++;
    my $i = $#result + 2;
    my ($img, $caption, $title);
    my $upcoming = 0;

    if ($upcoming_event_count < $max_upcoming) {
      my $kwds = $upcoming_events_2[0];
      if (! $kwds) {
        # ran out of upcoming events!
        $max_upcoming = 0;
        print STDERR "$progname: $i: ran out of upcoming events\n" 
          if ($verbose);
      } else {
        my @kwds = @$kwds;
        shift @kwds;  # remove date

        # Pick a random image related to this event.
        # The image qualifies if it matches any of the keywords of this event:
        # That is, if it is from an event with the same name as this one; or
        # if it is from a different event, but has a performer who is also a 
        # part of this event.
        #
        $img = pick_random_image_by_keywords (@kwds);
        $upcoming = $kwds[0];

        if (! $img || $looping >= 100) {
          shift @upcoming_events_2;  # no images for this event, or looping
          $looping = 0;
        }
      }

    } else {
      $img = pick_random_image();
    }

    ($caption, $title) = image_caption ($img) if ($img);

    print STDERR "$progname: $i: " .
                 ($img
                  ? ("picked $img" .
                     ($upcoming && $title eq $upcoming ? "" : " (\"$title\")"))
                  : "no images") .
                 ($upcoming ? " for \"$upcoming\"" : "") . "\n"
      if ($verbose);

    next unless $img;

    my ($dir) = ($img =~ m@^(.*)/[^/]*@si);

    # Do not include an image if there's another image from the same directory.
    #
    if ($dirs_used->{$dir}) {
      print STDERR "$progname: $i: skipped dup: $dir/\n" if ($verbose);
      next;
    }

    # Do not include an image if there's another image with the same event name.
    #
    if ($titles_used->{$title}) {
      print STDERR "$progname: $i: skipped dup: \"$title\"\n" if ($verbose);
      next;
    }

    # Do not include an image if this image was used on a previous frame.
    #
    if ($prev_imgs_used->{$img}) {
      print STDERR "$progname: $i: skipped dup2: $img \"$title\"\n"
        if ($verbose);
      next;
    }

    # Do not include an image if the same event name is on this line.
    #
    if ($titles_used_this_line{$title}) {
      print STDERR "$progname:f $i: skipped dup3: \"$title\"\n" if ($verbose);
      shift @upcoming_events_2;
      next;
    }
    $titles_used_this_line{$title} = 1;

    # Do not include an image if it is of an upcoming event *accidentally*.
    # That is: we select 3 "upcoming" images and 3 "other" images.  Don't
    # let any of the "other" images also be for upcoming events.
    # (Maybe this is not a good idea...)
    #
    if (!$upcoming && $caption =~ m/^Next /m) {
      print STDERR "$progname: $i: skipped extra upcoming: \"$title\"\n"
        if ($verbose);
      next;
    }

    if ($upcoming) {
      $upcoming_event_count++;
      shift @upcoming_events_2;    # this event is taken care of.
    }

    my @r = ($img, $title, $caption);
    push @result, \@r;
    $looping = 0;
  }

  return @result;
}


# Picks some images and computes the sizes to which they should be scaled.
# Returns an list of array refs containing the rows/columns/sizes/titles, etc.
# max_upcoming: how many "upcoming" events to use in this row.
# dirs_used, titles_used: table refs for avoiding duplicates.
# forced_images: override randomization and use these instead.
#
sub layout_row($$$$$$$) {
  my ($columns, $max_upcoming, $line_width, 
      $dirs_used, $titles_used, $prev_imgs_used, $forced_imgs) = @_;

  my @row = ();
  my @files = ();

  if (! $forced_imgs) {
    @files = pick_images ($columns, $max_upcoming, $dirs_used, $titles_used,
                          $prev_imgs_used);
  } else {
    print STDERR "$progname: forcing images:\n" if ($verbose);
    for (my $i = 0; $i < $columns; $i++) {
      my $img = shift @$forced_imgs;
      my ($caption, $title) = image_caption($img);
      print STDERR "$progname:   $img ($title)\n" if ($verbose);

      my @L = ($img, $title, $caption);
      push @files, \@L;
    }
  }

  for (my $j = 0; $j < $columns; $j++) {
    my $L = shift @files;
    my ($file, $title, $caption) = @$L;

    $file =~ s@^\./@@;        # lose leading ./

    my $href = $file;         # link to the image page
    $href =~ s@\.(jpg|gif)$@.html@ || error ("bad picture: $file");

    my ($ow, $oh) = image_size ($file);
    my @img = ($href, $file, $title, $caption, $ow, $oh, undef, undef);
    push @row, \@img;
  }

  # To ensure the rows are always the same width and height, we crop
  # the thumbnails.  Most of the images in the gallery are 6x4, but
  # we can't produce a consistent layout with that.  So given that we
  # have exactly three images per row, and we constraint them so that
  # they are not all portrait or landscape, that means we only have
  # two layouts: LLP or LPP (in any order).  Some experimentation
  # shows that a good looking pair of layouts is:
  #
  #   [6x4 landscape] [4x5 portrait]  [4x5 portrait]  and
  #   [5x4 landscape] [5x4 landscape] [4x6 portrait]
  #
  # which is approximately:
  #
  #   [48% x 32%] [26% x 32%] [26% x 32%]  and
  #   [39% x 32%] [39% x 32%] [22% x 32%]
  #

  my $portrait_count  = 0;
  my $landscape_count = 0;
  foreach my $imgP (@row) {
    my ($href, $file, $title, $caption, $ow, $oh, $cw, $ch) = @$imgP;
    if ($ow < $oh) {
      $portrait_count++;
    } else {
      $landscape_count++;
    }
  }

  # Bail if all portrait or all landscape.
  #
  if ($portrait_count == 0 || $landscape_count == 0) {
    print STDERR "$progname: oops, got $columns " .
                 ($portrait_count ? "portrait" : "landscape") .
                 " images in one row\n"
      if ($verbose);
    return ();
  }

  error ("more than 3 photos on the line") 
    unless ($portrait_count + $landscape_count == 3);

  my ($target_wl, $target_wp);
  my $target_h = 0.32;
  if ($portrait_count == 2) {
    $target_wl = 0.48;	# 48% x 32%  x 1
    $target_wp = 0.26;	# 26% x 32%  x 2
  } else {
    $target_wl = 0.39;	# 39% x 32%  x 2
    $target_wp = 0.22;	# 22% x 32%  x 1
  }

  # Decide the aspect ratio to which we want to crop the image;
  # decide on the size to which we want to scale that.
  #
  foreach my $imgP (@row) {
    my @img = @$imgP;
    my ($href, $file, $title, $caption, $ow, $oh, $cw, $ch) = @img;
    $img[6] = int ($line_width * ($ow < $oh ? $target_wp : $target_wl) + 0.5);
    $img[7] = int ($line_width * $target_h + 0.5);

    my ($dir) = ($file =~ m@^(.*)/[^/]*@si);
    $dirs_used->{$dir} = 1;
    $titles_used->{$title} = 1;
    $prev_imgs_used->{$file} = 1;

    $imgP = \@img;
  }

  return @row;
}


# Converts the list of array-refs of image data to HTML for a single row.
# Creates the necessary thumbnail JPG files.  Returns HTML.
#
sub format_row($$$$$@) {
  my ($dir, $thumb_number, $row, $line_width, $output_files, @imgs) = @_;

  my $output = "";

  my $column = 0;
  $output .= "<DIV CLASS=\"snaps\">\n";
  my $imgs_in_row = $#imgs + 1;
  foreach my $imgP (@imgs) {
    my ($href, $file, $title, $caption, $ow, $oh, $cw, $ch) = @$imgP;

    $caption =~ s/\"/&quot;/g;
    $caption =~ s/\'/&apos;/g;

    my $tmp;
    ($file, $tmp) = make_thumbnail ($dir, $file, $thumb_number,
                                    $ow, $oh, $cw, $ch, $caption);
    $output_files->{"$dir/$file"} = $tmp;

    $href =~ s@^$dir/@@;

    # to prevent web browsers from mis-cacheing (e.g., refreshing
    # the HTML page but not re-pulling the images) attach a "?" search
    # term to each image.  The server will ignore that, but it will
    # cause a cache miss if the HTML and pictures are out of sync.
    #
    $file .= "?${cw}x${ch},$href";
    $file =~ s@\.html$@@;
    $file .= ".jpg";

    # If there's no HTML-wrapper file for this image, point at the
    # directory index instead (this happens for thumbless galleries.)
    $href =~ s@/[^/]*$@/@ unless (-f "$dir/$href");

    $output .= "<A\n  HREF=\"$href\">";

    # Top and left padding.  No top padding on first row, 
    # no left padding on first column.
    my $hs = 8;
    my $vs = 8;
    my $vspct = sprintf ("%.4f", 100 * $vs / ($line_width + 0.5));
    my $hspct = sprintf ("%.4f", 100 * $hs / ($line_width + 0.5));
    $vspct =~ s/\.?0+$//s;
    $hspct =~ s/\.?0+$//s;
    $vspct = 0 if ($row == 0);
    $hspct = 0 if ($column == 0);

    my $wpct = sprintf ("%.4f", 100 * $cw / 
                        ($line_width + ($hs * ($imgs_in_row - 1)) + 0.5));
    $wpct =~ s/\.?0+$//s;

    $vspct .= '%' if $vspct;
    $hspct .= '%' if $hspct;
    $output .= ("<IMG SRC=\"$file\" STYLE=\"" .
                 "width:${wpct}%;" .
                " height:auto;" .
                " max-width:${cw}px;" .
                " max-height:${ch}px;" .
                " margin:${vspct} 0 0 ${hspct}" .
                "\">" .
                "</A>");
    $column++;
    $thumb_number++;
  }
  $output .= "\n</DIV>\n";
  return $output;
}




# Pick some images and generate HTML for them.
# Generate $frames iterations of each line, for animation.
#
sub generate_html($$$@) {
  my ($dir, $frames, $output_files, @force) = @_;

  my $rows = 2;
  my $columns = 3;
  my $line_width =  800;

  my $thumb_number = 0;
  my @frames = ();
  my %prev_imgs_used;
  for (my $frame = 0; $frame < $frames; $frame++) {

    my @rows = ();
    my %dirs_used;
    my %titles_used;
    my $loop = 0;
    my $max_upcoming = $columns;  # first row is all upcoming.

    for (my $i = 0; $i < $rows; $i++) {

      print STDERR "\n" if ($verbose > 2);

      my @row = ();
      while ($#row < 0) {
        @row = layout_row ($columns, $max_upcoming, $line_width,
                           \%dirs_used, \%titles_used, \%prev_imgs_used,
                           (($#force >= 0) ? \@force : undef));
        error ("we seem to be looping!") if ($loop++ > 20);
      }
      $max_upcoming -= $#row+1;
      my $html = format_row ($dir, $thumb_number, $i, $line_width, 
                             $output_files, @row);
      $thumb_number += $columns;
      push @rows, $html;

      print STDERR "\n" if ($verbose);
    }

    push @frames, \@rows;
  }

  my $html = '';

  # Interleave the lines: if we generated 3 frames ABC, lay out the lines
  # as 1A 1B 1C 2A 2B 2C.  Also give them IDs.
  #
  for (my $row = 0; $row < $rows; $row++) {
    my $framen = 0;
    $html .= "<DIV ID=\"snaps_${row}\">\n";
    foreach my $frame (@frames) {
      my @f = @$frame;
      my $line = shift @f;
      $frame = \@f;
      my $id = "snaps_${row}_${framen}";
      my $hide = ($framen > 0 ? " STYLE=\"display:none\"" : "");
      ($line =~ s/^(<DIV\b[^<>]*)>/$1 ID="$id"$hide>/si) ||
        error ("unable to add ID to $line");
      $html .= $line;
      $framen++;
    }
    $html .= "</DIV>\n";
  }

  return $html;
}



# Picks some images and generates the "snapshots.html" file.
#
sub generate_page($@) {
  my ($dir, @force) = @_;

  $dir =~ s@/+$@@;
  my $outfile = "$dir/snapshots.html";

  # Create all files with .tmp extension and gather them here.
  # Then rename them all into place at once, to minimize racing.
  my %output_files;

  load_excluded ("$dir/$excluded_file");
  scan_gallery($dir);
  scan_upcoming_events();
  print_tables();

  my $frames = 3;
  my $output = ("<BODY>\n" .
                "<P ALIGN=CENTER>\n\n" .
                "<!-- %%RIGHT_START%% -->\n" .
                "<!-- %%SNAPSHOTS_START%% -->\n" .
                generate_html ($dir, $frames, \%output_files, @force) .
                "<!-- %%SNAPSHOTS_END%% -->\n" .
                "<!-- %%RIGHT_END%% -->\n" .
                "</BODY>\n");

  # Write "snapshots.html" now, since we need that to generate index.html.
  #
  if (!$debug_p) {
    my $tmp = "$outfile.tmp";
    open (my $out, '>', $tmp) || error ("$tmp: $!");
    print $out $output;
    close $out;
    rename ($tmp, $outfile) || error ("mv $tmp $outfile: $!");
    print STDERR "$progname: wrote $outfile\n" if ($verbose);
  }

  # Generate a new index.html based on the new snapshots.html,
  # then add that to the list of files to rename/install.
  #
  my $front           = "index.html";
  my $front_template  = "index-template.html";
  my $front_tmp       = "index.html.tmp";
  my @cmd = ("utils/splice-frontpage.pl", $front_template, $front_tmp);
  push @cmd, ("-" . ("v" x $verbose)) if $verbose;
  push @cmd, "--debug" if ($debug_p);
  print STDERR "$progname: executing " . join(' ', @cmd) . "\n" 
    if ($verbose > 1);
  system @cmd;
  $output_files{$front} = $front_tmp;

  # Similarly for Facebook.
  #
  $front     = "facebook/index.fbml";
  $front_tmp = "$front.tmp";
  @cmd = ("facebook/build-index.pl", "facebook/", $front_tmp);
  push @cmd, ("-" . ("v" x $verbose)) if $verbose;
  push @cmd, "--debug" if ($debug_p);
  print STDERR "$progname: executing " . join(' ', @cmd) . "\n" 
    if ($verbose > 1);
  system @cmd;
  $output_files{$front} = $front_tmp;

  # I wish there was some way to do this atomically...
  #
  foreach my $file (sort keys (%output_files)) {
    my $tmp = $output_files{$file};
    if ($debug_p) {  # don't bother running "diff"
      print STDERR "$progname: debug: not writing $file\n";
      unlink $tmp if defined($tmp);
    } else {
      rename ($tmp, $file) || error ("mv $tmp $file: $!");
      print STDERR "$progname: mv $tmp $file\n" if ($verbose);
    }
  }
}


# Returns the list of images currently in use on snapshots.html.
#
sub current_images($) {
  my ($dir) = @_;
  $dir =~ s@/+$@@;

  my $file = "$dir/snapshots.html";
  open (my $in, '<', $file) || error ("$file: $!");
  local $/ = undef;  # read entire file
  my $body = <$in>;
  close $in;
  
  my @imgs = ();
  while ($body =~ m/\G.*?<IMG\s+SRC=\"[^<>\"?]*\?([^<>\"]+)\"/gsi) {
    my $img = $1;
    $img =~ s/^[\d.]+x[\d.]+,//s;
    push @imgs, "$dir/$img";
  }
  my $n = $#imgs+1;
  error ("$file unparsable") unless ($n > 0 && ($n % 6) == 0);
  return @imgs;
}


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

sub usage() {
  print STDERR "usage: $progname [--verbose] [--debug] gallery-dir\n";
  print STDERR "\t\t\t      [--force [which six images]]\n";
  exit 1;
}

sub main() {

  my @force = ();
  srand(time ^ $$);

  my $dir;

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if    (m/^--?verbose$/s)           { $verbose++; }
    elsif (m/^-v+$/)                   { $verbose += length($_)-1; }
    elsif (m/^--?debug$/s)             { $debug_p++; }
    elsif (m/^--?force$/s)             {
      if (!defined ($ARGV[0]) || $ARGV[0] =~ m/^-/) {
        @force = ('');
      } else {
        for (my $i = 0; $i < 6; $i++) {
          my $f = shift @ARGV;
          error ("--force requires six files (only got " . ($i+1) . ")")
            unless defined ($f);
          error ("file does not exist: $f") unless (-f $f);
          $f =~ s@\.html$@\.jpg@;
          error ("file does not exist: $f") unless (-f $f);
          push @force, $f;
        }
      }
    }
    elsif (m/^-./)                     { usage; }
    elsif (!defined($dir))             { $dir = $_; }
    else                               { usage; }
  }

  usage unless $dir;
  $dir =~ s@/+$@@;

  # When writing files, make permissions match the parent directory
  # by computing a umask from the directory's permissions.
  #
  umask (~((stat($dir))[2] & 0666) & 0666);

  @force = current_images($dir) if ($#force == 0);

  $DNA::Menuify::verbose = $verbose;
  $DNA::Menuify::debug   = $debug_p;

  generate_page ($dir, @force);
}

main();
exit 0;