1	#!/usr/bin/perl -w
2	use strict;
3	$|++;
4
5	use CGI qw(:all area map);
6	$ENV{PATH} = "/usr/local/bin:/bin:/usr/bin";
7
8	use Cache::FileCache;
9	my $cache = Cache::FileCache->new
10	  ({namespace => 'forestdump',
11	    username => 'nobody',
12	    default_expires_in => '10 minutes',
13	    auto_purge_interval => '1 hour',
14	   });
15
16	if (length (my $info = path_info())) { # I am the image
17	  my ($session) = $info =~ m{\A/([0-9a-f]+)\.gif\z}i
18	    or do {
19	      warn("bad URL $info");
20	      print header(-status => '404 Not Found');
21	      exit 0;
22	    };
23
24	  defined(my $image_and_imagemap = $cache->get($session))
25	    or do {
26	      warn("Cannot find $session");
27	      print header(-status => '404 Not Found');
28	      exit 0;
29	    };
30
31	  print header('image/gif'), $image_and_imagemap->[0];
32	  exit 0;
33	}
34
35	param('pairs', do {local $/; <DATA>}) unless param('pairs');
36	print header,
37	  hr, start_form, p('enter pairs of parent-to-child,',
38	                    'one pair per line, separated by commas'), 			            br,
39	  textarea(-name => 'pairs', -rows => 10),
40	  submit, end_form, hr;
41
42	if (param('goto')) {
43	  my $selected = param('goto');
44	  Delete('goto');
45	  print p("You selected node", escapeHTML($selected)."!");
46	}
47
48	my $pairs = param('pairs');
49	$pairs =~ tr/\r//d;
50
51	my $session = do { require MD5; MD5->hexhash($pairs) };
52
53	if (defined(my $image_and_imagemap = $cache->get($session))) {
54	  ## we have a good imagemap already, so reuse it
55	  warn "reusing imagemap $session"; # DEBUG
56	  print $image_and_imagemap->[1];
57	} else {
58	  ## we must compute it from the pairs
59
60	  my (@times) = (time,times);
61
62	  require GraphViz;
63	  my $g = GraphViz->new
64	    (rankdir => 1, node => {height => '0.05', shape => 'box', 		       URL => '\N'});
65
66	  my %nodename;
67
68	  for (split /\n/, $pairs) {
69	    my @values = split /\s*,\s*/;
70	    next unless @values == 2;
71	    my ($fromlabel, $tolabel) = @values;
72	    my ($fromnode, $tonode) = map {
73	      $nodename{$_} ||= $g->add_node('label' => $_)
74	    } ($fromlabel, $tolabel);
75	    $g->add_edge($fromnode, $tonode);
76	  }
77
78	  my %nodename_to_label = reverse %nodename;
79
80	  my $imagemap = join
81	    ("",
82	     img({ismap => 1, usemap => '#my_image_map',
83	          src => url(-relative => 1)."/$session.gif"}),
84	     &map({name => 'my_image_map'},
85	          join("\n",
86	               map {
87	                 my ($x1,$y1,$x2,$y2, $nodename) =
88	                   /^rectangle \((\d+),(\d+)\) \((\d+),(\d+)\) 			           (\S+) /; 
89	                 param('goto', $nodename_to_label{$nodename});
90	                 ## y1 needs to be swapped with y2 apparently
91	                 area({shape => 'rect',
92	                       href => url(-relative => 1, -query => 				     1),
93	                       coords => "$x1,$y2,$x2,$y1"});
94	               } split /\n/, $g->as_ismap)));
95	  Delete('goto'); # set in the loop above
96
97	  print $imagemap;
98
99	  $cache->set($session, [$g->as_gif, $imagemap]);
100
101	  @times = map { $_ - shift @times } time, times;
102	  warn "CPU used for new item: @times"; # debug
103	}
104
105	__END__
106	pa1, a
107	pa2, a
108	a, b
109	a, c
110	a, d%
111	d%, e&f
112	j, k
113	k, l
114	k, m
115	k, n
116	pa1, n