From 722bb447e6218d522562007a4c8dcc4eb31f6582 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Sat, 12 Sep 2020 15:21:13 +0200 Subject: 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. --- lib/VNDB/DB/Discussions.pm | 176 ------------------------------- lib/VNDB/DB/Misc.pm | 77 -------------- lib/VNDB/DB/VN.pm | 43 +------- lib/VNDB/Handler/Misc.pm | 229 ---------------------------------------- lib/VNWeb/Filters.pm | 78 ++++++++++++++ lib/VNWeb/Misc/History.pm | 1 + lib/VNWeb/Misc/HomePage.pm | 253 +++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 333 insertions(+), 524 deletions(-) delete mode 100644 lib/VNDB/DB/Discussions.pm delete mode 100644 lib/VNDB/DB/Misc.pm create mode 100644 lib/VNWeb/Misc/HomePage.pm 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; -- cgit v1.2.3