package Stonehenge::Pictures;
use strict;

use vars qw($VERSION);
BEGIN { $VERSION = 2.00; };

use vars qw($CACHED);
BEGIN { $CACHED = undef; }

### configuration
my $PICSPERPAGE = 10;
my $ODD = "#dddddd";            # bgcolor for odd rows
my $EVEN = "#ffffff";           # bgcolor for even rows
my $NEXTPREV = "#ddffdd";       # bgcolor for next/prev links rows
my $REPORT = 1;                 # if 1, report times for Magick
my $DEBUG_DUMP_CACHE = 0;       # if 1, append dump of cache in response
### end configuration

use Apache::Constants qw(:common DIR_MAGIC_TYPE);
use Apache::Log;
use Apache::File;
use Apache::Util qw(escape_uri escape_html size_string);
use CGI::Pretty qw(:all);

### globals
my $R;                          # request object
my $LOG;                        # log object

my $URI;                        # uri string
my $DIR;                        # directory (set only if directory)
### end globals

sub handler {
  use Stonehenge::Reload; goto &handler if Stonehenge::Reload->reload_me;

  $R = shift;
  $LOG = $R->log;
  $URI = $R->uri;

  if ($R->content_type eq DIR_MAGIC_TYPE) {
    return handle_directory();
  } else {
    return handle_file();
  }
}

sub handle_file {

  ## handle only JPEG files with ?size=half suffix
  return DECLINED if $R->content_type ne "image/jpeg" or $R->path_info;
  {
    my (%args) = $R->args;
    return DECLINED if
      not exists $args{size} or not delete $args{size} eq "half"
        or %args;               # must be empty now
  }

  if ($R->header_only) {        # save some work
    $R->send_http_header('image/jpeg');
    return OK;
  }

  my $rc = eval { do_magick() };
  if ($@) {                     # dead magick
    notice("Magick error: $@");
    return SERVER_ERROR;
  }
  return $rc;
}

sub do_magick {                 # may die
  my @times = (time, times);

  require Image::Magick;

  my $q = Image::Magick->new or die "Cannot new Image::Magick";
  my $err = $q->Read($R->filename); die $err if $err;
  $err = $q->Minify; die $err if $err;

  my ($tmpnam,$fh) = Apache::File->tmpfile or die "Cannot create tmpfile: $@";

  $err = $q->Write('filename' => "JPG:$tmpnam"); die $err if $err;

  $REPORT and
    notice(sprintf "%s magick: real %d user %.2f sys %.2f",
           $URI, (map { $_ - shift @times } time, times)[0,1,2]);

  $R->send_http_header('image/jpeg');
  $R->send_fd($fh);
  return OK;
}

sub handle_directory {
  ## if non-slash URL, send external redirect via mod_dir:
  return DECLINED unless $URI =~ /\/$/;

  $DIR = $R->filename;

  $R->chdir_file("$DIR/");

  return possible_304(update_cache()) || showdir();
}

sub showdir {
  my $title = "Picture index for " . get_cache_dir_title();

  print
    header(-expires => "+1d"),
    start_html(-title => $title,
               -dtd => "-//W3C//DTD HTML 4.0 Transitional//EN"),
    h1($title),
    p(get_cache_dir_info());

  show_links();
  show_pics();
  dump_cache() if $DEBUG_DUMP_CACHE;

  print
    hr,
    p("This page is powered by",
      a({href =>"http://perl.apache.org"},
        img({src => "http://perl.apache.org/logos/mod_perl.gif",
             alt => "Apache and mod_perl!"})));

  print end_html;
  return OK;
}

sub show_links {
  my $flip = 0;
  
  print
    h2("links"),
    table({ cellspacing => 0, cellpadding => 10 },
          map { Tr({bgcolor => (($flip = !$flip) ? $ODD : $EVEN)},
                   td(a({Href => escape_html_uri($_->[0])},
                        escape_html($_->[0]))),
                   td($_->[1]),
                  ) }
          @{get_cache_other($DIR)});
}

sub show_pics {
  if (my @all_pics = @{get_cache_pictures($DIR)}) {
    my $max = @all_pics;

    my %args = $R->args;
    my $start = int($args{'start'} || 1);
    $start = 1 if $start < 1;
    $start = $max if $start > $max; # dubious
    my $end = int($args{'end'} || ($start + $PICSPERPAGE - 1));
    $end = $start if $end < $start;
    $end = $max if $end > $max;

    my @pics = @all_pics[($start-1)..($end-1)];

    my @links_row = make_links_row(3, $start, $end, $max);

    my $flip = 0;
    print
      h2("Pictures $start through $end of $max"),
      p("Please note the new 50% links...",
        "a reduced-size JPEG will be created on the fly."),
      table({ cellspacing => 0, cellpadding => 10 },
            @links_row,
            map ({my($jpg, $thumb, $info, $size, $mtime) = @$_;
                  Tr({bgcolor => (($flip = !$flip) ? $ODD : $EVEN)},
                      td(a({Href => escape_html_uri($jpg)},
                           img({src => escape_html_uri($thumb),
                                alt => "[thumbnail for ".
                                escape_html($jpg)."]"}))),
                      td(size_string($size).",",
                         "uploaded",int((time - $mtime)/86400),"days ago,",
                         "scaled:",
                         a({Href => escape_html_uri($jpg)."?size=half" },
                           "50%")),
                      td($info),
                     ) } @pics),
            @links_row,
           );
  }
}

