summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-04-06 18:22:47 +0200
committerYorhel <git@yorhel.nl>2020-04-06 18:22:47 +0200
commit7cfc606c4ae05814fb4dde6fce90dcb09cb93679 (patch)
tree5be04b0c10e7f2e676bd6d8cb57d7eb51f590fd2 /lib
parent91c5ca72e9c90c5a60f71e53a68c980094a59da8 (diff)
Delete old relation graph generating and caching machineryHEADmaster
Diffstat (limited to 'lib')
-rw-r--r--lib/Multi/Maintenance.pm6
-rw-r--r--lib/Multi/RG.pm352
-rw-r--r--lib/VNDB/Config.pm1
-rw-r--r--lib/VNDB/DB/Producers.pm12
-rw-r--r--lib/VNDB/DB/VN.pm8
-rw-r--r--lib/VNWeb/HTML.pm3
6 files changed, 8 insertions, 374 deletions
diff --git a/lib/Multi/Maintenance.pm b/lib/Multi/Maintenance.pm
index e0f9e08d..4f469993 100644
--- a/lib/Multi/Maintenance.pm
+++ b/lib/Multi/Maintenance.pm
@@ -77,12 +77,6 @@ my %dailies = (
# takes a few seconds, need more data and measurements. This query /should/ not be necessary.
imagecache => 'SELECT update_images_cache(NULL)',
- # should be pretty fast
- cleangraphs => q|
- DELETE FROM relgraphs vg
- WHERE NOT EXISTS(SELECT 1 FROM vn WHERE rgraph = vg.id)
- AND NOT EXISTS(SELECT 1 FROM producers WHERE rgraph = vg.id)|,
-
cleansessions => q|DELETE FROM sessions WHERE expires < NOW()|,
cleannotifications => q|DELETE FROM notifications WHERE read < NOW()-'1 month'::interval|,
cleannotifications2=> q|DELETE FROM notifications WHERE id IN (
diff --git a/lib/Multi/RG.pm b/lib/Multi/RG.pm
deleted file mode 100644
index 57722c9c..00000000
--- a/lib/Multi/RG.pm
+++ /dev/null
@@ -1,352 +0,0 @@
-
-#
-# Multi::RG - Relation graph generator
-#
-
-# XXX: The producer graphs generated here are not used at the moment, that's
-# now done on demand in VNWeb::Producers::Graph. If that's successful, the same
-# approach will be applied to VN graphs and this module can be removed
-# entirely.
-
-package Multi::RG;
-
-use strict;
-use warnings;
-use Multi::Core;
-use AnyEvent::Util;
-use Encode 'encode_utf8';
-use XML::Parser;
-use TUWF::XML;
-use VNDB::Types;
-
-
-my %O = (
- font => 'Arial',
- fsize => [ 9, 7, 10 ], # nodes, edges, node_title
- dot => '/usr/bin/dot',
- check_delay => 3600,
-);
-
-
-my %C;
-
-
-sub run {
- shift;
- %O = (%O, @_);
- push_watcher schedule 0, $O{check_delay}, \&check_rg;
- push_watcher pg->listen(relgraph => on_notify => \&check_rg);
-}
-
-
-sub check_rg {
- # Only process one at a time, we don't know how many other entries the
- # current graph will affect.
- return if $C{id};
-
- AE::log debug => 'Checking for new graphs to create.';
- pg_cmd q|
- SELECT 'v', v.id FROM vn v JOIN vn_relations vr ON vr.id = v.id WHERE v.rgraph IS NULL AND v.hidden = FALSE
- UNION
- SELECT 'p', p.id FROM producers p JOIN producers_relations pr ON pr.id = p.id WHERE p.rgraph IS NULL AND p.hidden = FALSE
- LIMIT 1|, undef, sub {
- my($res, $time) = @_;
- return if pg_expect $res, 1 or !$res->rows;
- creategraph(scalar $res->value(0, 0), scalar $res->value(0, 1), 0, $time);
- }
-}
-
-
-sub creategraph {
- my($type, $id, $official, $sqlt) = @_;
-
- %C = (
- start => scalar AE::time(),
- type => $type,
- id => $id,
- sqlt => $sqlt,
- offi => $official,
- rels => {}, # relations (key=id1-id2, value=[relation,official])
- nodes => {}, # nodes (key=id, value= 0:found, 1:processed)
- );
-
- AE::log debug => "Generating graph for $C{type}$C{id}";
- getrelid($C{id});
-}
-
-
-sub getrelid {
- my $id = shift;
- AE::log debug => "Fetching relations for $C{type}$id";
- pg_cmd $C{type} eq 'p'
- ? 'SELECT pid, relation FROM producers_relations WHERE id = $1'
- : $C{offi} ? 'SELECT vid, relation, official FROM vn_relations WHERE id = $1 AND official'
- : 'SELECT vid, relation, official FROM vn_relations WHERE id = $1',
- [ $id ], sub { getrel($id, @_) };
-}
-
-
-sub getrel { # id, res, time
- my($id, $res, $time) = @_;
- return if pg_expect $res, 1, $id;
-
- $C{sqlt} += $time;
- $C{nodes}{$id} = 1;
-
- for($res->rows) {
- my($xid, $xrel, $xoff) = @$_;
- $xoff = 0 if $xoff && $xoff =~ /^f/;
-
- $C{rels}{$id.'-'.$xid} = [ ($C{type} eq 'v' ? \%VN_RELATION : \%PRODUCER_RELATION)->{$xrel}{reverse}, $xoff ] if $id < $xid;
- $C{rels}{$xid.'-'.$id} = [ $xrel, $xoff ] if $id > $xid;
-
- # New node? Get its relations too.
- if(!exists $C{nodes}{$xid}) {
- $C{nodes}{$xid} = 0;
- getrelid $xid;
- }
- }
-
- # Wait for other node relations to come in.
- return if grep !$_, values %{$C{nodes}};
-
- # For VNs: If the graph has more than 30 nodes and there are unofficial
- # links, start again, this time throwing away the unofficial links.
- # XXX: This is an ugly hack.
- # - This would remove unofficial links between VNs that are in the graph anyway.
- # - It can result in graphs with just a single VN node and no links.
- # - How well does this work together with the current caching mechanism? It's
- # possible that a distant VN doesn't get its relation graph updated because
- # it's being excluded here.
- if($C{type} eq 'v' && scalar keys %{$C{nodes}} > 30 && grep !$_->[1], values %{$C{rels}}) {
- AE::log info => "Graph for $C{type}$C{id} is too large, re-creating graph without unofficial links";
- return creategraph v => $C{id}, 1, $C{sqlt};
- }
-
- # do we have all relations now? get node info
- my @ids = keys %{$C{nodes}};
- my $ids = join(', ', map '$'.$_, 1..@ids);
- AE::log debug => "Fetching node information for $C{type}:".join ', ', @ids;
- pg_cmd $C{type} eq 'v'
- ? "SELECT id, title, c_released AS date, array_to_string(c_languages, '/') AS lang FROM vn WHERE id IN($ids) ORDER BY c_released"
- : "SELECT id, name, lang, type FROM producers WHERE id IN($ids) ORDER BY name",
- [ @ids ], \&builddot;
-}
-
-
-sub builddot {
- my($res, $time) = @_;
- return if pg_expect $res, 1, $C{id};
- $C{sqlt} += $time;
-
- my $gv =
- qq|graph rgraph {\n|.
- qq|\tnode [ fontname = "$O{font}", shape = "plaintext",|.
- qq| fontsize = $O{fsize}[0], fontcolor = "#333333", color = "#111111" ]\n|.
- qq|\tedge [ labeldistance = 2.5, labelangle = -20, labeljust = 1, minlen = 2, dir = "both",|.
- qq| fontname = $O{font}, fontsize = $O{fsize}[1], arrowsize = 0.7, color = "#111111", fontcolor = "#333333" ]\n|;
-
- # insert all nodes and relations
- my %nodes = map +($_->{id}, $_), $res->rowsAsHashes;
- $gv .= $C{type} eq 'v' ? gv_vnnode($nodes{$_}) : gv_prodnode($nodes{$_}) for keys %nodes;
- $gv .= $C{type} eq 'v' ? gv_vnrels($C{rels}, \%nodes) : gv_prodrels($C{rels}, \%nodes);
-
- $gv .= "}\n";
-
- rundot($gv);
-}
-
-
-sub gv_vnnode {
- my $n = shift;
-
- my $date = sprintf '%08d', $n->{date};
- $date =~ s{^([0-9]{4})([0-9]{2})([0-9]{2})$}{
- $1 == 0 ? 'unknown'
- : $1 == 9999 ? 'TBA'
- : $2 == 99 ? $1
- : $3 == 99 ? "$1-$2" : "$1-$2-$3"
- }e;
-
- my $title = $n->{title};
- $title = substr($title, 0, 27).'...' if length($title) > 30;
- $title =~ s/&/&amp;/g;
- $title =~ s/>/&gt;/g;
- $title =~ s/</&lt;/g;
-
- my $tooltip = $n->{title};
- $tooltip =~ s/\\/\\\\/g;
- $tooltip =~ s/"/\\"/g;
-
- return sprintf
- qq|\tv%d [ id = "node_v%1\$d", URL = "/v%1\$d", tooltip = "%s", label=<|.
- q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|.
- 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|,
- $n->{id}, encode_utf8($tooltip), $O{fsize}[2], encode_utf8($title), $date, $n->{lang}||'N/A';
-}
-
-
-sub gv_vnrels {
- my($rels, $vns) = @_;
- my $r = '';
-
- # @rels = ([ vid1, vid2, relation, official, date1, date2 ], ..), for easier processing
- my @rels = map {
- /^([0-9]+)-([0-9]+)$/;
- [ $1, $2, @{$rels->{$_}}, $vns->{$1}{date}, $vns->{$2}{date} ]
- } keys %$rels;
-
- # insert all edges, ordered by release date
- for (sort { ($a->[4]>$a->[5]?$a->[5]:$a->[4]) <=> ($b->[4]>$b->[5]?$b->[5]:$b->[4]) } @rels) {
- # [older game] -> [newer game]
- if($_->[5] > $_->[4]) {
- ($_->[0], $_->[1]) = ($_->[1], $_->[0]);
- $_->[2] = $VN_RELATION{$_->[2]}{reverse};
- }
- my $rel = $VN_RELATION{$_->[2]}{txt};
- my $rev = $VN_RELATION{ $VN_RELATION{$_->[2]}{reverse} }{txt};
- my $style = $_->[3] ? '' : ', style="dotted"';
- my $label = $rev ne $rel
- ? qq|headlabel = "$rel" taillabel = "${rev}" $style|
- : qq|label = "$rel" $style|;
- $r .= qq|\tv$$_[1] -- v$$_[0] [ $label ]\n|;
- }
- $r;
-}
-
-
-sub gv_prodnode {
- my $n = shift;
-
- my $name = $n->{name};
- $name = substr($name, 0, 27).'...' if length($name) > 30;
- $name =~ s/&/&amp;/g;
- $name =~ s/>/&gt;/g;
- $name =~ s/</&lt;/g;
-
- my $tooltip = $n->{name};
- $tooltip =~ s/\\/\\\\/g;
- $tooltip =~ s/"/\\"/g;
-
- return sprintf
- qq|\tp%d [ id = "node_p%1\$d", URL = "/p%1\$d", tooltip = "%s", label=<|.
- q|<TABLE CELLSPACING="0" CELLPADDING="1" BORDER="0" CELLBORDER="1" BGCOLOR="#222222">|.
- q|<TR><TD COLSPAN="2" ALIGN="CENTER" CELLPADDING="2"><FONT POINT-SIZE="%d"> %s </FONT></TD></TR>|.
- q|<TR><TD ALIGN="CENTER"> %s </TD><TD ALIGN="CENTER"> %s </TD></TR>|.
- qq|</TABLE>> ]\n|,
- $n->{id}, encode_utf8($tooltip), $O{fsize}[2], encode_utf8($name),
- $LANGUAGE{$n->{lang}}, $PRODUCER_TYPE{$n->{type}};
-}
-
-
-sub gv_prodrels {
- my($rels, $prods) = @_;
- my $r = '';
-
- for (keys %$rels) {
- /^([0-9]+)-([0-9]+)$/;
- my $p1 = $prods->{$1};
- my $p2 = $prods->{$2};
-
- my $rel = $PRODUCER_RELATION{$rels->{$_}[0]}{txt};
- my $rev = $PRODUCER_RELATION{ $PRODUCER_RELATION{$rels->{$_}[0]}{reverse} }{txt};
- my $label = $rev ne $rel
- ? qq|headlabel = "$rev", taillabel = "$rel"|
- : qq|label = "$rel"|;
- $r .= qq|\tp$p1->{id} -- p$p2->{id} [ $label ]\n|;
- }
- $r;
-}
-
-
-sub rundot {
- my $gv = shift;
- AE::log trace => "Running graphviz, dot:\n$gv";
-
- my $svg;
- my $cv = run_cmd [ $O{dot}, '-Tsvg' ],
- '<', \$gv,
- '>', \$svg,
- '2>', sub { AE::log warn => "STDERR from graphviz: $_[0]" if $_[0]; };
-
- $cv->cb(sub {
- return AE::log warn => 'graphviz failed' if shift->recv;
- processgraph($svg);
- });
-}
-
-
-sub processgraph {
- my $data = shift;
-
- # Before saving the SVG output, we'll modify it a little:
- # - Remove comments
- # - Remove <title> elements (unused)
- # - Remove id attributes (unused)
- # - Remove first <polygon> element (emulates the background color)
- # - Replace stroke and fill attributes with classes (so that coloring is done in CSS)
- my $svg = '';
- my $w = TUWF::XML->new(write => sub { $svg .= shift });
- my $p = XML::Parser->new;
- $p->setHandlers(
- Start => sub {
- my($expat, $el, %attr) = @_;
- return if $el eq 'title' || $expat->in_element('title');
- return if $el eq 'polygon' && $expat->depth == 2;
-
- $attr{class} = 'border' if $attr{stroke} && $attr{stroke} eq '#111111';
- $attr{class} = 'nodebg' if $attr{fill} && $attr{fill} eq '#222222';
-
- delete @attr{qw|stroke fill|};
- delete $attr{id} if $attr{id} && $attr{id} !~ /^node_[vp]\d+$/;
- $w->tag($el, %attr, $el eq 'path' || $el eq 'polygon' ? undef : ());
- },
- End => sub {
- my($expat, $el) = @_;
- return if $el eq 'title' || $expat->in_element('title');
- return if $el eq 'polygon' && $expat->depth == 2;
- $w->end($el) if $el ne 'path' && $el ne 'polygon';
- },
- Char => sub {
- my($expat, $str) = @_;
- return if $expat->in_element('title');
- $w->txt($str) if $str !~ /^[\s\t\r\n]*$/s;
- }
- );
- $p->parsestring($data);
-
- # save the processed SVG in the database and fetch graph ID
- AE::log trace => "Processed SVG:\n$svg";
- pg_cmd 'INSERT INTO relgraphs (svg) VALUES ($1) RETURNING id', [ $svg ], \&save_rgraph;
-}
-
-
-sub save_rgraph {
- my($res, $time) = @_;
- return if pg_expect $res, 1;
- $C{sqlt} += $time;
-
- my $graphid = $res->value(0,0);
- my @ids = sort keys %{$C{nodes}};
- my $ids = join ',', map '$'.$_, 2..@ids+1;
- my $table = $C{type} eq 'v' ? 'vn' : 'producers';
-
- pg_cmd "UPDATE $table SET rgraph = \$1 WHERE id IN($ids)",
- [ $graphid, @ids ],
- sub {
- my($res, $time) = @_;
- return if pg_expect $res, 0;
- $C{sqlt} += $time;
-
- AE::log info => sprintf 'Generated relation graph #%d in %.2fs (%.2fs SQL), %s: %s',
- $graphid, AE::time-$C{start}, $C{sqlt}, $C{type}, join ',', @ids;
-
- %C = ();
- check_rg;
- };
-}
-
-
-1;
diff --git a/lib/VNDB/Config.pm b/lib/VNDB/Config.pm
index efaa1303..1a426030 100644
--- a/lib/VNDB/Config.pm
+++ b/lib/VNDB/Config.pm
@@ -39,7 +39,6 @@ my $config = {
Core => {},
Feed => {},
Maintenance => {},
- RG => {},
},
};
diff --git a/lib/VNDB/DB/Producers.pm b/lib/VNDB/DB/Producers.pm
index 0caf0ece..9497a8eb 100644
--- a/lib/VNDB/DB/Producers.pm
+++ b/lib/VNDB/DB/Producers.pm
@@ -9,7 +9,7 @@ our @EXPORT = qw|dbProducerGet dbProducerGetRev dbProducerRevisionInsert|;
# options: results, page, id, search, char, sort, inc_hidden
-# what: extended relations relgraph
+# what: extended relations
sub dbProducerGet {
my $self = shift;
my %o = (
@@ -34,11 +34,8 @@ sub dbProducerGet {
'(ASCII(p.name) < 97 OR ASCII(p.name) > 122) AND (ASCII(p.name) < 65 OR ASCII(p.name) > 90)' => 1 ) : (),
);
- my $join = $o{what} =~ /relgraph/ ? 'JOIN relgraphs pg ON pg.id = p.rgraph' : '';
-
- my $select = 'p.id, p.type, p.name, p.original, p.lang, p.rgraph';
+ my $select = 'p.id, p.type, p.name, p.original, p.lang';
$select .= ', p.desc, p.alias, p.website, p.l_wp, p.l_wikidata, p.hidden, p.locked' if $o{what} =~ /extended/;
- $select .= ', pg.svg' if $o{what} =~ /relgraph/;
my($order, @order) = ('p.name');
if($o{sort} && $o{sort} eq 'search') {
@@ -49,10 +46,9 @@ sub dbProducerGet {
my($r, $np) = $self->dbPage(\%o, qq|
SELECT !s
FROM producers p
- !s
!W
ORDER BY $order|,
- $select, $join, \%where, @order
+ $select, \%where, @order
);
return _enrich($self, $r, $np, 0, $o{what});
@@ -67,7 +63,7 @@ sub dbProducerGetRev {
$o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'p\' AND itemid = ?', $o{id})->{rev};
- my $select = 'c.itemid AS id, p.type, p.name, p.original, p.lang, po.rgraph';
+ my $select = 'c.itemid AS id, p.type, p.name, p.original, p.lang';
$select .= ', extract(\'epoch\' from c.added) as added, c.comments, c.rev, c.ihid, c.ilock, '.VNWeb::DB::sql_user();
$select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
$select .= ', p.desc, p.alias, p.website, p.l_wp, p.l_wikidata, po.hidden, po.locked' if $o{what} =~ /extended/;
diff --git a/lib/VNDB/DB/VN.pm b/lib/VNDB/DB/VN.pm
index 5b0fa932..d0c9caa5 100644
--- a/lib/VNDB/DB/VN.pm
+++ b/lib/VNDB/DB/VN.pm
@@ -14,7 +14,7 @@ our @EXPORT = qw|dbVNGet dbVNGetRev dbVNRevisionInsert dbScreenshotGet dbScreens
# Options: id, char, search, gtin, length, lang, olang, plat, tag_inc, tag_exc, tagspoil,
# hasani, hasshot, ul_notblack, ul_onwish, results, page, what, sort,
# reverse, inc_hidden, date_before, date_after, released, release, character
-# What: extended anime staff seiyuu relations screenshots relgraph rating ranking vnlist
+# What: extended anime staff seiyuu relations screenshots rating ranking vnlist
# Note: vnlist is ignored (no db search) unless a user is logged in
# Sort: id rel pop rating title tagscore rand
sub dbVNGet {
@@ -96,7 +96,6 @@ sub dbVNGet {
}
my @join = (
- $o{what} =~ /relgraph/ ? 'JOIN relgraphs vg ON vg.id = v.rgraph' : (),
$uid && $o{what} =~ /vnlist/ ? ("LEFT JOIN (
SELECT irv.vid, COUNT(*) AS userlist_all,
SUM(CASE WHEN irl.status = 2 THEN 1 ELSE 0 END) AS userlist_obtained
@@ -109,10 +108,9 @@ sub dbVNGet {
my $tag_ids = $o{tag_inc} && join ',', ref $o{tag_inc} ? @{$o{tag_inc}} : $o{tag_inc};
my @select = ( # see https://rt.cpan.org/Ticket/Display.html?id=54224 for the cast on c_languages and c_platforms
- qw|v.id v.locked v.hidden v.c_released v.c_languages::text[] v.c_olang::text[] v.c_platforms::text[] v.title v.original v.rgraph|,
+ qw|v.id v.locked v.hidden v.c_released v.c_languages::text[] v.c_olang::text[] v.c_platforms::text[] v.title v.original|,
$o{what} =~ /extended/ ? (
qw|v.alias v.img_nsfw v.length v.desc v.l_wp v.l_encubed v.l_renai v.l_wikidata|, 'coalesce(vndbid_num(v.image),0) as image' ) : (),
- $o{what} =~ /relgraph/ ? 'vg.svg' : (),
$o{what} =~ /rating/ ? (qw|v.c_popularity v.c_rating v.c_votecount|) : (),
$o{what} =~ /ranking/ ? (
'(SELECT COUNT(*)+1 FROM vn iv WHERE iv.hidden = false AND iv.c_popularity > COALESCE(v.c_popularity, 0.0)) AS p_ranking',
@@ -157,7 +155,7 @@ sub dbVNGetRev {
# XXX: Too much duplication with code in dbVNGet() here. Can we combine some code here?
my $uid = $self->authInfo->{id};
- my $select = 'c.itemid AS id, vo.c_released, vo.c_languages::text[], vo.c_olang::text[], vo.c_platforms::text[], v.title, v.original, vo.rgraph';
+ my $select = 'c.itemid AS id, vo.c_released, vo.c_languages::text[], vo.c_olang::text[], vo.c_platforms::text[], v.title, v.original';
$select .= ', extract(\'epoch\' from c.added) as added, c.comments, c.rev, c.ihid, c.ilock, '.VNWeb::DB::sql_user();
$select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
$select .= ', v.alias, coalesce(vndbid_num(v.image), 0) as image, v.img_nsfw, v.length, v.desc, v.l_wp, v.l_encubed, v.l_renai, v.l_wikidata, vo.hidden, vo.locked' if $o{what} =~ /extended/;
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index 526b33d3..c33baccc 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -339,8 +339,7 @@ sub _maintabs_ {
t '' => "/$id", $id;
t rg => "/$id/rg", 'relations'
- if $t =~ /[vp]/ && (exists $o->{rgraph} ? $o->{rgraph}
- : tuwf->dbVali('SELECT rgraph FROM', $t eq 'v' ? 'vn' : 'producers', 'WHERE id =', \$o->{id}));
+ if $t =~ /[vp]/ && tuwf->dbVali('SELECT 1 FROM', $t eq 'v' ? 'vn_relations' : 'producers_relations', 'WHERE id =', \$o->{id}, 'LIMIT 1');
t releases => "/$id/releases", 'releases' if $t eq 'v';
t edit => "/$id/edit", 'edit' if can_edit $t, $o;