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

use CGI qw(:all area map);
$ENV{PATH} = "/usr/local/bin:/bin:/usr/bin";

use Cache::FileCache;
my $cache = Cache::FileCache->new
  ({namespace => 'forestdump',
    username => 'nobody',
    default_expires_in => '10 minutes',
    auto_purge_interval => '1 hour',
   });

if (length (my $info = path_info())) { # I am the image
  my ($session) = $info =~ m{\A/([0-9a-f]+)\.gif\z}i
    or do {
      warn("bad URL $info");
      print header(-status => '404 Not Found');
      exit 0;
    };

  defined(my $image_and_imagemap = $cache->get($session))
    or do {
      warn("Cannot find $session");
      print header(-status => '404 Not Found');
      exit 0;
    };

  print header('image/gif'), $image_and_imagemap->[0];
  exit 0;
}

param('pairs', do {local $/; <DATA>}) unless param('pairs');
print header,
  hr, start_form, p('enter pairs of parent-to-child,',
                    'one pair per line, separated by commas'), br,
  textarea(-name => 'pairs', -rows => 10),
  submit, end_form, hr;

if (param('goto')) {
  my $selected = param('goto');
  Delete('goto');
  print p("You selected node", escapeHTML($selected)."!");
}

my $pairs = param('pairs');
$pairs =~ tr/\r//d;

my $session = do { require MD5; MD5->hexhash($pairs) };

if (defined(my $image_and_imagemap = $cache->get($session))) {
  ## we have a good imagemap already, so reuse it
  warn "reusing imagemap $session"; # DEBUG
  print $image_and_imagemap->[1];
} else {
  ## we must compute it from the pairs

  my (@times) = (time,times);

  require GraphViz;
  my $g = GraphViz->new
    (rankdir => 1, node => {height => '0.05', shape => 'box', URL => '\N'});
  
  my %nodename;

  for (split /\n/, $pairs) {
    my @values = split /\s*,\s*/;
    next unless @values == 2;
    my ($fromlabel, $tolabel) = @values;
    my ($fromnode, $tonode) = map {
      $nodename{$_} ||= $g->add_node('label' => $_)
    } ($fromlabel, $tolabel);
    $g->add_edge($fromnode, $tonode);
  }

  my %nodename_to_label = reverse %nodename;

  my $imagemap = join
    ("",
     img({ismap => 1, usemap => '#my_image_map',
          src => url(-relative => 1)."/$session.gif"}),
     &map({name => 'my_image_map'},
          join("\n",
               map {
                 my ($x1,$y1,$x2,$y2, $nodename) =
                   /^rectangle \((\d+),(\d+)\) \((\d+),(\d+)\) (\S+) /;
                 param('goto', $nodename_to_label{$nodename});
                 ## y1 needs to be swapped with y2 apparently
                 area({shape => 'rect',
                       href => url(-relative => 1, -query => 1),
                       coords => "$x1,$y2,$x2,$y1"});
               } split /\n/, $g->as_ismap)));
  Delete('goto'); # set in the loop above
  
  print $imagemap;

  $cache->set($session, [$g->as_gif, $imagemap]);

  @times = map { $_ - shift @times } time, times;
  warn "CPU used for new item: @times"; # debug
}

__END__
pa1, a
pa2, a
a, b
a, c
a, d%
d%, e&f
j, k
k, l
k, m
k, n
pa1, n