diff options
author | yorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b> | 2008-04-24 17:48:59 +0000 |
---|---|---|
committer | yorhel <yorhel@1fe2e327-d9db-4752-bcf7-ef0cb4a1748b> | 2008-04-24 17:48:59 +0000 |
commit | d2efb163c11a11e02abd7251fdfde3cb54c710ef (patch) | |
tree | 848de5db61c434d38adc8871f4999ea344b196fe /lib/Multi/RG.pm | |
parent | 491d871612f7e4d351d533d30fe942332132ea41 (diff) |
See the diff for lib/ChangeLog...
git-svn-id: svn://vndb.org/vndb@4 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b
Diffstat (limited to 'lib/Multi/RG.pm')
-rw-r--r-- | lib/Multi/RG.pm | 248 |
1 files changed, 248 insertions, 0 deletions
diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm new file mode 100644 index 00000000..9133a7a6 --- /dev/null +++ b/lib/Multi/RG.pm @@ -0,0 +1,248 @@ + +# +# Multi::RG - Relation graph generator +# + +package Multi::RG; + +use strict; +use warnings; +use POE; +use Text::Unidecode; +use GraphViz; + + +sub spawn { + my $p = shift; + POE::Session->create( + package_states => [ + $p => [qw| _start cmd_relgraph creategraph getrel relscomplete buildgraph graphcomplete |], + ], + heap => { + font => 's', + fsize => [ 9, 7, 10 ], # nodes, edges, node_title + imgdir => '/www/vndb/static/rg', + datdir => '/www/vndb/data/rg', + moy => [qw| Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec |], + @_, + } + ); +} + + +sub _start { + $_[KERNEL]->alias_set('rg'); + $_[KERNEL]->call(core => register => qr/^relgraph ((?:[0-9]+)(?:\s+[0-9]+)*|all)$/, 'cmd_relgraph'); +} + + +sub cmd_relgraph { + $_[HEAP]{curcmd} = $_[ARG0]; + + # 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 = 0'); + $q->execute; + $_[HEAP]{todo} = [ map { $_->[0] } @{$q->fetchall_arrayref([])} ]; + } + + # generate first graph + $_[KERNEL]->yield(creategraph => $_[HEAP]{todo}[0]); +} + + +sub creategraph { # id + # Function order: + # creategraph + # getrel (recursive) + # relscomplete + # if !rels + # graphcomplete + # else + # buildgraph + # graphcomplete + + $_[KERNEL]->call(core => log => 3, 'Processing graph for v%d', $_[ARG0]); + $_[HEAP]{gv} = GraphViz->new( + #width => 700/96, + height => 2000/96, + ratio => 'compress', + ); + + $_[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 getrel { # vid + #return if $_[HEAP]{nodes}{$_[ARG0]} && $_[HEAP]{nodes}{$_[ARG0]}[4]; + $_[KERNEL]->call(core => log => 3, 'Fetching relations for v%d', $_[ARG0]); + + 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) { + if($r->{vid1} < $r->{vid2}) { + $_[HEAP]{rels}{$r->{vid1}.'-'.$r->{vid2}} = reverserel($r->{relation}); + } else { + $_[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]; + } + } + $_[HEAP]{nodes}{$_[ARG0]}[4]++; + } + + $_[KERNEL]->yield('relscomplete') if !grep { !$_->[4] } values %{$_[HEAP]{nodes}}; +} + + +sub relscomplete { # heap->nodes and heap->rels are now assumed to contain all necessary data + if(!keys %{$_[HEAP]{nodes}}) { + $_[KERNEL]->call(core => log => 3, 'No relation graph for v%d', $_[HEAP]{vid}); + $Multi::SQL->do('UPDATE vn SET rgraph = 0 WHERE id = ?', undef, $_[HEAP]{vid}); + $_[HEAP]{nodes}{$_[HEAP]{vid}} = []; + $_[KERNEL]->yield('graphcomplete'); + return; + } + $_[KERNEL]->call(core => log => 3, 'Fetched all relation data'); + + # insert all nodes, ordered by release date + for (sort { $a->[2] <=> $b->[2] } values %{$_[HEAP]{nodes}}) { + my $date = sprintf '%08d', $_->[2]; + $date =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2>0?($_[HEAP]{moy}[$2-1].' '):'').$1)#e; + + my $title = unidecode($_->[1]); + $title = substr($title, 0, 27).'...' if length($title) > 30; + $title =~ s/&/&/g; + + $_[HEAP]{gv}->add_node($_->[0], + fontname => $_[HEAP]{font}, + shape => 'plaintext', + fontsize => $_[HEAP]{fsize}[0], + style => 'setlinewidth(0.5)', + URL => '/v'.$_->[0], + tooltip => $title, + label => sprintf( + '<<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#f0f0f0"> + <TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="3"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR> + <TR><TD> %s </TD><TD> %s </TD></TR> + </TABLE>>', + $_[HEAP]{fsize}[2], $title, $date, $_->[3]||'N/A' + ), + ); + } + + # @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] ] + } 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]); + } + $_[HEAP]{gv}->add_edge( + $_->[1] => $_->[0], + labeldistance => 2.5, + labelangle => -20, + labeljust => 'l', + dir => 'both', + minlen => 2, + fontname => $_[HEAP]{font}, + fontsize => $_[HEAP]{fsize}[1], + arrowsize => 0.7, + color => '#69a89a', + $VNDB::VRELW->{$_->[2]} ? ( + headlabel => $VNDB::VREL->[$_->[2]], + taillabel => $VNDB::VREL->[$_->[2]-1], + ) : $VNDB::VRELW->{$_->[2]+1} ? ( + headlabel => $VNDB::VREL->[$_->[2]], + taillabel => $VNDB::VREL->[$_->[2]+1], + ) : ( + label => ' '.$VNDB::VREL->[$_->[2]], + ), + ); + } + + $_[KERNEL]->yield('buildgraph'); +} + + +sub buildgraph { + # get a new ID + my $gid = $Multi::SQL->prepare("SELECT nextval('relgraph_seq')"); + $gid->execute; + $gid = $gid->fetchrow_arrayref->[0]; + my $gif = sprintf '%s/%02d/%d.gif', $_[HEAP]{imgdir}, $gid % 50, $gid; + my $cmap = sprintf '%s/%02d/%d.cmap', $_[HEAP]{datdir}, $gid % 50, $gid; + + # generate the graph + $_[HEAP]{gv}->as_gif($gif); + chmod 0666, $gif; + + # generate the image map + open my $F, '>', $cmap or die $!; + print $F '<!-- V:'.join(',',keys %{$_[HEAP]{nodes}})." -->\n"; + (my $d = $_[HEAP]{gv}->as_cmapx) =~ s/(id|name)="[^"]+"/$1="rgraph"/g; + print $F $d; + close $F; + chmod 0666, $cmap; + + # update the VN table + $Multi::SQL->do(sprintf q| + UPDATE vn + SET rgraph = %d + WHERE id IN(%s)|, + $gid, join(',', keys %{$_[HEAP]{nodes}})); + + $_[KERNEL]->yield('graphcomplete'); +} + + +sub graphcomplete { # all actions to create the graph (after calling creategraph) are now done + $_[KERNEL]->call(core => log => 3, 'Generated the relation graph for v%d', $_[HEAP]{vid}); + + # 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 |}; + } +} + + + + + +# Not a POE handler, just a small macro +sub reverserel { # relation + return $VNDB::VRELW->{$_[0]} ? $_[0]-1 : $VNDB::VRELW->{$_[0]+1} ? $_[0]+1 : $_[0]; +} + + +1; + |