# # Multi::RG - Relation graph generator # package Multi::RG; use strict; use warnings; use POE 'Wheel::Run', 'Filter::Stream'; use Encode 'encode_utf8'; use Time::HiRes 'time'; sub spawn { my $p = shift; POE::Session->create( package_states => [ $p => [qw| _start shutdown check_rg creategraph getrel builddot buildgraph savegraph 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, @_, } ); } sub _start { $_[KERNEL]->alias_set('rg'); $_[KERNEL]->sig(CHLD => 'proc_child'); $_[KERNEL]->sig(shutdown => 'shutdown'); $_[KERNEL]->post(pg => listen => relgraph => 'check_rg'); $_[KERNEL]->yield('check_rg'); } sub shutdown { $_[KERNEL]->delay('check_rg'); $_[KERNEL]->post(pg => unlisten => 'relgraph'); $_[KERNEL]->alias_remove('rg'); } 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'); } 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}); } sub getrel { # num, res, vid 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}; 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 = ?', [ $_->{id} ], 'getrel', $_->{id}); } } # do we have all relations now? get VN 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}}).')', [ keys %{$_[HEAP]{nodes}} ], 'builddot'); } } sub builddot { # num, res my $vns = $_[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|\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/&/&/g; $title =~ s/>/>/g; $title =~ s/{title}; $tooltip =~ s/\\/\\\\/g; $tooltip =~ s/"/\\"/g; $gv .= sprintf qq|\tv%d [ URL = "/v%d", tooltip = "%s" label=<|. q||. q||. q||. qq|
%s
%s %s
> ]\n|, $_->{id}, $_->{id}, encode_utf8($tooltip), $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->{lang}||'N/A'; } # @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 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|; } $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 $_[HEAP]{proc} = POE::Wheel::Run->new( Program => $_[HEAP]{dot}, ProgramArgs => [ '-Tpng', '-o', $_[HEAP]{graph}, '-Tcmapx' ], StdioFilter => POE::Filter::Stream->new(), StdinEvent => 'proc_stdin', StdoutEvent => 'proc_stdout', StderrEvent => 'proc_stderr', CloseEvent => 'proc_closed', ); $_[HEAP]{proc}->put(${$_[ARG2]}); } sub savegraph { my $vids = join ',', sort map int, keys %{$_[HEAP]{nodes}}; # chmod graph chmod 0666, $_[HEAP]{graph}; # save the image map in the database $_[KERNEL]->post(pg => do => 'UPDATE relgraph SET cmap = ? WHERE id = ?', [ "\n$_[HEAP]{cmap}", $_[HEAP]{gid} ]); # update the VN table $_[KERNEL]->post(pg => do => "UPDATE vn SET rgraph = ? WHERE id IN($vids)", [ $_[HEAP]{gid} ]); # log $_[KERNEL]->call(core => log => 'Generated relation graph in %.2fs, V: %s', time-$_[HEAP]{start}, $vids); # clean up delete @{$_[HEAP]}{qw| start vid nodes rels gid graph cmap proc |}; # check for more things to do $_[KERNEL]->yield('check_rg'); } # POE handlers for communication with GraphViz sub proc_stdin { $_[HEAP]{proc}->shutdown_stdin; } sub proc_stdout { $_[HEAP]{cmap} .= $_[ARG0]; } sub proc_stderr { $_[KERNEL]->call(core => log => 'GraphViz STDERR: %s', $_[ARG0]); } sub proc_closed { $_[KERNEL]->yield('savegraph'); } sub proc_child { 1; # do nothing, just make sure SIGCHLD is handled to reap the process } # 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]; } 1;