sub make_links_row {
  my ($colspan, $start, $end, $max) = @_;

  my @links;
  push @links, range_link($start - $PICSPERPAGE,
                          $start - 1,
                          $max, "previous")
    if $start > 1;
  push @links, range_link($end + 1,
                          $end + $PICSPERPAGE,
                          $max, "next")
    if $end < $max;
  return @links
    ? Tr({bgcolor => $NEXTPREV}, td({colspan => $colspan}, join ", ", @links))
      : ();
}

sub range_link {
  my $start = shift;
  my $end = shift;
  my $max = shift;
  my $text = shift;

  $start = 1 if $start < 1;
  $start = $max if $start > $max;
  $end = $start if $end < $start;
  $end = $max if $end > $max;

  my $count = $end - $start + 1;
  my $pictures = $count > 1 ? "$count pictures" : "picture";

  return a({href => "$URI?start=$start&end=$end"}, "$text $pictures");
}

sub dump_cache {
  require Data::Dumper;
  print
    table({ Border => 1 },
          Tr(th("dump of %cache")),
          Tr(td(pre(escape_html(Data::Dumper::Dumper(get_cache_ref($DIR)))))));
}

sub notice {
  $LOG->notice("[$$] ", @_);
}

sub escape_html_uri {
  return escape_html(escape_uri(shift));
}

BEGIN {
  ## cache this file's mtime at compile-time
  my $module_mtime = (stat(__FILE__))[9];

  sub possible_304 {
    my $cache_time = shift;

    $R->update_mtime;           # from current directory/file
    $R->update_mtime($module_mtime);
    $R->update_mtime($cache_time);
    $R->set_last_modified;
    $R->set_etag;
    return $R->meets_conditions;
  }
}

BEGIN {                         # cache-related functions
  my %cache;

  ## $cache{$DIR} = {
  ##    { Depends => { "relative name" => $mod_time, ... },
  ##    { Other => [["link" => "desc"], ["link" => "desc"], ... ] },
  ##    { Pictures => [["foo","foo.thumb.jpg","desc", stats], ...] },
  ##    { Title => "my title" },
  ##    { Info => "my info" },
  ## }

  sub update_cache {
    return check_depends() || make_new_cache();
  }

  sub check_depends {
    my $no_stat = shift || 0;   # if true, returns max(@times)

    return 0 unless exists $cache{$DIR} and exists $cache{$DIR}{Depends};
    my $items = $cache{$DIR}{Depends};
    my $most_recent = 0;
    while (my ($key, $value) = each %$items) {
      unless ($no_stat) {
        return 0 unless my (@stat) = stat($key);
        return 0 if $stat[9] != $value;
      }
      $most_recent = $value unless $most_recent > $value;
    }
    return $most_recent;
  }

  sub make_new_cache {

    ## clear it out, initialize to dot mtime
    $cache{$DIR} = { Depends => { "." => (stat("."))[9] } };

    my @files = get_files_in_dot();
    my $info = get_info_in_dot();

    my @pictures;
    my @other;

    for (@files) {
      my @stat = stat;
      if (-d _) {
        push @other, ["$_/" => get_title($_)];
      } elsif (-r "$_.thumb.jpg") {
        push @pictures,
        [$_, "$_.thumb.jpg", get_info($info, $_), $stat[7], $stat[9]];
      } elsif (/\.thumb\.jpg$/) { # ignore
      } else {
        push @other, [$_ => get_info($info, $_)],
      }
    }

    $cache{$DIR}{Pictures} = \@pictures;
    $cache{$DIR}{Other} = \@other;
    $cache{$DIR}{Title} = get_title(".");
    $cache{$DIR}{Info} = get_info($info,".");

    $CACHED = keys %cache;      # for ChildExitHandler report

    return check_depends(1);
  }

  sub get_files_in_dot {
    my $dot = Apache::File->new;
    opendir $dot, ".";
    return sort "..", grep !/^\.|~$/, readdir $dot;
  }

  sub get_info_in_dot {
    my %info = ();
    local($/,$_);
    my $fh = open_and_add_depends(".info");
    if ($fh and defined($_ = <$fh>)) {
      s/^\s*\#.*\n//mg;         # toss comments
      s/[ \t]*\n[ \t]+/ /g;     # fold continuation lines
      %info = /^(\S+)\s+(.*)/mg;
    }
    return \%info;
  }

  sub open_and_add_depends {
    my $path = shift;
    my $fh = Apache::File->new($path);
    $fh and $cache{$DIR}{Depends}{$path} = (stat($fh))[9];
    return $fh;                 # possibly undef
  }

  sub get_title {
    my $name = shift;

    my $fh = open_and_add_depends("$name/.title");
    $fh and <$fh> =~ /(.+)/ and return escape_html($1);
    $name eq ".." and return "Go up";
    $name eq "." and $name = $URI; # use uri instead of dot
    return "The ".escape_html($name)." directory";
  }

  sub get_info {
    my $info = shift;
    my $name = shift;

    exists $info->{$name} and return $info->{$name};
    $name eq "." and return " ";
    return "Description not provided for ".escape_html($name);
  }

  sub get_cache_pictures {return $cache{$DIR}{Pictures}}

  sub get_cache_other {return $cache{$DIR}{Other}}

  sub get_cache_dir_title {return $cache{$DIR}{Title}}

  sub get_cache_dir_info {return $cache{$DIR}{Info}}

  sub get_cache_ref {return \%cache} # for debugging only
}

1;