#!/usr/bin/perl -Tw
use strict;
$|++;

use CGI::Carp qw(fatalsToBrowser); # development only

## CONFIG

my $CACHE = "/tmp/merlyn-cacheddate";
my $STALE = 5;
my $DEAD = 60;

my $CONTENT_TYPE = "text/plain";

sub WRITE_TASK_TO {
  my $handle = shift;           # must write to this handle

  sleep 5;                      # simulate some computation
  print $handle scalar localtime;
}

my $TMP = "$CACHE.tmp";         # probably don't need to mess with

## END CONFIG

{
  ## main loop

  if (cache_is_good()) {
    show_cache_and_exit("current");
  }
  if (cache_is_stale()) {
    if (i_am_the_writer()) {
      if (i_can_fork()) {
        if (i_am_the_parent()) {
          show_cache_and_exit("stale");
        }
        ## child does:
        be_a_child();
        update_cache();
        exit 0;
      }
      ## cannot fork, so it's up to me
      update_cache();
      show_cache_and_exit("current");
    }
    ## I'm not the writer, so show old cache
    show_cache_and_exit("stale");
  }
  ## cache is dead
  if (i_am_the_writer()) {
    update_cache();
    show_cache_and_exit("current");
  }
  ## we cannot do anything about a bad cache, so retry
  close_cache();
  sleep 5;
  redo;
}

BEGIN {
  ## current-cache-related stuff

  my $cache_handle = \do {local *HANDLE};
  my $cache_mtime;

  sub cache_is_good {
    cache_not_older_than($STALE);
  }

  sub cache_is_stale {
    not cache_is_good() and
      cache_not_older_than($DEAD);
  }

  sub cache_not_older_than {
    my $seconds = shift;
    open_cache() or return 0;
    defined $cache_mtime and time - $cache_mtime < $seconds;
  }

  sub open_cache {
    return 0 unless
      defined fileno($cache_handle) or
        open $cache_handle, $CACHE;
    ($cache_mtime) = (stat $cache_handle)[9];
    1;
  }

  sub close_cache {
    close $cache_handle;
  }

  sub not_modified {
    return 0 unless defined(my $ims = $ENV{HTTP_IF_MODIFIED_SINCE});
    require HTTP::Date;

    my $time = HTTP::Date::str2time($ims);
    $time >= $cache_mtime;
  }

  sub modified_date {
    require HTTP::Date;

    HTTP::Date::time2str($cache_mtime);
  }

  sub expires_date {
    require HTTP::Date;

    HTTP::Date::time2str($cache_mtime + $DEAD);
  }

  sub show_cache_and_exit {
    my $status = shift;

    open_cache() or die "cache missing: $!";

    print "X-cache-status: $status\n";

    if (not_modified()) {
      print "Status: 304 Not Modified\n\n";
    } else {
      print "Last-modified: ", modified_date(), "\n";
      print "Expires: ", expires_date(), "\n";
      print "Content-type: $CONTENT_TYPE\n\n";
      print while <$cache_handle>;
    }
    exit 0;
  }
}

BEGIN {
  ## output-cache-related related stuff

  my $cache_tmp_handle = \do {local *HANDLE};

  sub i_am_the_writer {
    require Fcntl;
    Fcntl->import(qw(LOCK_EX LOCK_NB));

    open $cache_tmp_handle, ">>$TMP" or die "Cannot create $TMP: $!";
    flock $cache_tmp_handle, LOCK_EX() | LOCK_NB();
  }

  sub update_cache {
    truncate $TMP, 0 or die "truncate: $!";
    seek $cache_tmp_handle, 0, 0;
    WRITE_TASK_TO($cache_tmp_handle);
    rename $TMP, $CACHE or die "Cannot rename: $!";
    close $cache_tmp_handle;
    close_cache();
  }

}

BEGIN {
  ## forking-related stuff

  my $kid_pid;
    
  sub i_can_fork {
    defined ($kid_pid = fork);
  }

  sub i_am_the_parent {
    $kid_pid > 0;
  }

  sub be_a_child {
    require sigtrap;
    sigtrap::->import(qw(handler __IGNORE__ any));

    close STDOUT;
  }

}