#!/home/merlyn/bin/perl -Tw
use strict;

$|++;

use File::Copy;
use HTTP::Date qw(time2str);

### Configuration

my $IMAGE_TOP = "/home/merlyn/Web/Images";
my $REAL = "$IMAGE_TOP/Real";
my $PREVIEW = "$IMAGE_TOP/Preview";

$ENV{PATH} = join ":",
  qw(
     /usr/local/netpbm/bin
     /usr/local/bin
     /usr/ucb
     /usr/bin
     /bin
     );

### end Configuration

### constants

my $BOUNDARY = "ThisRandomString";

### end constants

### CGI input

my $PATH_INFO = $ENV{PATH_INFO} || "";

### end CGI input

my $file;
my $real;

eval {
  $PATH_INFO =~ /^\/([a-zA-Z0-9._-]+\.(jpe?g|gif))$/i
    or die "missing filename in PATH_INFO: $PATH_INFO\n";
  $file = $1;
  $real = "$REAL/$file";
  -r $real or die "$file not found\n";
};
if ($@) {
  print "Status: 404 Not Found\n";
  print "Content-type: text/plain\n\n";
  print "error: $@\n";
  exit 0;
}
my $preview = "$PREVIEW/$file.gif";

unless (-e $preview and -M $preview < -M $real) {
  my $preview_temp = "$preview.$$";

  ## JPEG: djpeg * | ...
  ## GIF: giftopnm * | ...
  ## ... | ppmtopgm | pgmtopbm | ppmtogif >*.gif

  my $command = ($real =~ /\.gif$/i) ? "giftopnm" : "djpeg";
  $command .= " $real | ppmtopgm | pgmtopbm | ppmtogif >$preview_temp";
  my $messages = `($command) 2>&1`;
  if (-s $preview_temp) {       # presuming non-empty file means all is OK
    rename $preview_temp, $preview;
  }
  unlink $preview_temp;
}

my $last_modified = time2str((stat $real)[9]);
print "Last-modified: $last_modified\n";
print "Content-type:multipart/x-mixed-replace;boundary=$BOUNDARY\n\n";
print "--$BOUNDARY\n";
if (-e $preview) {
  send_this($preview);
  print "\n--$BOUNDARY\n";
}
send_this($real);
print "\n--$BOUNDARY--\n";

sub send_this {
  my $name = shift;

  my $type = ($name =~ /\.gif$/i) ? "gif" : "jpeg";

  print "Content-type: image/$type\n";
  print "Content-length: ", (-s $name), "\n\n";
  copy $name, \*STDOUT;
}