diff options
author | Yorhel <git@yorhel.nl> | 2009-07-19 21:43:08 +0200 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2009-07-19 21:43:08 +0200 |
commit | 1dcc52e87a1e07835c196dc039dd11df4db0cdbb (patch) | |
tree | 73310308348918d77cc6f67674b2d22c4859e85b /lib/Multi/RG.pm | |
parent | b8649adc46bd1964e90387400988b984744b0e3e (diff) |
Rewrote Multi::RG
It should be a bit more efficient and non-blocking. Also a lot less
verbose with logging.
Diffstat (limited to 'lib/Multi/RG.pm')
-rw-r--r-- | lib/Multi/RG.pm | 217 |
1 files changed, 88 insertions, 129 deletions
diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm index d16d63b5..303b2e54 100644 --- a/lib/Multi/RG.pm +++ b/lib/Multi/RG.pm @@ -9,6 +9,7 @@ use strict; use warnings; use POE 'Wheel::Run', 'Filter::Stream'; use Encode 'encode_utf8'; +use Time::HiRes 'time'; sub spawn { @@ -16,8 +17,7 @@ sub spawn { POE::Session->create( package_states => [ $p => [qw| - _start cmd_relgraph - creategraph getrel builddot buildgraph savegraph completegraph + _start shutdown check_rg creategraph getrel builddot buildgraph savegraph proc_stdin proc_stdout proc_stderr proc_closed proc_child |], ], @@ -27,6 +27,7 @@ sub spawn { 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, @_, } ); @@ -36,94 +37,68 @@ sub spawn { sub _start { $_[KERNEL]->alias_set('rg'); $_[KERNEL]->sig(CHLD => 'proc_child'); - $_[KERNEL]->call(core => register => qr/^relgraph ((?:[0-9]+)(?:\s+[0-9]+)*|all)$/, 'cmd_relgraph'); - - # regenerate all relation graphs once a month - $_[KERNEL]->post(core => addcron => '0 3 1 * *', 'relgraph all'); + $_[KERNEL]->sig(shutdown => 'shutdown'); + $_[KERNEL]->yield('check_rg'); } -sub cmd_relgraph { - $_[HEAP]{curcmd} = $_[ARG0]; +sub shutdown { + $_[KERNEL]->delay('check_rg'); +} - # determine vns to generate graphs for - if($_[ARG1] ne 'all') { - $_[HEAP]{todo} = [ split /\s/, $_[ARG1] ]; - } else { - my $q = $Multi::SQL->prepare('SELECT id FROM vn WHERE hidden = FALSE'); - $q->execute; - $_[HEAP]{todo} = [ map { $_->[0] } @{$q->fetchall_arrayref([])} ]; - } - # generate first graph - $_[KERNEL]->yield(creategraph => $_[HEAP]{todo}[0]); +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 { # id - # Function order: - # creategraph (inits vars and initates getrel) - # getrel (recursive - fetches relation and vn data) - # if !rels - # completegraph (checks for other vids in the queue, exits otherwise) - # else - # builddot (creates input for graphviz) - # buildgraph (fetches graph ID and calls grapviz) - # savegraph (writes cmap, chmods files, updates database entries) - # completegraph - - $_[KERNEL]->call(core => log => 3, 'Processing graph for v%d', $_[ARG0]); - - $_[HEAP]{rels} = {}; # relations (key=vid1-vid2, value=relation) - $_[HEAP]{nodes} = {}; # nodes (key=vid, value=[ vid, title, date, lang, processed ]) - $_[HEAP]{vid} = $_[ARG0]; - $_[KERNEL]->yield(getrel => $_[ARG0]); +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 { # vid - $_[KERNEL]->call(core => log => 3, 'Fetching relations for v%d', $_[ARG0]); +sub getrel { # num, res, vid + my $id = $_[ARG2]; + $_[HEAP]{nodes}{$id} = 1; - my $s = $Multi::SQL->prepare(q| - SELECT vr1.vid AS vid1, r.vid2, r.relation, vr1.title AS title1, vr2.title AS title2, - v1.c_released AS date1, v2.c_released AS date2, v1.c_languages AS lang1, v2.c_languages AS lang2 - FROM vn_relations r - JOIN vn_rev vr1 ON r.vid1 = vr1.id - JOIN vn v1 ON v1.latest = vr1.id - JOIN vn v2 ON r.vid2 = v2.id - JOIN vn_rev vr2 ON v2.latest = vr2.id - WHERE (r.vid2 = ? OR vr1.vid = ?)| - ); - $s->execute($_[ARG0], $_[ARG0]); - while(my $r = $s->fetchrow_hashref) { - $_[HEAP]{rels}{$r->{vid1}.'-'.$r->{vid2}} = reverserel($r->{relation}) if $r->{vid1} < $r->{vid2}; - $_[HEAP]{rels}{$r->{vid2}.'-'.$r->{vid1}} = $r->{relation} if $r->{vid1} > $r->{vid2}; - - for (1,2) { - my($vid, $title, $date, $lang) = @$r{ "vid$_", "title$_", "date$_", "lang$_" }; - if(!$_[HEAP]{nodes}{$vid}) { - $_[HEAP]{nodes}{$vid} = [ $vid, $title, $date, $lang, 0 ]; - $_[KERNEL]->yield(getrel => $vid) if $vid != $_[ARG0]; - } + 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}); } - $_[HEAP]{nodes}{$_[ARG0]}[4]++; } - if(!grep !$_->[4], values %{$_[HEAP]{nodes}}) { - if(!keys %{$_[HEAP]{nodes}}) { - $_[KERNEL]->call(core => log => 3, 'No relation graph for v%d', $_[HEAP]{vid}); - $Multi::SQL->do('UPDATE vn SET rgraph = NULL WHERE id = ?', undef, $_[HEAP]{vid}); - $_[HEAP]{nodes}{$_[HEAP]{vid}} = []; - $_[KERNEL]->yield('completegraph'); - return; - } - $_[KERNEL]->call(core => log => 3, 'Fetched all relation data'); - $_[KERNEL]->yield('builddot') + # 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 { +sub builddot { # num, res + my $vns = $_[ARG1]; + my $gv = qq|graph rgraph {\n|. qq|\tratio = "compress"\n|. @@ -133,18 +108,18 @@ sub builddot { 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->[2] <=> $b->[2] } values %{$_[HEAP]{nodes}}) { - my $date = sprintf '%08d', $_->[2]; + # 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 = $_->[1]; + my $title = $_->{title}; $title = substr($title, 0, 27).'...' if length($title) > 30; $title =~ s/&/&/g; $title =~ s/>/>/g; $title =~ s/</</g; - my $tooltip = $_->[1]; + my $tooltip = $_->{title}; $tooltip =~ s/\\/\\\\/g; $tooltip =~ s/"/\\"/g; @@ -154,99 +129,85 @@ sub builddot { 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|, - $_->[0], $_->[0], encode_utf8($tooltip), $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->[3]||'N/A'; + $_->{id}, $_->{id}, encode_utf8($tooltip), $_[HEAP]{fsize}[2], encode_utf8($title), $date, $_->{lang}||'N/A'; } - # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing + # @rels = ([ vid1, vid2, relation, date1, date2 ], ..), for easier processing my @rels = map { /^([0-9]+)-([0-9]+)$/; - [ $1, $2, $_[HEAP]{rels}{$_}, $_[HEAP]{nodes}{$1}[2], $_[HEAP]{nodes}{$2}[2] ] + 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 + # 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] + # [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]"|; - + $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"; - #print $gv; - $_[HEAP]{gv} = \$gv; - $_[KERNEL]->yield('buildgraph'); + + # get ID + $_[KERNEL]->post(pg => query => 'INSERT INTO relgraph (cmap) VALUES (\'\') RETURNING id', undef, 'buildgraph', \$gv); } -sub buildgraph { - # get a new ID - my $gid = $Multi::SQL->prepare("INSERT INTO relgraph (cmap) VALUES ('') RETURNING id"); - $gid->execute; - $gid = $gid->fetchrow_arrayref->[0]; - $_[HEAP]{gid} = [ - $gid, - sprintf('%s/%02d/%d.png', $_[HEAP]{imgdir}, $gid % 100, $gid), - ]; +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]{gid}[1], '-Tcmapx' ], + 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(${$_[HEAP]{gv}}); - $_[HEAP]{cmap} = ''; + $_[HEAP]{proc}->put(${$_[ARG2]}); } sub savegraph { - # save the image map - $Multi::SQL->do('UPDATE relgraph SET cmap = ? WHERE id = ?', undef, - '<!-- V:'.join(',',keys %{$_[HEAP]{nodes}})." -->\n$_[HEAP]{cmap}", $_[HEAP]{gid}[0]); + my $vids = join ',', sort map int, keys %{$_[HEAP]{nodes}}; - # proper chmod - chmod 0666, $_[HEAP]{gid}[1]; + # chmod graph + chmod 0666, $_[HEAP]{graph}; - # update the VN table - $Multi::SQL->do(sprintf q| - UPDATE vn - SET rgraph = %d - WHERE id IN(%s)|, - $_[HEAP]{gid}[0], join(',', keys %{$_[HEAP]{nodes}})); + # save the image map in the database + $_[KERNEL]->post(pg => do => 'UPDATE relgraph SET cmap = ? WHERE id = ?', + [ "<!-- V:$vids -->\n$_[HEAP]{cmap}", $_[HEAP]{gid} ]); - $_[KERNEL]->yield('completegraph'); -} + # 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); -sub completegraph { - $_[KERNEL]->call(core => log => 3, 'Generated the relation graph for v%d', $_[HEAP]{vid}); + # clean up + delete @{$_[HEAP]}{qw| start vid nodes rels gid graph cmap proc |}; - # remove processed vns, and check for other graphs in the queue - $_[HEAP]{todo} = [ grep { !$_[HEAP]{nodes}{$_} } @{$_[HEAP]{todo}} ]; - if(@{$_[HEAP]{todo}}) { - $_[KERNEL]->yield(creategraph => $_[HEAP]{todo}[0]); - } else { - $_[KERNEL]->post(core => finish => $_[HEAP]{curcmd}); - delete @{$_[HEAP]}{qw| vid nodes rels curcmd gv todo gid cmap |}; - } + # check for more things to do + $_[KERNEL]->yield('check_rg'); } - # POE handlers for communication with GraphViz sub proc_stdin { $_[HEAP]{proc}->shutdown_stdin; @@ -255,11 +216,10 @@ sub proc_stdout { $_[HEAP]{cmap} .= $_[ARG0]; } sub proc_stderr { - $_[KERNEL]->call(core => log => 1, 'GraphViz STDERR: %s', $_[ARG0]); + $_[KERNEL]->call(core => log => 'GraphViz STDERR: %s', $_[ARG0]); } sub proc_closed { $_[KERNEL]->yield('savegraph'); - undef $_[HEAP]{proc}; } sub proc_child { 1; # do nothing, just make sure SIGCHLD is handled to reap the process @@ -267,8 +227,7 @@ sub proc_child { - -# Not a POE handler, just a small macro +# 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]; } |