#!/usr/bin/perl -w
# Copyright © 2003-2008 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 bytes;

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

my $verbose = 0;
my $debug = 0;

$ENV{PATH} .= ":/Users/jwz/bin:/opt/local/bin:/sw/bin";


# 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 %imgs_to_titles;   # maps jpegs to <title> from the corresponding html file
my %titles_to_imgs;   # maps bands/events to jpegs, according to <title>
my %imgs_to_upcoming; # maps jpegs to the date of the upcoming *next* event

my @upcoming_event_photos = ();
my @upcoming_event_keywords = ();


my @months = ("January", "February", "March", "April", "May", "June", "July",
              "August", "September", "October", "November", "December");

# 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 = (
   "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"   => 'ÿ',
   "ndash"  => '-', "mdash"  => "--", "apos"  => "'"
);


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


sub cmp_files($$) {
  my ($file1, $file2) = @_;

  my @cmd = ("cmp", "-s", "$file1", "$file2");
  print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 3);

  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);
  return $exit_value;
}


sub diff_files($$) {
  my ($file1, $file2) = @_;

  my @cmd = ("diff", "-Nu2", "$file1", "$file2");
  print "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 1);

  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);
  return $exit_value;
}


# If the two files differ:
#   mv file2 file1
# else
#   rm file2
#
sub rename_or_delete($$) {
  my ($file, $file_tmp) = @_;

  my $changed_p = cmp_files ($file, $file_tmp);

  if ($changed_p && $debug) {
    print STDOUT "\n" . ('#' x 79) . "\n";
    diff_files ("$file", "$file_tmp");
    $changed_p = 0;
  }

  if ($changed_p) {

    if (!rename ("$file_tmp", "$file")) {
      unlink "$file_tmp";
      error ("mv $file_tmp $file: $!");
    }
    print STDERR "$progname: wrote $file\n" if ($verbose);

  } else {
    unlink "$file_tmp" || error ("rm $file_tmp: $!\n");
    print STDERR "$progname: $file unchanged\n" if ($verbose > 1);
    print STDERR "$progname: rm $file_tmp\n" if ($verbose > 2);
  }
}


# Returns a list of all images under the given directory.
# Assumes the form "DIR/YYYY/MM-DD/*.(gif|jpg)"
#
sub get_image_files($) {
  my ($gallery_dir) = @_;
  my @all = ();
  local *GDIR;
  opendir (GDIR, $gallery_dir) || error ("$gallery_dir: $!");
  foreach my $year (readdir (GDIR)) {
    next unless ($year =~ m/^\d{4}$/);
    $year = "$gallery_dir/$year";
    local *YDIR;
    opendir (YDIR, $year) || error ("$year: $!");
    foreach my $day (readdir (YDIR)) {
      next unless ($day =~ m/^\d\d-\d\d$/);
      $day = "$year/$day";
      local *DDIR;
      opendir (DDIR, $day) || error ("$day: $!");
      foreach my $file (readdir (DDIR)) {
        next unless ($file =~ m/\.(gif|jpg)$/);
        next if ($file =~ m/thumb/);
        next if ($file =~ m/[a-z]\./);  # exclude "001b.jpg"
        $file = "$day/$file";
        push @all, $file;
        snarf_title ($file);
      }
      closedir DDIR;
    }
    closedir YDIR;
  }
  closedir GDIR;
  return @all;
}


