summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-09-12 15:21:13 +0200
committerYorhel <git@yorhel.nl>2020-09-12 15:21:16 +0200
commit722bb447e6218d522562007a4c8dcc4eb31f6582 (patch)
treeb87b8dc999f9865fb970e60fb9ffb6a60fb2d3db
parentf263c9616fa9790dc7c20bbbb021078d8d44a1fd (diff)
v2rw: Add new filter querying framework + rewrite homepage
The new filter framework hasn't been extensively tested yet, but seems to mostly work. No real changes to the homepage, but I did manage to make a few queries a little bit faster. The most significant source of slowness is the releases listing, but I can't optimize that without adding indices.
-rw-r--r--lib/VNDB/DB/Discussions.pm176
-rw-r--r--lib/VNDB/DB/Misc.pm77
-rw-r--r--lib/VNDB/DB/VN.pm43
-rw-r--r--lib/VNDB/Handler/Misc.pm229
-rw-r--r--lib/VNWeb/Filters.pm78
-rw-r--r--lib/VNWeb/Misc/History.pm1
-rw-r--r--lib/VNWeb/Misc/HomePage.pm253
7 files changed, 333 insertions, 524 deletions
diff --git a/lib/VNDB/DB/Discussions.pm b/lib/VNDB/DB/Discussions.pm
deleted file mode 100644
index 1de87dd9..00000000
--- a/lib/VNDB/DB/Discussions.pm
+++ /dev/null
@@ -1,176 +0,0 @@
-
-package VNDB::DB::Discussions;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbThreadGet dbPostGet|;
-
-
-# Options: id, type, iid, results, page, what, asuser, notusers, search, sort, reverse
-# What: boards, boardtitles, firstpost, lastpost, poll
-# Sort: id lastpost
-sub dbThreadGet {
- my($self, %o) = @_;
- $o{results} ||= 50;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my @where = (
- $o{id} ? (
- 't.id = ?' => $o{id}
- ) : (
- 'NOT t.hidden' => 0,
- q{(NOT t.private OR EXISTS(SELECT 1 FROM threads_boards WHERE tid = t.id AND type = 'u' AND iid = ?))} => $o{asuser}
- ),
- $o{type} && !$o{iid} ? (
- 'EXISTS(SELECT 1 FROM threads_boards WHERE tid = t.id AND type IN(!l))' => [ ref $o{type} ? $o{type} : [ $o{type} ] ] ) : (),
- $o{type} && $o{iid} ? (
- 'tb.type = ?' => $o{type}, 'tb.iid = ?' => $o{iid} ) : (),
- $o{notusers} ? (
- 'NOT EXISTS(SELECT 1 FROM threads_boards WHERE type = \'u\' AND tid = t.id)' => 1) : (),
- );
-
- if($o{search}) {
- for (split /[ -,._]/, $o{search}) {
- s/%//g;
- push @where, 't.title ilike ?', "%$_%" if length($_) > 0;
- }
- }
-
- my @select = (
- qw|t.id t.c_lastnum t.title t.locked t.hidden t.private|, 't.poll_question IS NOT NULL AS haspoll',
- $o{what} =~ /lastpost/ ? (q|EXTRACT('epoch' from tpl.date) AS lastpost_date|, VNWeb::DB::sql_user('ul', 'lastpost_')) : (),
- $o{what} =~ /poll/ ? (qw|t.poll_question t.poll_max_options t.poll_preview t.poll_recast|) : (),
- );
-
- my @join = (
- $o{what} =~ /lastpost/ ? (
- 'JOIN threads_posts tpl ON tpl.tid = t.id AND tpl.num = t.c_lastnum',
- 'LEFT JOIN users ul ON ul.id = tpl.uid'
- ) : (),
- $o{type} && $o{iid} ?
- 'JOIN threads_boards tb ON tb.tid = t.id' : (),
- );
-
- my $order = sprintf {
- id => 't.id %s',
- lastpost => 'tpl.date %s',
- }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM threads t
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \@where, $order
- );
-
- if($o{what} =~ /(boards|boardtitles|poll)/ && $#$r >= 0) {
- my %r = map {
- $r->[$_]{boards} = [];
- $r->[$_]{poll_options} = [];
- ($r->[$_]{id}, $_)
- } 0..$#$r;
-
- if($o{what} =~ /boards/) {
- push(@{$r->[$r{$_->{tid}}]{boards}}, [ $_->{type}, $_->{iid} ]) for (@{$self->dbAll(q|
- SELECT tid, type, iid
- FROM threads_boards
- WHERE tid IN(!l)|,
- [ keys %r ]
- )});
- }
-
- if($o{what} =~ /poll/) {
- push(@{$r->[$r{$_->{tid}}]{poll_options}}, [ $_->{id}, $_->{option} ]) for (@{$self->dbAll(q|
- SELECT tid, id, option
- FROM threads_poll_options
- WHERE tid IN(!l)|,
- [ keys %r ]
- )});
- }
-
- if($o{what} =~ /firstpost/) {
- do { my $idx = $r{ delete $_->{tid} }; $r->[$idx] = { $r->[$idx]->%*, %$_ } } for (@{$self->dbAll(q|
- SELECT tpf.tid, EXTRACT('epoch' from tpf.date) AS firstpost_date, !s
- FROM threads_posts tpf
- LEFT JOIN users uf ON tpf.uid = uf.id
- WHERE tpf.num = 1 AND tpf.tid IN(!l)|,
- VNWeb::DB::sql_user('uf', 'firstpost_'), [ keys %r ]
- )});
- }
-
- if($o{what} =~ /boardtitles/) {
- push(@{$r->[$r{$_->{tid}}]{boards}}, $_) for (@{$self->dbAll(q|
- SELECT tb.tid, tb.type, tb.iid, COALESCE(u.username, v.title, p.name) AS title, COALESCE(u.username, v.original, p.original) AS original
- FROM threads_boards tb
- LEFT JOIN vn v ON tb.type = 'v' AND v.id = tb.iid
- LEFT JOIN producers p ON tb.type = 'p' AND p.id = tb.iid
- LEFT JOIN users u ON tb.type = 'u' AND u.id = tb.iid
- WHERE tb.tid IN(!l)|,
- [ keys %r ]
- )});
- }
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Options: tid, num, what, uid, mindate, hide, search, type, page, results, sort, reverse
-# what: user thread
-sub dbPostGet {
- my($self, %o) = @_;
- $o{results} ||= 50;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my %where = (
- $o{tid} ? (
- 'tp.tid = ?' => $o{tid} ) : (),
- $o{num} ? (
- 'tp.num = ?' => $o{num} ) : (),
- $o{uid} ? (
- 'tp.uid = ?' => $o{uid} ) : (),
- $o{mindate} ? (
- 'tp.date > to_timestamp(?)' => $o{mindate} ) : (),
- $o{hide} ? (
- 'tp.hidden = FALSE' => 1 ) : (),
- $o{hide} && $o{what} =~ /thread/ ? (
- 't.hidden = FALSE AND t.private = FALSE' => 1 ) : (),
- $o{type} ? (
- 'tp.tid IN(SELECT tid FROM threads_boards WHERE type IN(!l))' => [ ref $o{type} ? $o{type} : [ $o{type} ] ] ) : (),
- );
-
- my @select = (
- qw|tp.tid tp.num tp.hidden|, q|extract('epoch' from tp.date) as date|, q|extract('epoch' from tp.edited) as edited|,
- $o{search} ? () : 'tp.msg',
- $o{what} =~ /user/ ? (VNWeb::DB::sql_user()) : (),
- $o{what} =~ /thread/ ? ('t.title', 't.hidden AS thread_hidden') : (),
- );
- my @join = (
- $o{what} =~ /user/ ? 'LEFT JOIN users u ON u.id = tp.uid' : (),
- $o{what} =~ /thread/ ? 'JOIN threads t ON t.id = tp.tid' : (),
- );
-
- my $order = sprintf {
- num => 'tp.num %s',
- date => 'tp.date %s',
- }->{ $o{sort}||'num' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM threads_posts tp
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \%where, $order
- );
-
- return wantarray ? ($r, $np) : $r;
-}
-
-1;
diff --git a/lib/VNDB/DB/Misc.pm b/lib/VNDB/DB/Misc.pm
deleted file mode 100644
index 525d5975..00000000
--- a/lib/VNDB/DB/Misc.pm
+++ /dev/null
@@ -1,77 +0,0 @@
-
-package VNDB::DB::Misc;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|
- dbRevisionGet
-|;
-
-
-# Options: type, itemid, uid, auto, hidden, edit, page, results, releases
-sub dbRevisionGet {
- my($self, %o) = @_;
- $o{results} ||= 10;
- $o{page} ||= 1;
- $o{auto} ||= 0; # 0:show, -1:only, 1:hide
- $o{hidden} ||= 0;
- $o{edit} ||= 0; # 0:both, -1:new, 1:edits
- $o{releases} = 0 if !$o{type} || $o{type} ne 'v' || !$o{itemid};
-
- my %where = (
- $o{releases} ? (
- # This selects all changes of releases that are currently linked to the VN, not release revisions that are linked to the VN.
- # The latter seems more useful, but is also a lot more expensive.
- q{((c.type = 'v' AND c.itemid = ?) OR (c.type = 'r' AND c.itemid = ANY(ARRAY(SELECT rv.id FROM releases_vn rv WHERE rv.vid = ?))))} => [$o{itemid}, $o{itemid}],
- ) : (
- $o{type} ? (
- 'c.type IN(!l)' => [ ref($o{type})?$o{type}:[$o{type}] ] ) : (),
- $o{itemid} ? (
- 'c.itemid = ?' => [ $o{itemid} ] ) : (),
- ),
- $o{uid} ? (
- 'c.requester = ?' => $o{uid} ) : (),
- $o{auto} ? (
- 'c.requester !s 1' => $o{auto} < 0 ? '=' : '<>' ) : (),
- $o{hidden} ? (
- '!s EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.ihid AND'.
- ' c2.rev = (SELECT MAX(c3.rev) FROM changes c3 WHERE c3.type = c.type AND c3.itemid = c.itemid))' => $o{hidden} == 1 ? 'NOT' : '') : (),
- $o{edit} ? (
- 'c.rev !s 1' => $o{edit} < 0 ? '=' : '>' ) : (),
- );
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT c.id, c.type, c.itemid, c.comments, c.rev, extract('epoch' from c.added) as added, !s
- FROM changes c
- JOIN users u ON c.requester = u.id
- !W
- ORDER BY c.id DESC|, VNWeb::DB::sql_user(), \%where
- );
-
- # I couldn't find a way to fetch the titles the main query above without slowing it down considerably, so let's just do it this way.
- if(@$r) {
- my %r = map +($_->{id}, $_), @$r;
- my $w = join ' OR ', ('(type = ? AND id = ?)') x @$r;
- my @w = map +($_->{type}, $_->{id}), @$r;
-
- $r{ $_->{id} }{ititle} = $_->{title}, $r{ $_->{id} }{ioriginal} = $_->{original} for(@{$self->dbAll("
- SELECT id, title, original FROM (
- SELECT 'v'::dbentry_type, chid, title, original FROM vn_hist
- UNION ALL SELECT 'r'::dbentry_type, chid, title, original FROM releases_hist
- UNION ALL SELECT 'p'::dbentry_type, chid, name, original FROM producers_hist
- UNION ALL SELECT 'c'::dbentry_type, chid, name, original FROM chars_hist
- UNION ALL SELECT 'd'::dbentry_type, chid, title, '' AS original FROM docs_hist
- UNION ALL SELECT 's'::dbentry_type, sh.chid, name, original FROM staff_hist sh JOIN staff_alias_hist sah ON sah.chid = sh.chid AND sah.aid = sh.aid
- ) x(type, id, title, original)
- WHERE $w
- ", @w
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-1;
-
diff --git a/lib/VNDB/DB/VN.pm b/lib/VNDB/DB/VN.pm
index 734ae69b..668b7fec 100644
--- a/lib/VNDB/DB/VN.pm
+++ b/lib/VNDB/DB/VN.pm
@@ -9,7 +9,7 @@ use POSIX 'strftime';
use Exporter 'import';
use VNDB::Func 'normalize_query', 'gtintype';
-our @EXPORT = qw|dbVNGet dbVNGetRev dbScreenshotRandom|;
+our @EXPORT = qw|dbVNGet dbVNGetRev|;
# Options: id, char, search, gtin, length, lang, olang, plat, tag_inc, tag_exc, tagspoil,
@@ -254,45 +254,4 @@ sub _enrich {
}
-
-# Fetch random VN + screenshots
-# if any arguments are given, it will return one random screenshot for each VN
-sub dbScreenshotRandom {
- my($self, @vids) = @_;
- if(!@vids) {
- my $where = q{c_weight > 0 and vndbid_type(id) = 'sf' and c_sexual_avg < 0.4 and c_violence_avg < 0.4};
- state $stats ||= $self->dbRow("SELECT count(*) as total, count(*) filter(where $where) as subset from images");
- my $sample = 100*List::Util::min(1, (1000 / $stats->{subset}) * ($stats->{total} / $stats->{subset}));
- return $self->dbAll(q{
- SELECT vndbid_num(i.id) AS scr, i.width, i.height, v.id AS vid, v.title
- FROM (
- SELECT id, width, height
- FROM images TABLESAMPLE SYSTEM (?)
- WHERE c_weight > 0 and vndbid_type(id) = 'sf' and c_sexual_avg < 0.4 and c_violence_avg < 0.4
- ORDER BY random()
- LIMIT 4
- ) i(id)
- JOIN vn_screenshots vs ON vs.scr = i.id
- JOIN vn v ON v.id = vs.id
- WHERE NOT v.hidden
- ORDER BY random()
- LIMIT 4
- }, $sample);
- }
-
- # this query is faster than it looks
- return $self->dbAll(join(' UNION ALL ', map
- q|SELECT vndbid_num(vs.scr) AS scr, vs.width, vs.height, v.id AS vid, v.title, RANDOM() AS position
- FROM (
- SELECT vs2.id, vs2.scr, s.width, s.height
- FROM vn_screenshots vs2
- JOIN images s ON s.id = vs2.scr
- WHERE vs2.id = ? AND s.c_sexual_avg < 0.4 AND s.c_violence_avg < 0.4
- ORDER BY RANDOM() LIMIT 1
- ) vs
- JOIN vn v ON v.id = vs.id
- |, @vids).' ORDER BY position', @vids);
-}
-
-
1;
diff --git a/lib/VNDB/Handler/Misc.pm b/lib/VNDB/Handler/Misc.pm
index b7e1620d..565523e6 100644
--- a/lib/VNDB/Handler/Misc.pm
+++ b/lib/VNDB/Handler/Misc.pm
@@ -10,7 +10,6 @@ use VNDB::Types;
TUWF::register(
- qr{}, \&homepage,
qr{nospam}, \&nospam,
qr{xml/prefs\.xml}, \&prefs,
qr{opensearch\.xml}, \&opensearch,
@@ -29,234 +28,6 @@ TUWF::register(
);
-sub homepage {
- my $self = shift;
-
- my $title = 'The Visual Novel Database';
- my $desc = 'VNDB.org strives to be a comprehensive database for information about visual novels.';
-
- my $metadata = {
- 'og:type' => 'website',
- 'og:title' => $title,
- 'og:description' => $desc,
- };
-
- $self->htmlHeader(title => $title, feeds => 1, metadata => $metadata);
-
- div class => 'mainbox';
- h1 $title;
- p class => 'description';
- txt $desc;
- br;
- txt 'This website is built as a wiki, meaning that anyone can freely add'
- .' and contribute information to the database, allowing us to create the'
- .' largest, most accurate and most up-to-date visual novel database on the web.';
- end;
-
- # with filters applied it's signifcantly slower, so special-code the situations with and without filters
- my @vns;
- if($self->authPref('filter_vn')) {
- my $r = $self->filFetchDB(vn => undef, undef, {hasshot => 1, results => 4, sort => 'rand'});
- @vns = map $_->{id}, @$r;
- }
- my $scr = $self->dbScreenshotRandom(@vns);
- p class => 'screenshots';
- for (@$scr) {
- my($w, $h) = imgsize($_->{width}, $_->{height}, @{$self->{scr_size}});
- a href => "/v$_->{vid}", title => $_->{title};
- img src => imgurl(st => $_->{scr}), alt => $_->{title}, width => $w, height => $h;
- end;
- }
- end;
- end 'div';
-
- table class => 'mainbox threelayout';
- Tr;
-
- # Recent changes
- td;
- h1;
- a href => '/hist', 'Recent Changes'; txt ' ';
- a href => '/feeds/changes.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- my $changes = $self->dbRevisionGet(results => 10, auto => 1);
- ul;
- for (@$changes) {
- li;
- txt "$_->{type}:";
- a href => "/$_->{type}$_->{itemid}.$_->{rev}", title => $_->{ioriginal}||$_->{ititle}, shorten $_->{ititle}, 33;
- lit " by ";
- VNWeb::HTML::user_($_);
- end;
- }
- end;
- end 'td';
-
- # Announcements
- td;
- my $an = $self->dbThreadGet(type => 'an', sort => 'id', reverse => 1, results => 2);
- h1;
- a href => '/t/an', 'Announcements'; txt ' ';
- a href => '/feeds/announcements.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- for (@$an) {
- my $post = $self->dbPostGet(tid => $_->{id}, num => 1)->[0];
- h2;
- a href => "/$_->{id}", $_->{title};
- end;
- p;
- lit bb_format $post->{msg}, maxlength => 150, inline => 1;
- end;
- }
- end 'td';
-
- # Recent posts
- td;
- h1;
- a href => '/t/all', 'Recent Posts'; txt ' ';
- a href => '/feeds/posts.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- my $posts = $self->dbThreadGet(what => 'lastpost boardtitles', results => 10, sort => 'lastpost', reverse => 1, notusers => 1);
- ul;
- for (@$posts) {
- my $boards = join ', ', map $BOARD_TYPE{$_->{type}}{txt}.($_->{iid}?' > '.$_->{title}:''), @{$_->{boards}};
- li;
- txt fmtage($_->{lastpost_date}).' ';
- a href => "/$_->{id}.$_->{c_lastnum}#last", title => "Posted in $boards", shorten $_->{title}, 25;
- lit ' by ';
- VNWeb::HTML::user_($_, 'lastpost_');
- end;
- }
- end;
- end 'td';
-
- end 'tr';
- Tr;
-
- # Random visual novels
- td;
- h1;
- a href => '/v/rand', 'Random visual novels';
- end;
- my $random = $self->filFetchDB(vn => undef, undef, {results => 10, sort => 'rand'});
- ul;
- for (@$random) {
- li;
- a href => "/v$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40;
- end;
- }
- end;
- end;
-
- # Upcoming releases
- td;
- h1;
- a href => '/r?fil=released-0;o=a;s=released', 'Upcoming Releases';
- end;
- my $upcoming = $self->filFetchDB(release => undef, undef, {results => 10, released => 0, what => 'platforms'});
- ul;
- for (@$upcoming) {
- li;
- lit fmtdatestr $_->{released};
- txt ' ';
- cssicon $_, $PLATFORM{$_} for (@{$_->{platforms}});
- cssicon "lang $_", $LANGUAGE{$_} for (@{$_->{languages}});
- txt ' ';
- a href => "/r$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 30;
- end;
- }
- end;
- end 'td';
-
- # Just released
- td;
- h1;
- a href => '/r?fil=released-1;o=d;s=released', 'Just Released';
- end;
- my $justrel = $self->filFetchDB(release => undef, undef, {results => 10, sort => 'released', reverse => 1, released => 1, what => 'platforms'});
- ul;
- for (@$justrel) {
- li;
- lit fmtdatestr $_->{released};
- txt ' ';
- cssicon $_, $PLATFORM{$_} for (@{$_->{platforms}});
- cssicon "lang $_", $LANGUAGE{$_} for (@{$_->{languages}});
- txt ' ';
- a href => "/r$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 30;
- end;
- }
- end;
- end 'td';
-
- end 'tr';
- Tr;
-
- # Latest Mini Reviews
- td;
- h1;
- a href => '/w', 'Latest Mini Reviews';
- end;
- my $minireviews = tuwf->dbAlli('
- SELECT w.id, v.title,', VNWeb::DB::sql_user(), ',', VNWeb::DB::sql_totime('w.date'), 'AS date
- FROM reviews w JOIN vn v ON v.id = w.vid LEFT JOIN users u ON u.id = w.uid WHERE NOT w.isfull ORDER BY w.id DESC LIMIT 10');
- ul;
- for (@$minireviews) {
- li;
- txt fmtage($_->{date}).' ';
- a href => "/$_->{id}", title => $_->{title}, shorten $_->{title}, 25;
- lit ' by ';
- VNWeb::HTML::user_($_);
- end;
- }
- end;
- end 'td';
-
- # Latest Full Reviews
- td;
- h1;
- a href => '/w', 'Latest Full Reviews';
- end;
- my $fullreviews = tuwf->dbAlli('
- SELECT w.id, v.title,', VNWeb::DB::sql_user(), ',', VNWeb::DB::sql_totime('w.date'), 'AS date
- FROM reviews w JOIN vn v ON v.id = w.vid LEFT JOIN users u ON u.id = w.uid WHERE w.isfull ORDER BY w.id DESC LIMIT 10');
- ul;
- for (@$fullreviews) {
- li;
- txt fmtage($_->{date}).' ';
- a href => "/$_->{id}", title => $_->{title}, shorten $_->{title}, 25;
- lit ' by ';
- VNWeb::HTML::user_($_);
- end;
- }
- end;
- end 'td';
-
- # Recent Review Comments
- td;
- h1;
- a href => '/w?s=lastpost', 'Recent Review Comments';
- end;
- my $comments = tuwf->dbAlli('
- SELECT w.id, wp.num, v.title,', VNWeb::DB::sql_user(), ',', VNWeb::DB::sql_totime('wp.date'), 'AS date
- FROM reviews w JOIN reviews_posts wp ON wp.id = w.id AND wp.num = w.c_lastnum JOIN vn v ON v.id = w.vid LEFT JOIN users u ON u.id = wp.uid ORDER BY wp.date DESC LIMIT 10');
- ul;
- for (@$comments) {
- li;
- txt fmtage($_->{date}).' ';
- a href => "/$_->{id}.$_->{num}#last", title => $_->{title}, shorten $_->{title}, 25;
- lit ' by ';
- VNWeb::HTML::user_($_);
- end;
- }
- end;
- end 'td';
- end 'tr';
- end 'table';
-
- $self->htmlFooter;
-}
-
-
sub nospam {
my $self = shift;
$self->htmlHeader(title => 'Could not send form', noindex => 1);
diff --git a/lib/VNWeb/Filters.pm b/lib/VNWeb/Filters.pm
index 6f5cef7a..79aa93dd 100644
--- a/lib/VNWeb/Filters.pm
+++ b/lib/VNWeb/Filters.pm
@@ -6,6 +6,11 @@ package VNWeb::Filters;
# we'll need to support these filters for the forseeable future.
use VNWeb::Prelude;
+use POSIX 'strftime';
+use Exporter 'import';
+
+our @EXPORT = qw/filter_parse filter_vn_query filter_release_query/;
+
my $VN = form_compile any => {
date_before => { required => 0, uint => 1, range => [0, 99999999] }, # don't use 'rdate' validation here, the search form allows invalid dates
@@ -115,4 +120,77 @@ sub filter_vn_compat {
$mod;
}
+
+# Throws error on failure.
+sub filter_parse {
+ my($type, $str) = @_;
+ my $s = {v => $VN, r => $RELEASE, c => $CHAR, s => $STAFF}->{$type};
+ my $data = ref $str ? $str : $str =~ /^{/ ? JSON::XS->new->decode($str) : VNDB::Func::fil_parse $str, keys $s->{known_keys}->%*;
+ die "Invalid filter data: $str\n" if !$data;
+ my $f = $s->validate($data)->data;
+ filter_vn_compat $f if $type eq 'vn';
+ $f
+}
+
+
+# Returns an SQL expression for use in a WHERE clause. Assumption: 'v' is an alias to the vn table being queried.
+sub filter_vn_query {
+ my($fil) = @_;
+ sql_and
+ defined $fil->{date_before} ? sql 'v.c_released <=', \$fil->{date_before} : (),
+ defined $fil->{date_after} ? sql 'v.c_released >=', \$fil->{date_after} : (),
+ defined $fil->{released} ? sql 'v.c_released', $fil->{released} ? '<=' : '>', \strftime('%Y%m%d', gmtime) : (),
+ defined $fil->{length} ? sql 'v.length IN', $fil->{length} : (),
+ defined $fil->{hasani} ? sql($fil->{hasani} ?'':'NOT', 'EXISTS(SELECT 1 FROM vn_anime iva WHERE iva.id = v.id)') : (),
+ defined $fil->{hasshot} ? sql($fil->{hasshot}?'':'NOT', 'EXISTS(SELECT 1 FROM vn_screenshots ivs WHERE ivs.id = v.id)') : (),
+ defined $fil->{tag_inc} ? sql
+ 'v.id IN(SELECT vid FROM tags_vn_inherit WHERE tag IN', $fil->{tag_inc}, 'AND spoiler <=', \$fil->{tagspoil}, 'GROUP BY vid HAVING COUNT(tag) =', scalar $fil->{tag_inc}->@*, ')' : (),
+ defined $fil->{tag_exc} ? sql 'v.id NOT IN(SELECT vid FROM tags_vn_inherit WHERE tag IN', $fil->{tag_exc}, ')' : (),
+ defined $fil->{lang} ? sql 'v.c_languages && ARRAY', $fil->{lang}, '::language[]' : (),
+ defined $fil->{olang} ? sql 'v.c_olang && ARRAY', $fil->{olang}, '::language[]' : (),
+ defined $fil->{plat} ? sql 'v.c_platforms && ARRAY', $fil->{plat}, '::platform[]' : (),
+ defined $fil->{staff_inc} ? sql 'v.id IN(SELECT ivs.id FROM vn_staff ivs JOIN staff_alias isa ON isa.aid = ivs.aid WHERE isa.id IN', $fil->{staff_inc}, ')' : (),
+ defined $fil->{staff_exc} ? sql 'v.id NOT IN(SELECT ivs.id FROM vn_staff ivs JOIN staff_alias isa ON isa.aid = ivs.aid WHERE isa.id IN', $fil->{staff_exc}, ')' : (),
+ auth ? (
+ # TODO: onwish, voted and onlist should respect the label filters in users.ulist_*
+ defined $fil->{ul_notblack} ? sql 'v.id NOT IN(SELECT vid FROM ulist_vns_labels WHERE uid =', \auth->uid, 'AND lbl =', \6, ')' : (),
+ defined $fil->{ul_onwish} ? sql 'v.id', $fil->{ul_onwish}?'':'NOT', 'IN(SELECT vid FROM ulist_vns_labels WHERE uid =', \auth->uid, 'AND lbl =', \5, ')' : (),
+ defined $fil->{ul_voted} ? sql 'v.id', $fil->{ul_voted} ?'':'NOT', 'IN(SELECT vid FROM ulist_vns_labels WHERE uid =', \auth->uid, 'AND lbl =', \7, ')' : (),
+ defined $fil->{ul_onlist} ? sql 'v.id', $fil->{ul_onlist}?'':'NOT', 'IN(SELECT vid FROM ulist_vns WHERE uid =', \auth->uid, ')' : (),
+ ) : (),
+}
+
+
+# Assumption: 'r' is an alias to the release table being queried.
+sub filter_release_query {
+ my($fil) = @_;
+ sql_and
+ defined $fil->{type} ? sql 'r.type =', \$fil->{type} : (),
+ defined $fil->{patch} ? sql($fil->{patch} ?'':'NOT', 'r.patch' ) : (),
+ defined $fil->{freeware} ? sql($fil->{freeware} ?'':'NOT', 'r.freeware' ) : (),
+ defined $fil->{doujin} ? sql($fil->{doujin} ?'':'NOT', 'r.doujin AND NOT r.patch') : (),
+ defined $fil->{uncensored} ? sql($fil->{uncensored}?'':'NOT', 'r.uncensored') : (),
+ defined $fil->{date_before} ? sql 'r.released <=', \$fil->{date_before} : (),
+ defined $fil->{date_after} ? sql 'r.released >=', \$fil->{date_after} : (),
+ defined $fil->{released} ? sql 'r.released', $fil->{released} ? '<=' : '>', \strftime('%Y%m%d', gmtime) : (),
+ defined $fil->{minage} ? sql 'r.minage IN', $fil->{minage} : (),
+ defined $fil->{lang} ? sql 'r.id IN(SELECT irl.id FROM releases_lang irl WHERE irl.lang IN', $fil->{lang}, ')' : (),
+ defined $fil->{olang} ? sql 'r.id IN(SELECT irv.id FROM releases_vn irv JOIN vn iv ON irv.vid = iv.id WHERE iv.c_olang && ARRAY', $fil->{olang}, '::language[])' : (),
+ defined $fil->{resolution} ? sql 'NOT r.patch AND ARRAY[r.reso_x,r.reso_y] IN', [ map $_ eq 'unknown' ? '{0,0}' : $_ eq 'nonstandard' ? '{0,1}' : '{'.(s/x/,/r).'}', $fil->{resolution}->@* ] : (),
+ defined $fil->{plat} ? sql_or(
+ grep( /^unk$/, $fil->{plat}->@*) ? sql 'NOT EXISTS(SELECT 1 FROM releases_platforms irp WHERE irp.id = r.id)' : (),
+ grep(!/^unk$/, $fil->{plat}->@*) ? sql 'r.id IN(SELECT irp.id FROM releases_platforms irp WHERE irp.platform IN', [grep !/^unk$/, $fil->{plat}->@*], ')' : (),
+ ) : (),
+ defined $fil->{prod_inc} ? sql 'r.id IN(SELECT irp.id FROM releases_producers irp WHERE irp.pid IN', $fil->{prod_inc}, ')' : (),
+ defined $fil->{prod_exc} ? sql 'r.id NOT IN(SELECT irp.id FROM releases_producers irp WHERE irp.pid IN', $fil->{prod_exc}, ')' : (),
+ defined $fil->{med} ? sql_or(
+ grep( /^unk$/, $fil->{med}->@*) ? sql 'NOT EXISTS(SELECT 1 FROM releases_media irm WHERE irm.id = r.id)' : (),
+ grep(!/^unk$/, $fil->{med}->@*) ? sql 'r.id IN(SELECT irm.id FROM releases_media irm WHERE irm.medium IN', [grep !/^unk$/, $fil->{med}->@*], ')' : (),
+ ) : (),
+ defined $fil->{voiced} ? sql 'NOT r.patch AND r.voiced IN', $fil->{voiced} : (),
+ defined $fil->{ani_story} ? sql 'NOT r.patch AND r.ani_story IN', $fil->{ani_story} : (),
+ defined $fil->{ani_ero} ? sql 'NOT r.patch AND r.ani_ero IN', $fil->{ani_ero} : (),
+ defined $fil->{engine} ? sql 'r.engine =', \$fil->{engine} : (),
+}
+
1;
diff --git a/lib/VNWeb/Misc/History.pm b/lib/VNWeb/Misc/History.pm
index 927afa98..691d035a 100644
--- a/lib/VNWeb/Misc/History.pm
+++ b/lib/VNWeb/Misc/History.pm
@@ -3,6 +3,7 @@ package VNWeb::Misc::History;
use VNWeb::Prelude;
+# Also used by Misc::HomePage
sub fetch {
my($type, $id, $filt, $opt) = @_;
diff --git a/lib/VNWeb/Misc/HomePage.pm b/lib/VNWeb/Misc/HomePage.pm
new file mode 100644
index 00000000..620acca7
--- /dev/null
+++ b/lib/VNWeb/Misc/HomePage.pm
@@ -0,0 +1,253 @@
+package VNWeb::Misc::HomePage;
+
+use VNWeb::Prelude;
+use VNWeb::Filters;
+use VNWeb::Discussions::Lib 'enrich_boards';
+use POSIX 'strftime';
+
+
+sub screens_ {
+ state $where ||= sql 'i.c_weight > 0 and vndbid_type(i.id) =', \'sf', 'and i.c_sexual_avg <', \0.4, 'and i.c_violence_avg <', \0.4;
+ state $stats ||= tuwf->dbRowi('SELECT count(*) as total, count(*) filter(where', $where, ') as subset from images i');
+ state $sample ||= 100*min 1, (200 / $stats->{subset}) * ($stats->{total} / $stats->{subset});
+
+ my $filt = auth->pref('filter_vn') && eval { filter_parse v => auth->pref('filter_vn') };
+ my $lst = $filt ? tuwf->dbAlli(
+ # Assumption: If we randomly select 30 matching VNs, there'll be at least 4 VNs with qualified screenshots
+ # (As of Sep 2020, over half of the VNs in the database have screenshots, so that assumption usually works)
+ 'SELECT * FROM (
+ SELECT DISTINCT ON (v.id) i.id, i.width, i,height, v.id AS vid, v.title
+ FROM (SELECT id, title FROM vn v WHERE NOT v.hidden AND ', filter_vn_query($filt), ' ORDER BY random() LIMIT', \30, ') v
+ JOIN vn_screenshots vs ON v.id = vs.id
+ JOIN images i ON i.id = vs.scr
+ WHERE ', $where, '
+ ORDER BY v.id
+ ) x ORDER BY random() LIMIT', \4
+ ) : tuwf->dbAlli('
+ SELECT i.id, i.width, i.height, v.id AS vid, v.title
+ FROM (SELECT id, width, height FROM images i TABLESAMPLE SYSTEM (', \$sample, ') WHERE', $where, ' ORDER BY random() LIMIT', \4, ') i(id)
+ JOIN vn_screenshots vs ON vs.scr = i.id
+ JOIN vn v ON v.id = vs.id
+ ORDER BY random()
+ LIMIT', \4
+ );
+
+ p_ class => 'screenshots', sub {
+ a_ href => "/v$_->{vid}", title => $_->{title}, sub {
+ my($w, $h) = imgsize $_->{width}, $_->{height}, tuwf->{scr_size}->@*;
+ img_ src => tuwf->imgurl($_->{id}), alt => $_->{title}, width => $w, height => $h;
+ } for @$lst;
+ }
+}
+
+
+sub recent_changes_ {
+ my($lst) = VNWeb::Misc::History::fetch(undef, undef, {m=>1,h=>1,p=>1}, {results=>10});
+ h1_ sub {
+ a_ href => '/hist', 'Recent Changes'; txt_ ' ';
+ a_ href => '/feeds/changes.atom', sub { abbr_ class => 'icons feed', title => 'Atom Feed', '' };
+ };
+ ul_ sub {
+ li_ sub {
+ txt_ "$_->{type}:";
+ a_ href => "/$_->{type}$_->{itemid}.$_->{rev}", title => $_->{original}||$_->{title}, shorten $_->{title}, 33;
+ lit_ " by ";
+ user_ $_;
+ } for @$lst;
+ };
+}
+
+
+sub announcements_ {
+ my $lst = tuwf->dbAlli('
+ SELECT t.id, t.title, substring(tp.msg, 1, 100+100+100) AS msg
+ FROM threads t
+ JOIN threads_boards tb ON tb.tid = t.id AND tb.type = \'an\'
+ JOIN threads_posts tp ON tp.tid = t.id AND tp.num = 1
+ WHERE NOT t.hidden AND NOT t.private
+ ORDER BY tb.tid DESC
+ LIMIT 1+1'
+ );
+ h1_ sub {
+ a_ href => '/t/an', 'Announcements'; txt_ ' ';
+ a_ href => '/feeds/announcements.atom', sub { abbr_ class => 'icons feed', title => 'Atom Feed', '' };
+ };
+ for (@$lst) {
+ h2_ sub { a_ href => "/$_->{id}", $_->{title} };
+ p_ sub { lit_ bb_format $_->{msg}, maxlength => 150, inline => 1 };
+ }
+}
+
+
+sub recent_posts_ {
+ my $lst = tuwf->dbAlli('
+ SELECT t.id, t.title, tp.num,', sql_totime('tp.date'), 'AS date, ', sql_user(), '
+ FROM threads t
+ JOIN threads_posts tp ON tp.tid = t.id AND tp.num = t.c_lastnum
+ LEFT JOIN users u ON tp.uid = u.id
+ WHERE NOT EXISTS(SELECT 1 FROM threads_boards tb WHERE tb.tid = t.id AND tb.type = \'u\')
+ AND NOT t.hidden AND NOT t.private
+ ORDER BY tp.date DESC
+ LIMIT 10'
+ );
+ enrich_boards undef, $lst;
+ h1_ sub {
+ a_ href => '/t/all', 'Recent Posts'; txt_ ' ';
+ a_ href => '/feeds/posts.atom', sub { abbr_ class => 'icons feed', title => 'Atom Feed', ''; };
+ };
+ ul_ sub {
+ li_ sub {
+ my $boards = join ', ', map $BOARD_TYPE{$_->{btype}}{txt}.($_->{iid}?' > '.$_->{title}:''), $_->{boards}->@*;
+ txt_ fmtage($_->{date}).' ';
+ a_ href => "/$_->{id}.$_->{num}#last", title => "Posted in $boards", shorten $_->{title}, 25;
+ lit_ ' by ';
+ user_ $_;
+ } for @$lst;
+ };
+}
+
+
+sub random_vns_ {
+ state $stats ||= tuwf->dbRowi('SELECT COUNT(*) AS total, COUNT(*) FILTER(WHERE NOT hidden) AS subset FROM vn');
+ state $sample ||= 100*min 1, (100 / $stats->{subset}) * ($stats->{total} / $stats->{subset});
+
+ my $filt = auth->pref('filter_vn') && eval { filter_parse v => auth->pref('filter_vn') };
+ my $lst = tuwf->dbAlli('
+ SELECT id, title, original
+ FROM vn v', $filt ? '' : ('TABLESAMPLE SYSTEM (', \$sample, ')'), '
+ WHERE NOT hidden AND', filter_vn_query($filt||{}), '
+ ORDER BY random() LIMIT 10'
+ );
+
+ h1_ sub {
+ a_ href => '/v/rand', 'Random visual novels';
+ };
+ ul_ sub {
+ li_ sub {
+ a_ href => "/v$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40;
+ } for @$lst;
+ }
+}
+
+
+sub releases_ {
+ my($released) = @_;
+
+ # XXX This query is kinda slow, an index on releases.released would probably help.
+ my $filt = auth->pref('filter_release') && eval { filter_parse r => auth->pref('filter_release') };
+ my $lst = tuwf->dbAlli('
+ SELECT id, title, original, released
+ FROM releases r
+ WHERE NOT hidden AND released', $released ? '<=' : '>', \strftime('%Y%m%d', gmtime), '
+ AND ', filter_release_query($filt||{}), '
+ ORDER BY released', $released ? 'DESC' : '', ', id LIMIT 10'
+ );
+ enrich_flatten plat => id => id => 'SELECT id, platform FROM releases_platforms WHERE id IN', $lst;
+ enrich_flatten lang => id => id => 'SELECT id, lang FROM releases_lang WHERE id IN', $lst;
+
+ h1_ sub {
+ a_ href => '/r?fil=released-0;o=a;s=released', 'Upcoming Releases' if !$released;
+ a_ href => '/r?fil=released-1;o=d;s=released', 'Just Released' if $released;
+ };
+ ul_ sub {
+ li_ sub {
+ rdate_ $_->{released};
+ txt_ ' ';
+ abbr_ class => "icons $_", title => $PLATFORM{$_}, '' for $_->{plat}->@*;
+ abbr_ class => "icons lang $_", title => $LANGUAGE{$_}, '' for $_->{lang}->@*;
+ txt_ ' ';
+ a_ href => "/r$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 30;
+ } for @$lst;
+ };
+}
+
+
+sub reviews_ {
+ my($full) = @_;
+ my $lst = tuwf->dbAlli('
+ SELECT w.id, v.title,', sql_user(), ',', sql_totime('w.date'), 'AS date
+ FROM reviews w
+ JOIN vn v ON v.id = w.vid
+ LEFT JOIN users u ON u.id = w.uid
+ WHERE ', $full ? '' : 'NOT', 'w.isfull
+ ORDER BY w.id DESC LIMIT 10'
+ );
+ h1_ sub {
+ a_ href => '/w', $full ? 'Latest Full Reviews' : 'Latest Mini Reviews';
+ };
+ ul_ sub {
+ li_ sub {
+ txt_ fmtage($_->{date}).' ';
+ a_ href => "/$_->{id}", title => $_->{title}, shorten $_->{title}, 25;
+ lit_ ' by ';
+ user_ $_;
+ } for @$lst;
+ }
+}
+
+
+sub recent_comments_ {
+ my $lst = tuwf->dbAlli('
+ SELECT w.id, wp.num, v.title,', sql_user(), ',', sql_totime('wp.date'), 'AS date
+ FROM reviews w
+ JOIN reviews_posts wp ON wp.id = w.id AND wp.num = w.c_lastnum
+ JOIN vn v ON v.id = w.vid
+ LEFT JOIN users u ON u.id = wp.uid
+ ORDER BY wp.date DESC LIMIT 10'
+ );
+ h1_ sub {
+ a_ href => '/w?s=lastpost', 'Recent Review Comments';
+ };
+ ul_ sub {
+ li_ sub {
+ txt_ fmtage($_->{date}).' ';
+ a_ href => "/$_->{id}.$_->{num}#last", title => $_->{title}, shorten $_->{title}, 25;
+ lit_ ' by ';
+ user_ $_;
+ } for @$lst;
+ };
+}
+
+
+TUWF::get qr{/}, sub {
+ my %meta = (
+ 'type' => 'website',
+ 'title' => 'The Visual Novel Database',
+ 'description' => 'VNDB.org strives to be a comprehensive database for information about visual novels.',
+ );
+
+ framework_ title => $meta{title}, feeds => 1, og => \%meta, index => 1, sub {
+ div_ class => 'mainbox', sub {
+ h1_ $meta{title};
+ p_ class => 'description', sub {
+ txt_ $meta{description};
+ br_;
+ txt_ q{
+ This website is built as a wiki, meaning that anyone can freely add
+ and contribute information to the database, allowing us to create the
+ largest, most accurate and most up-to-date visual novel database on the web.
+ };
+ };
+ screens_;
+ };
+ table_ class => 'mainbox threelayout', sub {
+ tr_ sub {
+ td_ \&recent_changes_;
+ td_ \&announcements_;
+ td_ \&recent_posts_;
+ };
+ tr_ sub {
+ td_ \&random_vns_;
+ td_ sub { releases_ 0 };
+ td_ sub { releases_ 1 };
+ };
+ tr_ sub {
+ td_ sub { reviews_ 0 };
+ td_ sub { reviews_ 1 };
+ td_ \&recent_comments_;
+ };
+ };
+ };
+};
+
+1;