diff options
Diffstat (limited to 'util/OLD/relgraph.pl')
-rw-r--r-- | util/OLD/relgraph.pl | 237 |
1 files changed, 237 insertions, 0 deletions
diff --git a/util/OLD/relgraph.pl b/util/OLD/relgraph.pl new file mode 100644 index 00000000..a4ae486d --- /dev/null +++ b/util/OLD/relgraph.pl @@ -0,0 +1,237 @@ +#!/usr/bin/perl + +our $S; + +open(STDERR, ">&STDOUT"); # warnings and errors can be captured easily this way +$ENV{PATH} = '/usr/bin'; # required for GraphViz + +use strict; +use warnings; +no warnings 'once'; +use Text::Unidecode; +#use Time::HiRes 'gettimeofday', 'tv_interval'; +#BEGIN { $S = [ gettimeofday ]; } +#END { printf "Done in %.2f s\n", tv_interval($S); } + +use Digest::MD5 'md5_hex'; +use Time::CTime; +use GraphViz; +use DBI; +use POSIX 'floor'; + +require '/www/vndb/lib/global.pl'; + + +my $font = 's'; #Comic Sans MSssss'; +my @fsize = ( 9, 7, 10 ); # nodes, edges, node_title +my $destdir = '/www/vndb/static/rg'; +my $datdir = '/www/vndb/data/rg'; +my $DEBUG = 0; + + +my %nodes_all = ( + fontname => $font, + shape => 'plaintext', + fontsize => $fsize[0], + style => "setlinewidth(0.5)", +); + +my %edge_all = ( + labeldistance => 2.5, + labelangle => -20, + labeljust => 'l', + dir => 'both', + minlen => 2, + fontname => $font, + fontsize => $fsize[1], + arrowsize => 0.7, + color => '#69a89a', +# constraint => 0, +); + +my @edge_rel = map { + { + %edge_all, + $VNDB::VRELW->{$_} ? ( + headlabel => $VNDB::VREL->[$_], + taillabel => $VNDB::VREL->[$_-1], + ) : $VNDB::VRELW->{$_+1} ? ( + headlabel => $VNDB::VREL->[$_], + taillabel => $VNDB::VREL->[$_+1], + ) : ( + label => ' '.$VNDB::VREL->[$_], + ), + }; +} 0..$#$VNDB::VREL; + + + + +my $sql = DBI->connect(@VNDB::DBLOGIN, { RaiseError => 1, PrintError => 0, AutoCommit => 0, pg_enable_utf8 => 1 }); +my %ids; my %nodes; +my %rels; # "v1-v2" => 1 +my @done; + + + +sub createGraph { # vid + my $id = shift; + %ids = (); + %nodes = (); + %rels = (); + + return 0 if grep { $id == $_ } @done; + + my $g = GraphViz->new( +# width => 700/96, + height => 2000/96, + ratio => 'compress', + ); + + getRel($g, $id); + if(!keys %rels) { + push @done, $id; + $sql->do(q|UPDATE vn SET rgraph = 0 WHERE id = ?|, undef, $id); + return 0; + } + + # correct order! + for (sort { $a->[2] <=> $b->[2] } values %nodes) { + $DEBUG && printf "ADD: %d\n", $_->[0]; + $_->[2] =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2>0?($Time::CTime::MoY[$2-1].' '):'').$1)#e; + $g->add_node($_->[0], %nodes_all, URL => '/v'.$_->[0], tooltip => $_->[1], label => sprintf + qq|<<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#f0f0f0"> + <TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="3"><FONT POINT-SIZE="$fsize[2]"> %s </FONT></TD></TR> + <TR><TD> %s </TD><TD> %s </TD></TR> + </TABLE>>|, + $_->[1], $_->[2], $_->[3]); + } + + # make sure to sort the edges on node release dates + my @rel = map { [ split(/-/, $_), $rels{$_} ] } keys %rels; + for (sort { ($ids{$a->[0]} > $ids{$a->[1]} ? $ids{$a->[1]} : $ids{$a->[0]}) + cmp ($ids{$b->[0]} > $ids{$b->[1]} ? $ids{$b->[1]} : $ids{$b->[0]}) } @rel) { + + # [older game] -> [newer game] + if($ids{$_->[1]} > $ids{$_->[0]}) { + ($_->[0], $_->[1]) = ($_->[1], $_->[0]); + $_->[2] = reverseRel($_->[2]); + } + $g->add_edge($_->[1] => $_->[0], %{$edge_rel[$_->[2]]}); + $DEBUG && printf "ADD %d -> %d\n", $_->[1], $_->[0]; + } + + $DEBUG && print "IMAGE\n"; + + # get a new number + my $gid = $sql->prepare("SELECT nextval('relgraph_seq')"); + $gid->execute; + $gid = $gid->fetchrow_arrayref->[0]; + my $fn = sprintf '/%02d/%d.', $gid % 50, $gid; + + # save the image & image map + my $d = $g->as_gif($destdir.$fn.'gif'); + chmod 0666, $destdir.$fn.'gif'; + + $DEBUG && print "CMAP\n"; + open my $F, '>', $datdir.$fn.'cmap' or die $!; + print $F '<!-- V:'.join(',',keys %nodes)." -->\n"; + ($d = $g->as_cmapx) =~ s/(id|name)="[^"]+"/$1="rgraph"/g; + print $F $d; + close $F; + chmod 0666, $datdir.$fn.'cmap'; + + $DEBUG && print "UPDATE\n"; + # update the VNs + $sql->do(sprintf q| + UPDATE vn + SET rgraph = %d + WHERE id IN(%s)|, + $gid, join(',', keys %ids)); + $DEBUG && print "FIN\n"; + + push @done, keys %ids; + return 1; +} + + +sub getRel { # gobj, vid + my($g, $id) = @_; + #$ids{$id} = 0; # false but defined + $DEBUG && printf "GET: %d\n", $id; + my $s = $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($id, $id); + for my $r (@{$s->fetchall_arrayref({})}) { + $DEBUG && printf " %d: %d - %d\n", $id, $r->{vid1}, $r->{vid2}; + if($r->{vid1} < $r->{vid2}) { + $rels{$r->{vid1}.'-'.$r->{vid2}} = reverseRel($r->{relation}); + } else { + $rels{$r->{vid2}.'-'.$r->{vid1}} = $r->{relation}; + } + + for (1,2) { + my($cid, $title, $date, $lang) = ($r->{'vid'.$_}, $r->{'title'.$_}, $r->{'date'.$_}, $r->{'lang'.$_}); + $title = unidecode($title); + $title = substr($title, 0, 27).'...' if length($title) > 30; + $title =~ s/&/&/g; + $date = sprintf('%08d', $date); + $nodes{$cid} = [ $cid, $title, $date, $lang ]; + + if(!defined $ids{$cid}) { + $ids{$cid} = $date; + getRel($g, $cid) if $id != $cid; + } + } + } +} + +sub reverseRel { # rel + return $VNDB::VRELW->{$_[0]} ? $_[0]-1 : $VNDB::VRELW->{$_[0]+1} ? $_[0]+1 : $_[0]; +} + + + +if(@ARGV) { + #print join('-',@ARGV); + createGraph($_) for (@ARGV); + $sql->commit; +} else { + require Time::HiRes; + my $S = [ Time::HiRes::gettimeofday() ]; + + # regenerate all + my $s = $sql->prepare(q|SELECT id FROM vn|); + $s->execute(); + my $i = $s->fetchall_arrayref([]); + for my $id (@$i) { + print "Processed $id->[0]\n" if createGraph($id->[0]); + } + + # delete unused + # opendir(my $D, $destdir) || die $!; + # for (readdir($D)) { + # next if !/^([0-9a-fA-F]{32})\.gif$/; + # my $s = $sql->prepare(q|SELECT 1 AS yes FROM vn WHERE rgraph = DECODE(?, 'hex')|); + # $s->execute($1); + # if(!$s->fetchall_arrayref({})->[0]{yes}) { + # printf "Deleting %s\n", $1; + # unlink "$datdir/$1.cmap" or die $!; + # unlink "$destdir/$1.gif" or die $!; + # } + # } + # closedir($D); + + $sql->commit; + + printf "Done in %.3f s\n", Time::HiRes::tv_interval($S); +} + |