# Populates the $titles_to_imgs and $imgs_to_titles arrays based on the
# title in the HTML file corresponding to this image.
#
sub snarf_title($) {
  my ($jpg) = @_;
  my $html = $jpg;
  $html =~ s/\.[^.]+$/.html/;
  local *IN;
  if (! open (IN, "<$html")) {
    $html =~ s@/[^/.]+\.html$@/index.html@;
    error ("$html: $!") unless open (IN, "<$html");
  }
  my $body = '';
  while (<IN>) { $body .= $_; }
  close IN;
  my ($title) = ($body =~ m@<TITLE>(.*?)</TITLE>@si);
  error ("$html: no title") unless $title;
  $title =~ s/\s*:\s*\d+(\.[^.]+)?\s*$//;
  $title =~ s/^DNA Lounge:\s*//i;
#  $title =~ s/&amp;/&/g;
#  $title =~ s/&quot;/"/g;
#  $title = de_entify($title);

  $imgs_to_titles{$jpg} = $title;

  $title = lc($title);
  my @titles = ($title);
  if ($title =~ m![\@:&+/]!) {
    foreach (split (m!\s*[\@:&+/]\s+!, $title)) {
      push @titles, $_;
    }
  }
  foreach $title (@titles) {
    my $listP = $titles_to_imgs{$title};
    my @list = (defined ($listP) ? @$listP : ());
    push @list, $jpg;
    $titles_to_imgs{$title} = \@list;
  }
}


# Given the path to an HTML file that wraps an image, returns a string
# describing it (based on the title in that file, and the date in the
# pathname.)
#
sub get_image_title($) {
  my ($file) = @_;
  $file =~ s/\.html$/\.jpg/;
  my $title = $imgs_to_titles{$file};
  error ("$file: no title") unless ($title);

  my ($yyyy, $mm, $dd) = ($file =~ m@/(\d\d\d\d)/(\d\d)-(\d\d)/@);
  $dd += 0;
  $mm = $months[$mm-1];
  $mm =~ s/^(...).*$/$1/;
  $title .= " ($dd-$mm-$yyyy)";

  return $title;
}


# loads excluded.txt and populates %excluded.
#
sub load_excluded($) {
  my ($file) = @_;
  local *IN;
  $file =~ s@//+@/@g;
  open (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);
}


# Returns the title and performers of all of the upcoming events
# as list of lists: ( \( "date", "k1", "k2" ... ) ... )
#
sub upcoming_event_keywords() {
  local *IN;
  error ("$rss_file: $!") unless open (IN, "<$rss_file");
  my $body = '';
  while (<IN>) { $body .= $_; }
  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 @result = ();
  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);
    my $date2 = "$dotm, $mmm $dd";
    $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, $date2;
    foreach (split (/\n/, $event)) {
      next unless m@^<(dnalounge:(title|dj|band|performer))[^<>]*>(.*?)</\1>@si;
      my $name = $3;
      push @titles, lc($name);
    }
    push @result, \@titles;
  }
  return @result;
}


# Returns photos related to the upcoming events: either from an event
# of the same name, or a photo of one of the next event's performers.
# Returns a list of lists.
#
sub upcoming_event_photos() {
  my @result = ();
  my $i = 0;
  @upcoming_event_keywords = upcoming_event_keywords();
  foreach my $kwdsP (@upcoming_event_keywords) {
    my @kwds = @$kwdsP;
    my @imgs = ();
    my $date = shift @kwds;
    push @imgs, $date;
    foreach my $key (@kwds) {
      my $listP = $titles_to_imgs{$key};
      next unless defined ($listP);
      push @imgs, @$listP;
      foreach (@$listP) {
        if (! defined ($imgs_to_upcoming{$_})) {
          # don't overwrite *next* upcoming with a *later* upcoming!
          $imgs_to_upcoming{$_} = $date;
        }
      }
    }
    if ($verbose > 2) {
      my $t = $kwds[0];
      my $n = $#imgs;
      print STDERR "$progname: event $i: $n photos ($t)\n";
    }

    # if this event doesn't have any photos, skip it and move on to the next.
    next if ($#imgs < 3);

    push @result, \@imgs;
    $i++;
  }

  return @result;
}


# 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];
  }
}


sub image_size($) {
  my ($file) = @_;
  error ("$file does not exist") unless -f $file;
  return (0, 0) unless -f $file;
  my $cmd = ("convert '$file' info:");
  print STDERR "$progname: executing: $cmd\n" if ($verbose > 3);
  my $result = `$cmd`;
  print STDERR "$progname:   ==> $result\n" if ($verbose > 3);
  my ($w, $h) = ($result =~ m/ (\d+)x(\d+) /);
  error ("no size: $file") unless ($w && $h);
  return ($w, $h);
}


