#!/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|<
>|,
$_->[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 '\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);
}