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