# Creates a W x H thumbnail jpeg of the given file in the given directory.
# 
sub make_thumbnail($$$$$$) {
  my ($dir, $file, $count, $w, $h, $title) = @_;

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

  my $w2  = $w * 2;
  my $h2  = $h * 2;
  my $ps  = 9  * 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 $fg  = "#00DDFF";
  my $bg  = "#00000088";

  my ($name, $date) = ($title =~ m/^(.*?)\s*\((.*)\)$/s);
  error ("unparsable title: $title") unless $name;
  $date =~ s/-/ /g;
  $date =~ s/^\d+ //si;  # lose dotm

  my $title2 = $imgs_to_upcoming{$file} || '';

  if ($title2) {
    my ($a, $b) = ($name =~ m/^(.*?)\s*:\s*(.*)$/s);
    $a = $name unless $a;
    $name = $b;
    $title2 = "Next $a\\n$title2";
    $title = ($name ? "$name\\n$date" : $date);

    # only use the "next" text, not the date; and put it at the bottom.
    $title = $title2;
    $title2 = '';
  } else {
    $title = "$date\\n$name";
  }

  foreach ($title, $title2) {
    next unless $_;
    $_ = de_entify($_);
    s@\\([\"\'])@$1@gs;
    s/([\"])/\\$1/gs;
    s@: @\\n@gsi;
  }

  my @lines  = split (m/\\n/, $title)  if $title;
  my @lines2 = split (m/\\n/, $title2) if $title2;
  my $lines  = $#lines+1;
  my $lines2 = $#lines2+1;

  my $rectgeom = ("0," . ($h2 - (($lines  * $ps * 1.2) + 10)) . " $w2,$h2");
  my $rect2geom = ("0,0,$w2," . (($lines2 * $ps * 1.2) + 10));

  $cmd = ("convert $file " .
          "-geometry ${w2}x${h2} " .
          "-gravity southeast " .
          "-font \"$f\" " .
          "-pointsize $ps " .
          ($title
           ? ("-fill \"$bg\" " .
              "-draw 'rectangle $rectgeom' " .
              "-fill \"$fg\" " .
              "-annotate +5+5 \"$title\" ")
           : "") .
          ($title2
           ? ("-gravity northeast " .
              "-fill \"$bg\" " .
              "-draw 'rectangle $rect2geom' " .
              "-fill \"$fg\" " .
              "-annotate +5+5 \"$title2\" ")
           : "") .
          "-geometry ${w}x${h} " .
          "-quality 90 " .
          "$tmp");

  if ($debug) {
    if ($verbose > 3) {
      print STDERR "$progname: debug: not executing: $cmd\n";
    } else {
      print STDERR "$progname: debug: not creating $thumb ($title)\n";
    }
    return $thumb;
  }

  print STDERR "$progname: executing: $cmd\n" if ($verbose > 3);
  
#  # I'm sick of seeing "convert: unable to read font `HelveticaBold'."
  $cmd .= " 2>/dev/null" unless ($verbose > 3);

  my @cmd = ("/bin/sh", "-c", $cmd);

  system (@cmd);
  my $exit_value  = $? >> 8;
  my $signal_num  = $? & 127;
  my $dumped_core = $? & 128;

  if ($dumped_core) {
    unlink $tmp;
    error ("$cmd[0]: core dumped!")
  }
  if ($signal_num) {
    unlink $tmp;
    error ("$cmd[0]: signal $signal_num!")
  }

  if (!rename ("$tmp", "$dir/$thumb")) {
    error ("mv $tmp $dir/$thumb: $!");
  }
  if ($verbose > 1) {
    my $title = get_image_title ($file);
    print STDERR sprintf ("$progname: wrote $dir/$thumb (%3d x %3d)" .
                          " for $file ($title)\n",
                          $w, $h)
  }
  return $thumb;
}


# Picks some images and returns a list of them.
# There will never be two images from the same directory,
# and the "excluded" images are excluded.
# (But if $force_p is true, we use the first N images regardless,
# since those were specified on the command line.)
#
sub pick_images($$$@) {
  my ($dir, $n, $force_p, @all) = @_;

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

  my $upcoming_event_count = 0;
  my $max_upcoming = 3;

  my @files0 = ();
  {
    my %dup_table;
    my $j = 0;

    while (1) {
      my $next = undef;

      if ($upcoming_event_count <= $#upcoming_event_photos &&
          $upcoming_event_count <= $max_upcoming) {
        my $photosP = $upcoming_event_photos[$upcoming_event_count];
        $next = pop @$photosP;
        $upcoming_event_count++;
      }

      $next = pop @all unless defined ($next);

      error ("INTERNAL ERROR") unless defined ($next);
      my $dir = $next; $dir =~ s@/[^/]+$@@;

      # don't use this one if we're already using an image from this directory.
      if (!$force_p && defined ($dup_table{$dir})) {
        print STDERR "$progname: skipped dup: $next\n" if ($verbose > 2);
        next;
      }

      # don't use this one if it's listed in the %excluded table.
      my $key = $next; $key =~ s@^.*?([^/]+/[^/]+/[^/]+)$@$1@;
      my $key2 = $key; $key2 =~ s@/[^/]+$@/@;
      if (!$force_p && ($excluded{$key} || $excluded{$key2})) {
        print STDERR "$progname: excluded: $next\n" if ($verbose > 2);
        next;
      }

      # If this image has no wrapping HTML file, don't use it.
      if (!$force_p) {
        my $html = $next;
        $html =~ s/\.[a-z]+$/.html/;
        if (! -f $html) {
          print STDERR "$progname: skipped: $next (no html)\n"
            if ($verbose > 2);
          next;
        }
      }

      $dup_table{$dir} = 1;
      unshift @files0, $next;
      $j++;
      print STDERR "$progname: picked: $next\n" if ($verbose > 2);
      last if ($j >= $n);
    }
  }

  return @files0;
}


# Picks some images and computes the sizes to which they should be scaled.
# Returns an array ref containing the rows/columns/sizes/titles, etc.
#
sub layout_images($$$$$$@) {
  my ($dir, $blocks, $count, $horiz_p, $max_size, $force_p, @all) = @_;

  my @files0 = pick_images ($dir, $blocks * $count, $force_p, @all);
#  shuffle_array (\@files0);


  my %dup_titles;

  my @images = ();   # ( \( block \) ... )
                     # block = ( \( img \) ... )
                     # image = ( href jpg thumb-w thumb-h )


  # compute the sizes, hrefs, etc. of this column/row of images.
  #
  my $n = 0;
  for (my $i = 0; $i < $blocks; $i++) {
    my @block = ();
    for (my $j = 0; $j < $count; $j++) {
      my $file = pop @files0;
      $file =~ s@^\./@@;        # lose leading ./

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

      my $title = get_image_title ($href);

      # Bail if we have picked two images with similar titles
      # (e.g., images from different dates, but the same band.)
      #
      if (! $force_p) {
        my $tt = $title;
        $tt =~ s/\s*[\(:;+,].*\s*$//si;
        $tt =~ tr/A-Z/a-z/;

        my $old = $dup_titles{$tt};
        if (defined ($old)) {
          print STDERR "$progname: duplicate title: $title\n" .
                       "$progname:                  $old\n\n"
            if ($verbose > 2);
          return undef;

        } else {
          $dup_titles{$tt} = $title;
        }
      }

      my ($w, $h) = image_size ($file);

      my @img = ($href, $file, $title, $w, $h);
      push @block, \@img;
    }
    push @images, \@block;
  }


  foreach my $blockP (@images) {

    # Scale each image down to the approximate size we want.
    #
    foreach my $imgP (@$blockP) {
      my @img = @$imgP;
      my $w = $img[3];
      my $h = $img[4];

      if ($horiz_p) {
        my $line_height = 200;
        $w = ($w / $h) * $line_height;
        $h = $line_height;
      } else {
        my $col_width = 200;
        $h = ($h / $w) * $col_width;
        $w = $col_width;
      }

      $img[3] = $w;
      $img[4] = $h;
      $imgP = \@img;
    }

    # Compute the actual width or height of this row or column,
    # based on those initial image sizes.
    #
    my $total = 0;
    foreach my $imgP (@$blockP) {
      my ($href, $file, $title, $w, $h) = @$imgP;
      $total += ($horiz_p ? $w : $h);
    }

    my $pad = ((($#$blockP+1) * 2) +    # border=1
               (($#$blockP-1) * 16));   # hspace=8 on middle

    # Ensure that the row/column doesn't exceed a max width/height
    # by scaling the images down a bit more.
    #
    my $scale = ($max_size - $pad) / $total;

    foreach my $imgP (@$blockP) {
      my @img = @$imgP;

      my $w = $img[3] * $scale;
      my $h = $img[4] * $scale;

      $w = int($w + 0.5);  # round, don't truncate
      $h = int($h + 0.5);

      $img[3] = $w;
      $img[4] = $h;
      $imgP = \@img;
    }

    my $real_total = 0;
    foreach my $imgP (@$blockP) {
      my ($href, $file, $title, $w, $h) = @$imgP;
      $real_total += ($horiz_p ? $w : $h);
    }

    # If the rounding leaves the total width 1 pixel too short,
    # increase the size of the 2nd image on the line by 1 pixel.
    #
    if ($real_total+1 == int($total*$scale+0.5)) {
      ${$blockP->[1]}[($horiz_p ? 3 : 4)]++;
    }
  }

  # Compute the aspect ratio of the full block of images, and bail if
  # it will look bad.
  #
  if (! $force_p) {
    my $overall_w = 0;
    my $overall_h = 0;
    foreach my $blockP (@images) {
      foreach my $imgP (@$blockP) {
        my @img = @$imgP;
        $overall_w += $img[3];
        $overall_h += $img[4];
      }
    }

    if ($horiz_p) {
      $overall_w /= $blocks;
      $overall_h /= $count;
    } else {
      $overall_h /= $blocks;
      $overall_w /= $count;
    }

    my $ratio = $overall_w / $overall_h;
    $ratio = (1/$ratio) unless ($horiz_p);

    print STDERR "$progname: overall size: $overall_w x $overall_h " .
      sprintf ("(%.2f)\n", $ratio)
        if ($verbose > 2);

    my $min_ratio = 1.5;

    if ($ratio <= $min_ratio) {
      print STDERR "$progname: oops, trying again: aspect ratio was " . 
                   sprintf("%.2f\n\n", $ratio)
          if ($verbose > 1);
      return undef;
    }

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

  return \@images;
}


# Converts the array-ref of image data to HTML.
# Creates the necessary thumbnail JPG files.
# Returns HTML.
#
sub format_images($$$) {
  my ($dir, $horiz_p, $imagesP) = @_;

  my $output = "";

  $output .= "<!-- %%NOWRAP%% -->\n";
  $output .= "<BODY BGCOLOR=\"#000000\" TEXT=\"#00FF00\"\n";
  $output .= "       LINK=\"#00DDFF\" VLINK=\"#AADD00\" ALINK=\"#FF6633\">\n";
  $output .= "<P ALIGN=CENTER>\n\n";

  # output $blocks columns (or rows) of $count images.
  #
  $output .= "<!-- %%SNAPSHOTS_START%% -->\n";
  $output .= "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>\n";
  $output .= " <TR>\n";


  # now emit the HTML for this column or row.
  #
  my $n = 0;
  foreach my $blockP (@$imagesP) {
    my $block_count = 0;
    $output .= "  <TD NOWRAP>";
    my $img_count = 0;
    foreach my $imgP (@$blockP) {
      my ($href, $file, $title, $w, $h) = @$imgP;

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

      $file = make_thumbnail ($dir, $file, $n, $w, $h, $title);
      $href =~ s@^$dir/@@;

      # 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 HREF=\"$href\">";

      # 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 .= "?$href";
      $file =~ s@\.html$@@;
      $file .= ".jpg";

      my $hs = ($horiz_p ? 8 : 4);
      my $vs = ($horiz_p ? 4 : 8);
      my $bd = 1;

      if ($img_count == 0 || $img_count == $#$blockP) {
        if ($horiz_p) {
          $hs = 0;
        } else {
          $vs = 0;
        }
      }

      $output .= "<IMG\n   SRC=\"$file\" WIDTH=$w HEIGHT=$h";
      $output .= "\n   HSPACE=$hs VSPACE=$vs BORDER=$bd";

      $output .= "></A>";
      $output .= "<BR>" unless ($horiz_p);
      $img_count++;
      $n++;
    }
    $output .= "</TD>\n";
    $output .= " </TR><TR>\n" if ($horiz_p);
    $block_count++;
  }
  
  $output =~ s@\s*<TR>\s*$@@s;
  $output .= "</TABLE>\n";
  $output .= "<!-- %%SNAPSHOTS_END%% -->\n";
  $output .= "</BODY>\n";

  return $output;
}


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

  my $force_p = ($#force >= 0);
  my $blocks = 2;
  my $count = 3;
  my $horiz_p = 1;
  my $max_size =  ($horiz_p ? 530 : 650);

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

  my @all = get_image_files($dir);  # gets titles too
  @all = @force if ($force_p);

  print STDERR "$progname: " . ($#all+1) . " potential images\n"
    if ($verbose > 2);

  if (!$force_p) {
    @upcoming_event_photos = upcoming_event_photos ();
  } else {
    upcoming_event_photos();   # just populate %imgs_to_upcoming
  }

  my $imagesP = undef;
  while (! defined ($imagesP)) {
    shuffle_array (\@all) unless ($force_p);

    if ($#upcoming_event_photos >= 0) {
      foreach (@upcoming_event_photos) {
        my $date = shift @$_;
        shuffle_array ($_);
        unshift @$_, $date;
      }
    }

    $imagesP = layout_images ($dir,
                              $blocks, $count, $horiz_p,
                              $max_size, $force_p,
                              @all);
  }

  my $output = format_images ($dir, $horiz_p, $imagesP);

  if ($debug) {
    print STDERR "$progname: debug: not writing $outfile\n";
    return;
  }

  local *OUT;
  my $tmp = "$outfile.tmp";
  open (OUT, ">$tmp") || error ("$tmp: $!");
  print OUT $output || error ("$tmp: $!");
  close OUT || error ("$tmp: $!");

  rename_or_delete ($outfile, $tmp);
}


sub current_images($) {
  my ($dir) = @_;
  $dir =~ s@/+$@@;

  my $file = "$dir/snapshots.html";
  local *IN;
  open (IN, "<$file") || error ("$file: $!");
  my $body = '';
  while (<IN>) { $body .= $_; }
  close IN;
  
  my @imgs = ();
  while ($body =~ m/\G.*?<IMG\s+SRC=\"[^<>\"?]*\?([^<>\"]+)\"/gsi) {
    unshift @imgs, "$dir/$1";
  }
  error ("$file unparsable") unless ($#imgs == 5);
  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 ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif ($_ eq "--debug") { $debug++; }
    elsif ($_ eq "--force") {
      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);
          unshift @force, $f;
        }
      }
    }
    elsif (m/^-./) { usage; }
    elsif (!defined($dir)) { $dir = $_; }
    else { usage; }
  }

  usage unless defined($dir);

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

  load_excluded ("$dir/$excluded_file");
  generate_page ($dir, @force);
}

main();
exit 0;