summaryrefslogtreecommitdiff
path: root/lib/Multi
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Multi')
-rw-r--r--lib/Multi/Anime.pm13
-rw-r--r--lib/Multi/IRC.pm8
-rw-r--r--lib/Multi/Maintenance.pm35
-rw-r--r--lib/Multi/RG.pm296
4 files changed, 227 insertions, 125 deletions
diff --git a/lib/Multi/Anime.pm b/lib/Multi/Anime.pm
index 03134925..df2f6424 100644
--- a/lib/Multi/Anime.pm
+++ b/lib/Multi/Anime.pm
@@ -70,6 +70,17 @@ sub spawn {
lm => 0, # timestamp of last outgoing message, 0=no running msg
aid => 0, # anime ID of the last sent ANIME command
tag => int(rand()*50000),
+ # anime types as returned by AniDB (lowercased)
+ anime_types => {
+ 'unknown' => undef, # NULL
+ 'tv series' => 'tv',
+ 'ova' => 'ova',
+ 'movie' => 'mov',
+ 'other' => 'oth',
+ 'web' => 'web',
+ 'tv special' => 'spe',
+ 'music video' => 'mv',
+ },
},
);
}
@@ -224,7 +235,7 @@ sub receivepacket { # input, wheelid
$col[2] = undef if !$col[2] || $col[2] =~ /^0,/;
$col[3] = $1 if $col[3] =~ /^([0-9]+)/; # remove multi-year stuff
$col[3] = undef if !$col[3];
- $col[4] = (grep lc($VNDB::S{anime_types}[$_]) eq lc($col[4]), 0..$#{$VNDB::S{anime_types}})[0];
+ $col[4] = $_[HEAP]{anime_types}{ lc($col[4]) };
$col[5] = undef if !$col[5];
$col[6] = undef if !$col[6];
$_[KERNEL]->post(pg => do => 'UPDATE anime
diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm
index 5018d2aa..4225e6b8 100644
--- a/lib/Multi/IRC.pm
+++ b/lib/Multi/IRC.pm
@@ -266,12 +266,12 @@ sub notify { # name, pid, payload
return if !$_[HEAP]{$k};
my $q = $_[ARG0] eq 'newrevision' ? q|SELECT
- CASE WHEN c.type = 0 THEN 'v' WHEN c.type = 1 THEN 'r' ELSE 'p' END AS type, c.rev, c.comments, c.id AS lastrev,
+ CASE WHEN c.type, c.rev, c.comments, c.id AS lastrev,
COALESCE(vr.vid, rr.rid, pr.pid) AS id, COALESCE(vr.title, rr.title, pr.name) AS title, u.username
FROM changes c
- LEFT JOIN vn_rev vr ON c.type = 0 AND c.id = vr.id
- LEFT JOIN releases_rev rr ON c.type = 1 AND c.id = rr.id
- LEFT JOIN producers_rev pr ON c.type = 2 AND c.id = pr.id
+ LEFT JOIN vn_rev vr ON c.type = 'v' AND c.id = vr.id
+ LEFT JOIN releases_rev rr ON c.type = 'r' AND c.id = rr.id
+ LEFT JOIN producers_rev pr ON c.type = 'p' AND c.id = pr.id
JOIN users u ON u.id = c.requester
WHERE c.id > ? AND c.requester <> 1
ORDER BY c.added|
diff --git a/lib/Multi/Maintenance.pm b/lib/Multi/Maintenance.pm
index e29c7b52..4f816e56 100644
--- a/lib/Multi/Maintenance.pm
+++ b/lib/Multi/Maintenance.pm
@@ -17,13 +17,13 @@ sub spawn {
package_states => [
$p => [qw|
_start shutdown set_daily daily set_monthly monthly log_stats
- vncache tagcache vnpopularity
- usercache statscache revcache logrotate
+ vncache tagcache vnpopularity cleangraphs
+ usercache statscache logrotate
|],
],
heap => {
- daily => [qw|vncache tagcache vnpopularity|],
- monthly => [qw|usercache statscache revcache logrotate|],
+ daily => [qw|vncache tagcache vnpopularity cleangraphs|],
+ monthly => [qw|usercache statscache logrotate|],
@_,
},
);
@@ -50,7 +50,7 @@ sub set_daily {
# (GMT because we're calculating on the UNIX timestamp, I can easily add an
# offset if necessary, but it doesn't really matter what time this cron
# runs, as long as it's run on a daily basis)
- $_[KERNEL]->alarm(daily => int(time/86400+1)*86400);
+ $_[KERNEL]->alarm(daily => int((time+3)/86400+1)*86400);
}
@@ -70,7 +70,7 @@ sub set_monthly {
# We do this by simply incrementing the timestamp with one day and checking gmtime()
# for a month change. This might not be very reliable, but should be enough for
# our purposes.
- my $nextday = int(time/86400+1)*86400;
+ my $nextday = int((time+3)/86400+1)*86400;
my $thismonth = (gmtime)[5]*100+(gmtime)[4]; # year*100 + month, for easy comparing
$nextday += 86400 while (gmtime $nextday)[5]*100+(gmtime $nextday)[4] <= $thismonth;
$_[KERNEL]->alarm(monthly => $nextday);
@@ -99,24 +99,33 @@ sub log_stats { # num, res, action, time
sub vncache {
- # this takes about 30s to complete. We really need to search for an alternative
+ # this takes about 40s to complete. We really need to search for an alternative
# method of keeping the c_* columns in the vn table up-to-date.
$_[KERNEL]->post(pg => do => 'SELECT update_vncache(0)', undef, 'log_stats', 'vncache');
}
sub tagcache {
- # this still takes "only" about 3 seconds max. Let's hope that doesn't increase too much.
+ # takes about 18 seconds max. ouch, but still kind-of acceptable
$_[KERNEL]->post(pg => do => 'SELECT tag_vn_calc()', undef, 'log_stats', 'tagcache');
}
sub vnpopularity {
- # still takes at most 2 seconds. Againt, let's hope that doesn't increase...
+ # still takes at most 2 seconds. let's hope that doesn't increase...
$_[KERNEL]->post(pg => do => 'SELECT update_vnpopularity()', undef, 'log_stats', 'vnpopularity');
}
+sub cleangraphs {
+ # should be pretty fast
+ $_[KERNEL]->post(pg => do => q|
+ DELETE FROM relgraphs vg
+ WHERE NOT EXISTS(SELECT 1 FROM vn WHERE rgraph = vg.id)
+ AND NOT EXISTS(SELECT 1 FROM producers WHERE rgraph = vg.id)
+ |, undef, 'log_stats', 'cleangraphs');
+}
+
#
# M O N T H L Y J O B S
@@ -164,14 +173,6 @@ sub statscache {
}
-sub revcache {
- # This -really- shouldn't be necessary...
- # Currently takes about 25 seconds to complete
- $_[KERNEL]->post(pg => do => q|SELECT update_rev('vn', ''), update_rev('releases', ''), update_rev('producers', '')|,
- undef, 'log_stats', 'revcache');
-}
-
-
sub logrotate {
my $dir = sprintf '%s/old', $VNDB::M{log_dir};
mkdir $dir if !-d $dir;
diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm
index e427caf2..b3f9bb46 100644
--- a/lib/Multi/RG.pm
+++ b/lib/Multi/RG.pm
@@ -9,6 +9,8 @@ use strict;
use warnings;
use POE 'Wheel::Run', 'Filter::Stream';
use Encode 'encode_utf8';
+use XML::Parser;
+use XML::Writer;
use Time::HiRes 'time';
@@ -17,15 +19,13 @@ sub spawn {
POE::Session->create(
package_states => [
$p => [qw|
- _start shutdown check_rg creategraph getrel builddot buildgraph savegraph
+ _start shutdown check_rg creategraph getrel builddot savegraph finish
proc_stdin proc_stdout proc_stderr proc_closed proc_child
|],
],
heap => {
font => 'Arial',
fsize => [ 9, 7, 10 ], # nodes, edges, node_title
- imgdir => '/www/vndb/static/rg',
- moy => [qw| Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec |],
dot => '/usr/bin/dot',
check_delay => 3600,
@_,
@@ -51,10 +51,12 @@ sub shutdown {
sub check_rg {
- return if $_[HEAP]{vid};
- $_[KERNEL]->call(pg => query =>
- 'SELECT v.id FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE rgraph IS NULL AND hidden = FALSE LIMIT 1',
- undef, 'creategraph');
+ return if $_[HEAP]{id};
+ $_[KERNEL]->call(pg => query => q|
+ SELECT 'v' AS type, v.id FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE rgraph IS NULL AND hidden = FALSE
+ UNION
+ SELECT 'p', p.id FROM producers p JOIN producers_relations pr ON pr.pid1 = p.latest WHERE rgraph IS NULL AND hidden = FALSE
+ LIMIT 1|, undef, 'creategraph');
}
@@ -62,148 +64,138 @@ sub creategraph { # num, res
return $_[KERNEL]->delay('check_rg', $_[HEAP]{check_delay}) if $_[ARG0] == 0;
$_[HEAP]{start} = time;
- $_[HEAP]{vid} = $_[ARG1][0]{id};
- $_[HEAP]{rels} = {}; # relations (key=vid1-vid2, value=relation)
- $_[HEAP]{nodes} = {}; # nodes (key=vid, value= 0:found, 1:processed)
-
- $_[KERNEL]->post(pg => query =>
- 'SELECT vid2 AS id, relation FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE v.id = ?',
- [ $_[HEAP]{vid} ], 'getrel', $_[HEAP]{vid});
+ $_[HEAP]{id} = $_[ARG1][0]{id};
+ $_[HEAP]{type} = $_[ARG1][0]{type};
+ $_[HEAP]{rels} = {}; # relations (key=id1-id2, value=relation)
+ $_[HEAP]{nodes} = {}; # nodes (key=id, value= 0:found, 1:processed)
+
+ $_[KERNEL]->post(pg => query => $_[HEAP]{type} eq 'v'
+ ? 'SELECT vid2 AS id, relation FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE v.id = ?'
+ : 'SELECT pid2 AS id, relation FROM producers p JOIN producers_relations pr ON pr.pid1 = p.latest WHERE p.id = ?',
+ [ $_[HEAP]{id} ], 'getrel', $_[HEAP]{id});
}
-sub getrel { # num, res, vid
+sub getrel { # num, res, id
my $id = $_[ARG2];
$_[HEAP]{nodes}{$id} = 1;
for($_[ARG0] > 0 ? @{$_[ARG1]} : ()) {
- $_[HEAP]{rels}{$id.'-'.$_->{id}} = reverserel($_->{relation}) if $id < $_->{id};
- $_[HEAP]{rels}{$_->{id}.'-'.$id} = $_->{relation} if $id > $_->{id};
+ $_[HEAP]{rels}{$id.'-'.$_->{id}} = $VNDB::S{ $_[HEAP]{type} eq 'v' ? 'vn_relations' : 'prod_relations' }{$_->{relation}}[1] if $id < $_->{id};
+ $_[HEAP]{rels}{$_->{id}.'-'.$id} = $_->{relation} if $id > $_->{id};
if(!exists $_[HEAP]{nodes}{$_->{id}}) {
$_[HEAP]{nodes}{$_->{id}} = 0;
- $_[KERNEL]->post(pg => query =>
- 'SELECT vid2 AS id, relation FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE v.id = ?',
+ $_[KERNEL]->post(pg => query => $_[HEAP]{type} eq 'v'
+ ? 'SELECT vid2 AS id, relation FROM vn v JOIN vn_relations vr ON vr.vid1 = v.latest WHERE v.id = ?'
+ : 'SELECT pid2 AS id, relation FROM producers p JOIN producers_relations pr ON pr.pid1 = p.latest WHERE p.id = ?',
[ $_->{id} ], 'getrel', $_->{id});
}
}
- # do we have all relations now? get VN info
+ # do we have all relations now? get node info
if(!grep !$_, values %{$_[HEAP]{nodes}}) {
- $_[KERNEL]->post(pg => query =>
- 'SELECT v.id, vr.title, v.c_released AS date, v.c_languages AS lang
- FROM vn v JOIN vn_rev vr ON vr.id = v.latest
- WHERE v.id IN('.join(', ', map '?', keys %{$_[HEAP]{nodes}}).')',
+ my $ids = join(', ', map '?', keys %{$_[HEAP]{nodes}});
+ $_[KERNEL]->post(pg => query => $_[HEAP]{type} eq 'v'
+ ? "SELECT v.id, vr.title, v.c_released AS date, v.c_languages AS lang FROM vn v JOIN vn_rev vr ON vr.id = v.latest WHERE v.id IN($ids) ORDER BY v.c_released"
+ : "SELECT p.id, pr.name, pr.lang, pr.type FROM producers p JOIN producers_rev pr ON pr.id = p.latest WHERE p.id IN($ids) ORDER BY pr.name",
[ keys %{$_[HEAP]{nodes}} ], 'builddot');
}
}
sub builddot { # num, res
- my $vns = $_[ARG1];
+ my $nodes = $_[ARG1];
my $gv =
qq|graph rgraph {\n|.
- qq|\tratio = "compress"\n|.
- qq|\tgraph [ bgcolor="#ffffff00" ]\n|.
qq|\tnode [ fontname = "$_[HEAP]{font}", shape = "plaintext",|.
- qq| fontsize = $_[HEAP]{fsize}[0], style = "setlinewidth(0.5)", fontcolor = "#cccccc", color = "#225588" ]\n|.
+ qq| fontsize = $_[HEAP]{fsize}[0], fontcolor = "#333333", color = "#111111" ]\n|.
qq|\tedge [ labeldistance = 2.5, labelangle = -20, labeljust = 1, minlen = 2, dir = "both",|.
- qq| fontname = $_[HEAP]{font}, fontsize = $_[HEAP]{fsize}[1], arrowsize = 0.7, color = "#225588", fontcolor = "#cccccc" ]\n|;
-
- # insert all nodes, ordered by release date
- for (sort { $a->{date} <=> $b->{date} } @$vns) {
- my $date = sprintf '%08d', $_->{date};
- $date =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2<13?($_[HEAP]{moy}[$2-1].' '):'').$1)#e;
-
- my $title = $_->{title};
- $title = substr($title, 0, 27).'...' if length($title) > 30;
- $title =~ s/&/&amp;/g;
- $title =~ s/>/&gt;/g;
- $title =~ s/</&lt;/g;
-
- my $tooltip = $_->{title};
- $tooltip =~ s/\\/\\\\/g;
- $tooltip =~ s/"/\\"/g;
-
- $gv .= sprintf
- qq|\tv%d [ URL = "/v%d", tooltip = "%s" label=<|.
- q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#00000033">|.
- q|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR>|.
- q|<TR><TD> %s </TD><TD> %s </TD></TR>|.
- qq|</TABLE>> ]\n|,
- $_->{id}, $_->{id}, encode_utf8($tooltip), $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->{lang}||'N/A';
- }
+ qq| fontname = $_[HEAP]{font}, fontsize = $_[HEAP]{fsize}[1], arrowsize = 0.7, color = "#111111", fontcolor = "#333333" ]\n|;
- # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing
- my @rels = map {
- /^([0-9]+)-([0-9]+)$/;
- my $vn1 = (grep $1 == $_->{id}, @$vns)[0];
- my $vn2 = (grep $2 == $_->{id}, @$vns)[0];
- [ $1, $2, $_[HEAP]{rels}{$_}, $vn1->{date}, $vn2->{date} ]
- } keys %{$_[HEAP]{rels}};
+ # insert all nodes
+ $gv .= $_[HEAP]{type} eq 'v' ? _vnnode($_, $_[HEAP]) : _prodnode($_, $_[HEAP]) for @$nodes;
- # insert all edges, ordered by release date again
- for (sort { ($a->[3]>$a->[4]?$a->[4]:$a->[3]) <=> ($b->[3]>$b->[4]?$b->[4]:$b->[3]) } @rels) {
- # [older game] -> [newer game]
- if($_->[4] > $_->[3]) {
- ($_->[0], $_->[1]) = ($_->[1], $_->[0]);
- $_->[2] = reverserel($_->[2]);
- }
- my $label =
- $VNDB::S{vn_relations}[$_->[2]][1]
- ? qq|headlabel = "$VNDB::S{vn_relations}[$_->[2]][0]", taillabel = "$VNDB::S{vn_relations}[$_->[2]-1][0]"| :
- $VNDB::S{vn_relations}[$_->[2]+1][1]
- ? qq|headlabel = "$VNDB::S{vn_relations}[$_->[2]][0]", taillabel = "$VNDB::S{vn_relations}[$_->[2]+1][0]"|
- : qq|label = " $VNDB::S{vn_relations}[$_->[2]][0]"|;
- $gv .= qq|\tv$$_[1] -- v$$_[0] [ $label ]\n|;
- }
+ # ...and relations
+ $gv .= $_[HEAP]{type} eq 'v' ? _vnrels($_[HEAP]{rels}, $nodes) : _prodrels($_[HEAP]{rels}, $nodes);
$gv .= "}\n";
- # get ID
- $_[KERNEL]->post(pg => query => 'INSERT INTO relgraph (cmap) VALUES (\'\') RETURNING id', undef, 'buildgraph', \$gv);
-}
-
-
-sub buildgraph { # num, res, \$gv
- $_[HEAP]{gid} = $_[ARG1][0]{id};
- $_[HEAP]{graph} = sprintf('%s/%02d/%d.png', $_[HEAP]{imgdir}, $_[ARG1][0]{id} % 100, $_[ARG1][0]{id});
- $_[HEAP]{cmap} = '';
-
- # roughly equivalent to:
- # cat layout.txt | dot -Tpng -o graph.png -Tcmapx
+ # Pass our dot file to graphviz
+ $_[HEAP]{svg} = '';
$_[HEAP]{proc} = POE::Wheel::Run->new(
Program => $_[HEAP]{dot},
- ProgramArgs => [ '-Tpng', '-o', $_[HEAP]{graph}, '-Tcmapx' ],
+ ProgramArgs => [ '-Tsvg' ],
StdioFilter => POE::Filter::Stream->new(),
StdinEvent => 'proc_stdin',
StdoutEvent => 'proc_stdout',
StderrEvent => 'proc_stderr',
CloseEvent => 'proc_closed',
);
- $_[HEAP]{proc}->put(${$_[ARG2]});
+ $_[HEAP]{proc}->put($gv);
}
sub savegraph {
- my $vids = join ',', sort map int, keys %{$_[HEAP]{nodes}};
+ # Before saving the SVG output, we'll modify it a little:
+ # - Remove comments
+ # - Add svg: prefix to all tags
+ # - Remove xmlns declarations (this is set in the html)
+ # - Remove <title> elements (unused)
+ # - Remove id attributes (unused)
+ # - Remove first <polygon> element (emulates the background color)
+ # - Replace stroke and fill attributes with classes (so that coloring is done in CSS)
+ my $svg = '';
+ my $w = XML::Writer->new(OUTPUT => \$svg);
+ my $p = XML::Parser->new;
+ $p->setHandlers(
+ Start => sub {
+ my($expat, $el, %attr) = @_;
+ return if $el eq 'title' || $expat->in_element('title');
+ return if $el eq 'polygon' && $expat->depth == 2;
+
+ $attr{class} = 'border' if $attr{stroke} && $attr{stroke} eq '#111111';
+ $attr{class} = 'nodebg' if $attr{fill} && $attr{fill} eq '#222222';
+
+ delete @attr{qw|stroke fill id xmlns xmlns:xlink|};
+ $el eq 'path' || $el eq 'polygon'
+ ? $w->emptyTag("svg:$el", %attr)
+ : $w->startTag("svg:$el", %attr);
+ },
+ End => sub {
+ my($expat, $el) = @_;
+ return if $el eq 'title' || $expat->in_element('title');
+ return if $el eq 'polygon' && $expat->depth == 2;
+ $w->endTag("svg:$el") if $el ne 'path' && $el ne 'polygon';
+ },
+ Char => sub {
+ my($expat, $str) = @_;
+ return if $expat->in_element('title');
+ $w->characters($str) if $str !~ /^[\s\t\r\n]*$/s;
+ }
+ );
+ $p->parsestring($_[HEAP]{svg});
+ $w->end();
+
+ # save the processed SVG in the database and fetch graph ID
+ $_[KERNEL]->post(pg => query => 'INSERT INTO relgraphs (svg) VALUES (?) RETURNING id', [ $svg ], 'finish');
+}
- # chmod graph
- chmod 0666, $_[HEAP]{graph};
- # save the image map in the database
- $_[KERNEL]->post(pg => do => 'UPDATE relgraph SET cmap = ? WHERE id = ?',
- [ "<!-- V:$vids -->\n$_[HEAP]{cmap}", $_[HEAP]{gid} ]);
+sub finish { # num, res
+ my $id = $_[ARG1][0]{id};
+ my $ids = join ',', sort map int, keys %{$_[HEAP]{nodes}};
+ my $table = $_[HEAP]{type} eq 'v' ? 'vn' : 'producers';
- # update the VN table
- $_[KERNEL]->post(pg => do => "UPDATE vn SET rgraph = ? WHERE id IN($vids)", [ $_[HEAP]{gid} ]);
+ # update the table
+ $_[KERNEL]->post(pg => do => "UPDATE $table SET rgraph = ? WHERE id IN($ids)", [ $id ]);
# log
- $_[KERNEL]->call(core => log => 'Generated relation graph in %.2fs, V: %s', time-$_[HEAP]{start}, $vids);
+ $_[KERNEL]->call(core => log => 'Generated relation graph #%d in %.2fs, %s: %s', $id, time-$_[HEAP]{start}, uc $_[HEAP]{type}, $ids);
# clean up
- delete @{$_[HEAP]}{qw| start vid nodes rels gid graph cmap proc |};
+ delete @{$_[HEAP]}{qw| start id type nodes rels svg proc |};
# check for more things to do
$_[KERNEL]->yield('check_rg');
@@ -216,7 +208,7 @@ sub proc_stdin {
$_[HEAP]{proc}->shutdown_stdin;
}
sub proc_stdout {
- $_[HEAP]{cmap} .= $_[ARG0];
+ $_[HEAP]{svg} .= $_[ARG0];
}
sub proc_stderr {
$_[KERNEL]->call(core => log => 'GraphViz STDERR: %s', $_[ARG0]);
@@ -230,9 +222,107 @@ sub proc_child {
-# non-POE helper function
-sub reverserel { # relation
- return $VNDB::S{vn_relations}[$_[0]][1] ? $_[0]-1 : $VNDB::S{vn_relations}[$_[0]+1][1] ? $_[0]+1 : $_[0];
+# non-POE helper functions
+
+sub _vnnode {
+ my($n, $heap) = @_;
+
+ my $date = sprintf '%08d', $n->{date};
+ $date =~ s{^([0-9]{4})([0-9]{2})([0-9]{2})$}{
+ $1 == 0 ? 'unknown'
+ : $1 == 9999 ? 'TBA'
+ : $2 == 99 ? $1
+ : $3 == 99 ? "$1-$2" : "$1-$2-$3"
+ }e;
+
+ my $title = $n->{title};
+ $title = substr($title, 0, 27).'...' if length($title) > 30;
+ $title =~ s/&/&amp;/g;
+ $title =~ s/>/&gt;/g;
+ $title =~ s/</&lt;/g;
+
+ my $tooltip = $n->{title};
+ $tooltip =~ s/\\/\\\\/g;
+ $tooltip =~ s/"/\\"/g;
+
+ return sprintf
+ qq|\tv%d [ URL = "/v%d", tooltip = "%s", label=<|.
+ q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|.
+ q|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR>|.
+ q|<TR><TD> %s </TD><TD> %s </TD></TR>|.
+ qq|</TABLE>> ]\n|,
+ $_->{id}, $_->{id}, encode_utf8($tooltip), $heap->{fsize}[2], encode_utf8($title), $date, $n->{lang}||'N/A';
+}
+
+
+sub _vnrels {
+ my($rels, $vns) = @_;
+ my $r = '';
+
+ # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing
+ my @rels = map {
+ /^([0-9]+)-([0-9]+)$/;
+ my $vn1 = (grep $1 == $_->{id}, @$vns)[0];
+ my $vn2 = (grep $2 == $_->{id}, @$vns)[0];
+ [ $1, $2, $rels->{$_}, $vn1->{date}, $vn2->{date} ]
+ } keys %$rels;
+
+ # insert all edges, ordered by release date again
+ for (sort { ($a->[3]>$a->[4]?$a->[4]:$a->[3]) <=> ($b->[3]>$b->[4]?$b->[4]:$b->[3]) } @rels) {
+ # [older game] -> [newer game]
+ if($_->[4] > $_->[3]) {
+ ($_->[0], $_->[1]) = ($_->[1], $_->[0]);
+ $_->[2] = $VNDB::S{vn_relations}{$_->[2]}[1];
+ }
+ my $rev = $VNDB::S{vn_relations}{$_->[2]}[1];
+ my $label = $rev ne $_->[2]
+ ? qq|headlabel = "\$____vnrel_$_->[2]____\$", taillabel = "\$____vnrel_${rev}____\$"|
+ : qq|label = "\$____vnrel_$_->[2]____\$"|;
+ $r .= qq|\tv$$_[1] -- v$$_[0] [ $label ]\n|;
+ }
+ return $r;
+}
+
+
+sub _prodnode {
+ my($n, $heap) = @_;
+
+ my $name = $n->{name};
+ $name = substr($name, 0, 27).'...' if length($name) > 30;
+ $name =~ s/&/&amp;/g;
+ $name =~ s/>/&gt;/g;
+ $name =~ s/</&lt;/g;
+
+ my $tooltip = $n->{name};
+ $tooltip =~ s/\\/\\\\/g;
+ $tooltip =~ s/"/\\"/g;
+
+ return sprintf
+ qq|\tp%d [ URL = "/p%d", tooltip = "%s", label=<|.
+ q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|.
+ q|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR>|.
+ q|<TR><TD ALIGN="CENTER"> $_lang_%s_$ </TD><TD ALIGN="CENTER"> $_ptype_%s_$ </TD></TR>|.
+ qq|</TABLE>> ]\n|,
+ $_->{id}, $_->{id}, encode_utf8($tooltip), $heap->{fsize}[2], encode_utf8($name), $n->{lang}, $n->{type};
+}
+
+
+sub _prodrels {
+ my($rels, $prods) = @_;
+ my $r = '';
+
+ for (keys %$rels) {
+ /^([0-9]+)-([0-9]+)$/;
+ my $p1 = (grep $1 == $_->{id}, @$prods)[0];
+ my $p2 = (grep $2 == $_->{id}, @$prods)[0];
+
+ my $rev = $VNDB::S{prod_relations}{$rels->{$_}}[1];
+ my $label = $rev ne $rels->{$_}
+ ? qq|headlabel = "\$____prodrel_${rev}____\$", taillabel = "\$____prodrel_$rels->{$_}____\$"|
+ : qq|label = "\$____prodrel_$rels->{$_}____\$"|;
+ $r .= qq|\tp$p1->{id} -- p$p2->{id} [ $label ]\n|;
+ }
+ return $r;
}