diff options
author | Yorhel <git@yorhel.nl> | 2019-12-30 15:20:00 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2019-12-30 15:20:00 +0100 |
commit | d1bb5b82255c764edecc659c78d5b9f4e36555e8 (patch) | |
tree | 53058ac9a25d0e82968da77e28f46d1137204e6b /lib | |
parent | 13287329e70cbaf155c85e3054f2496411e21b21 (diff) | |
parent | ddb0d385eeb112de6e544adefbbac1cb0b8a957a (diff) |
Merge branch 'ulist'
Diffstat (limited to 'lib')
54 files changed, 408 insertions, 6262 deletions
diff --git a/lib/Multi/API.pm b/lib/Multi/API.pm index 5cb68c1b..120c3341 100644 --- a/lib/Multi/API.pm +++ b/lib/Multi/API.pm @@ -1036,20 +1036,22 @@ my %GET_USER = ( # the uid filter for votelist/vnlist/wishlist -my $UID_FILTER = [ 'int' => 'uid :op: :value:', {qw|= =|}, range => [0,1e6], process => \&subst_user_id ]; +my $UID_FILTER = [ 'int' => 'uv.uid :op: :value:', {qw|= =|}, range => [0,1e6], process => \&subst_user_id ]; # Similarly, a filter for 'vid' my $VN_FILTER = [ - [ 'int' => 'vid :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 'vid :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6], join => ',' ], + [ 'int' => 'uv.vid :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], + [ inta => 'uv.vid :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6], join => ',' ], ]; +my $UV_PUBLIC = 'EXISTS(SELECT 1 FROM ulist_vns_labels uvl JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND NOT ul.private)'; + my %GET_VOTELIST = ( islist => 1, - sql => "SELECT %s FROM votes v WHERE (%s) AND NOT EXISTS(SELECT 1 FROM users WHERE id = v.uid AND hide_list) %s", - sqluser => q{SELECT %1$s FROM votes v WHERE (%2$s) AND (uid = %4$d OR NOT EXISTS(SELECT 1 FROM users WHERE id = v.uid AND hide_list)) %3$s}, - select => "uid, vid as vn, vote, extract('epoch' from date) AS added", + sql => "SELECT %s FROM ulist_vns uv WHERE uv.vote IS NOT NULL AND (%s) AND $UV_PUBLIC %s", + sqluser => "SELECT %1\$s FROM ulist_vns uv WHERE uv.vote IS NOT NULL AND (%2\$s) AND (uid = %4\$d OR $UV_PUBLIC) %3\$s", + select => "uid, vid as vn, vote, extract('epoch' from vote_date) AS added", proc => sub { $_[0]{uid}*=1; $_[0]{vn}*=1; @@ -1062,37 +1064,44 @@ my %GET_VOTELIST = ( filters => { uid => [ $UID_FILTER ], vn => $VN_FILTER } ); +my $SQL_VNLIST = 'FROM ulist_vns uv LEFT JOIN ulist_vns_labels uvl ON uvl.uid = uv.uid AND uvl.vid = uv.vid AND uvl.lbl IN(1,2,3,4)' + .' WHERE (EXISTS(SELECT 1 FROM ulist_vns_labels uvl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND uvl.lbl IN(1,2,3,4))' + .' OR NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid))'; + my %GET_VNLIST = ( islist => 1, - sql => "SELECT %s FROM vnlists v WHERE (%s) AND NOT EXISTS(SELECT 1 FROM users WHERE id = v.uid AND hide_list) %s", - sqluser => q{SELECT %1$s FROM vnlists v WHERE (%2$s) AND (uid = %4$d OR NOT EXISTS(SELECT 1 FROM users WHERE id = v.uid AND hide_list)) %3$s}, - select => "uid, vid as vn, status, extract('epoch' from added) AS added, notes", + sql => "SELECT %s $SQL_VNLIST AND (%s) AND $UV_PUBLIC GROUP BY uv.uid, uv.vid, uv.added, uv.notes %s", + sqluser => "SELECT %1\$s $SQL_VNLIST AND (%2\$s) AND (uv.uid = %4\$d OR $UV_PUBLIC) GROUP BY uv.uid, uv.vid, uv.added, uv.notes %3\$s", + select => "uv.uid, uv.vid as vn, MAX(uvl.lbl) AS status, extract('epoch' from uv.added) AS added, uv.notes", proc => sub { $_[0]{uid}*=1; $_[0]{vn}*=1; - $_[0]{status}*=1; + $_[0]{status} = defined $_[0]{status} ? $_[0]{status}*1 : undef; $_[0]{added} = int $_[0]{added}; $_[0]{notes} ||= undef; }, sortdef => 'vn', - sorts => { vn => 'vid %s' }, + sorts => { vn => 'uv.vid %s' }, flags => { basic => {} }, filters => { uid => [ $UID_FILTER ], vn => $VN_FILTER } ); +my $SQL_WISHLIST = "FROM ulist_vns uv JOIN ulist_vns_labels uvl ON uvl.uid = uv.uid AND uvl.vid = uv.vid JOIN ulist_labels ul ON ul.uid = uv.uid AND ul.id = uvl.lbl" + ." WHERE (uvl.lbl IN(5,6) OR ul.label IN('Wishlist-Low','Wishlist-Medium','Wishlist-High'))"; + my %GET_WISHLIST = ( islist => 1, - sql => "SELECT %s FROM wlists w WHERE (%s) AND NOT EXISTS(SELECT 1 FROM users WHERE id = w.uid AND hide_list) %s", - sqluser => q{SELECT %1$s FROM wlists w WHERE (%2$s) AND (uid = %4$d OR NOT EXISTS(SELECT 1 FROM users WHERE id = w.uid AND hide_list)) %3$s}, - select => "uid, vid AS vn, wstat AS priority, extract('epoch' from added) AS added", + sql => "SELECT %s $SQL_WISHLIST AND (%s) AND NOT ul.private GROUP BY uv.uid, uv.vid, uv.added %s", + sqluser => "SELECT %1\$s $SQL_WISHLIST AND (%2\$s) AND (uv.uid = %4\$d OR NOT ul.private) GROUP BY uv.uid, uv.vid, uv.added %3\$s", + select => "uv.uid, uv.vid AS vn, MAX(ul.label) AS priority, extract('epoch' from uv.added) AS added", proc => sub { $_[0]{uid}*=1; $_[0]{vn}*=1; - $_[0]{priority}*=1; + $_[0]{priority} = {'Wishlist-High' => 0, 'Wishlist-Medium' => 1, 'Wishlist-Low' => 2, 'Blacklist' => 3}->{$_[0]{priority}}//1; $_[0]{added} = int $_[0]{added}; }, sortdef => 'vn', - sorts => { vn => 'vid %s' }, + sorts => { vn => 'uv.vid %s' }, flags => { basic => {} }, filters => { uid => [ $UID_FILTER ], vn => $VN_FILTER } ); @@ -1427,28 +1436,35 @@ sub setpg { }; } +sub set_ulist_ret { + my($c, $obj) = @_; + setpg $obj, 'SELECT update_users_ulist_stats($1)', [ $c->{uid} ]; # XXX: This can be deferred, to speed up batch updates over the same connection +} + sub set_votelist { my($c, $obj) = @_; - return setpg $obj, 'DELETE FROM votes WHERE uid = $1 AND vid = $2', - [ $c->{uid}, $obj->{id} ] if !$obj->{opt}; + return cpg $c, 'UPDATE ulist_vns SET vote = NULL, vote_date = NULL WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { + set_ulist_ret $c, $obj + } if !$obj->{opt}; my($ev, $vv) = (exists($obj->{opt}{vote}), $obj->{opt}{vote}); return cerr $c, missing => 'No vote given', field => 'vote' if !$ev; return cerr $c, badarg => 'Invalid vote', field => 'vote' if ref($vv) || !defined($vv) || $vv !~ /^\d+$/ || $vv < 10 || $vv > 100; - setpg $obj, 'WITH upsert AS (UPDATE votes SET vote = $1 WHERE uid = $2 AND vid = $3 RETURNING vid) - INSERT INTO votes (vote, uid, vid) SELECT $1, $2, $3 WHERE EXISTS(SELECT 1 FROM vn v WHERE v.id = $3) AND NOT EXISTS(SELECT 1 FROM upsert)', - [ $vv, $c->{uid}, $obj->{id} ]; + cpg $c, 'INSERT INTO ulist_vns (uid, vid, vote, vote_date) VALUES ($1, $2, $3, NOW()) ON CONFLICT (uid, vid) DO UPDATE SET vote = $3, vote_date = NOW(), lastmod = NOW()', + [ $c->{uid}, $obj->{id}, $vv ], sub { set_ulist_ret $c, $obj; } } sub set_vnlist { my($c, $obj) = @_; - return setpg $obj, 'DELETE FROM vnlists WHERE uid = $1 AND vid = $2', - [ $c->{uid}, $obj->{id} ] if !$obj->{opt}; + # Bug: Also removes from wishlist and votelist. + return cpg $c, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { + set_ulist_ret $c, $obj; + } if !$obj->{opt}; my($es, $en, $vs, $vn) = (exists($obj->{opt}{status}), exists($obj->{opt}{notes}), $obj->{opt}{status}, $obj->{opt}{notes}); return cerr $c, missing => 'No status or notes given', field => 'status,notes' if !$es && !$en; @@ -1458,34 +1474,63 @@ sub set_vnlist { $vs ||= 0; $vn ||= ''; - my $set = join ', ', $es ? 'status = $3' : (), $en ? 'notes = $4' : (); - setpg $obj, 'WITH upsert AS (UPDATE vnlists SET '.$set.' WHERE uid = $1 AND vid = $2 RETURNING vid) - INSERT INTO vnlists (uid, vid, status, notes) SELECT $1, $2, $3, $4 WHERE EXISTS(SELECT 1 FROM vn v WHERE v.id = $2) AND NOT EXISTS(SELECT 1 FROM upsert)', - [ $c->{uid}, $obj->{id}, $vs, $vn ]; + cpg $c, 'INSERT INTO ulist_vns (uid, vid, notes) VALUES ($1, $2, $3) ON CONFLICT (uid, vid) DO UPDATE SET lastmod = NOW()'.($en ? ', notes = $3' : ''), + [ $c->{uid}, $obj->{id}, $vn ], sub { + if($es) { + cpg $c, 'DELETE FROM ulist_vns_labels WHERE uid = $1 AND vid = $2 AND lbl IN(1,2,3,4)', [ $c->{uid}, $obj->{id} ], sub { + if($vs) { + cpg $c, 'INSERT INTO ulist_vns_labels (uid, vid, lbl) VALUES($1, $2, $3)', [ $c->{uid}, $obj->{id}, $vs ], sub { + set_ulist_ret $c, $obj; + } + } else { + set_ulist_ret $c, $obj; + } + } + } else { + set_ulist_ret $c, $obj; + } + } } sub set_wishlist { my($c, $obj) = @_; - return setpg $obj, 'DELETE FROM wlists WHERE uid = $1 AND vid = $2', - [ $c->{uid}, $obj->{id} ] if !$obj->{opt}; + my $sql_label = "(lbl IN(5,6) OR lbl IN(SELECT id FROM ulist_labels WHERE uid = \$1 AND label IN('Wishlist-Low','Wishlist-High','Wishlist-Medium')))"; + + # Bug: This will make it appear in the vnlist + return cpg $c, "DELETE FROM ulist_vns_labels WHERE uid = \$1 AND vid = \$2 AND $sql_label", + [ $c->{uid}, $obj->{id} ], sub { + set_ulist_ret $c, $obj; + } if !$obj->{opt}; my($ep, $vp) = (exists($obj->{opt}{priority}), $obj->{opt}{priority}); return cerr $c, missing => 'No priority given', field => 'priority' if !$ep; return cerr $c, badarg => 'Invalid priority', field => 'priority' if ref($vp) || !defined($vp) || $vp !~ /^[0-3]$/; - setpg $obj, 'WITH upsert AS (UPDATE wlists SET wstat = $1 WHERE uid = $2 AND vid = $3 RETURNING vid) - INSERT INTO wlists (wstat, uid, vid) SELECT $1, $2, $3 WHERE EXISTS(SELECT 1 FROM vn v WHERE v.id = $3) AND NOT EXISTS(SELECT 1 FROM upsert)', - [ $vp, $c->{uid}, $obj->{id} ]; + # Bug: High/Med/Low statuses are only set if a Wishlist-(High|Medium|Low) label exists; These should probably be created if they don't. + cpg $c, 'INSERT INTO ulist_vns (uid, vid) VALUES ($1, $2) ON CONFLICT DO NOTHING', [ $c->{uid}, $obj->{id} ], sub { + cpg $c, "DELETE FROM ulist_vns_labels WHERE uid = \$1 AND vid = \$2 AND $sql_label", [ $c->{uid}, $obj->{id} ], sub { + cpg $c, 'INSERT INTO ulist_vns_labels (uid, vid, lbl) VALUES($1, $2, $3)', [ $c->{uid}, $obj->{id}, $vp == 3 ? 6 : 5 ], sub { + if($vp != 3) { + cpg $c, 'INSERT INTO ulist_vns_labels (uid, vid, lbl) SELECT $1, $2, id FROM ulist_labels WHERE uid = $1 AND label = $3', + [ $c->{uid}, $obj->{id}, ['Wishlist-High', 'Wishlist-Medium', 'Wishlist-Low']->[$vp] ], sub { + set_ulist_ret $c, $obj; + } + } else { + set_ulist_ret $c, $obj; + } + } + } + } } - sub set_ulist { my($c, $obj) = @_; - return setpg $obj, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', - [ $c->{uid}, $obj->{id} ] if !$obj->{opt}; + return cpg $c, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { + set_ulist_ret $c, $obj; + } if !$obj->{opt}; my $opt = $obj->{opt}; my @set; @@ -1533,7 +1578,9 @@ sub set_ulist { return cerr $c, missing => 'No fields to change' if !@set; cpg $c, 'INSERT INTO ulist_vns (uid, vid) VALUES ($1, $2) ON CONFLICT (uid, vid) DO NOTHING', [ $c->{uid}, $obj->{id} ], sub { - setpg $obj, 'UPDATE ulist_vns SET '.join(',', @set).' WHERE uid = $1 AND vid = $2', \@bind; + cpg $c, 'UPDATE ulist_vns SET '.join(',', @set).' WHERE uid = $1 AND vid = $2', \@bind, sub { + set_ulist_ret $c, $obj; + } }; } diff --git a/lib/Multi/Maintenance.pm b/lib/Multi/Maintenance.pm index e19c1890..abed87a6 100644 --- a/lib/Multi/Maintenance.pm +++ b/lib/Multi/Maintenance.pm @@ -71,18 +71,8 @@ my %dailies = ( # takes about 25 seconds, OK traitcache => 'SELECT traits_chars_calc(NULL)', - # takes about 140 seconds, not really OK - vnpopularity => 'SELECT update_vnpopularity()', - - # takes about 3 seconds, can be performed in ranges as well when necessary - vnrating => q| - UPDATE vn SET - c_rating = (SELECT ( - ((SELECT COUNT(vote)::real/COUNT(DISTINCT vid)::real FROM votes)*(SELECT AVG(a)::real FROM (SELECT AVG(vote) FROM votes GROUP BY vid) AS v(a)) + SUM(vote)::real) / - ((SELECT COUNT(vote)::real/COUNT(DISTINCT vid)::real FROM votes) + COUNT(uid)::real) - ) FROM votes WHERE vid = id AND uid NOT IN(SELECT id FROM users WHERE ign_votes) - ), - c_votecount = COALESCE((SELECT count(*) FROM votes WHERE vid = id AND uid NOT IN(SELECT id FROM users WHERE ign_votes)), 0)|, + # takes about 4 seconds, OK + vnstats => 'SELECT update_vnvotestats()', # should be pretty fast cleangraphs => q| @@ -214,30 +204,3 @@ sub vnsearch_update { # id, res, time 1; - -__END__ - -# Shouldn't really be necessary, except c_changes could be slightly off when -# hiding/unhiding DB items. -# This query takes almost two hours to complete and tends to bring the entire -# site down with it, so it's been disabled for now. Can be performed in -# ranges though. -UPDATE users SET - c_votes = COALESCE( - (SELECT COUNT(vid) - FROM votes - WHERE uid = users.id - GROUP BY uid - ), 0), - c_changes = COALESCE( - (SELECT COUNT(id) - FROM changes - WHERE requester = users.id - GROUP BY requester - ), 0), - c_tags = COALESCE( - (SELECT COUNT(tag) - FROM tags_vn - WHERE uid = users.id - GROUP BY uid - ), 0) diff --git a/lib/VN3/BBCode.pm b/lib/VN3/BBCode.pm deleted file mode 100644 index a9922b4c..00000000 --- a/lib/VN3/BBCode.pm +++ /dev/null @@ -1,300 +0,0 @@ -package VN3::BBCode; - -use strict; -use warnings; -use v5.10; -use Exporter 'import'; -use TUWF::XML 'xml_escape'; - -our @EXPORT = qw/bb2html bb2text bb_subst_links/; - -# Supported BBCode: -# [spoiler] .. [/spoiler] -# [quote] .. [/quote] -# [code] .. [/code] -# [url=..] [/url] -# [raw] .. [/raw] -# link: http://../ -# dblink: v+, v+.+, d+#+, d+#+.+ -# -# Permitted nesting of formatting codes: -# spoiler -> url, raw, link, dblink -# quote -> anything -# code -> nothing -# url -> raw -# raw -> nothing - - -# State action function usage: -# _state_action \@stack, $match, $char_pre, $char_post -# Returns: ($token, @arg) on successful parse, () otherwise. - -# Trivial open and close actions -sub _spoiler_start { if(lc$_[1] eq '[spoiler]') { push @{$_[0]}, 'spoiler'; ('spoiler_start') } else { () } } -sub _quote_start { if(lc$_[1] eq '[quote]') { push @{$_[0]}, 'quote'; ('quote_start') } else { () } } -sub _code_start { if(lc$_[1] eq '[code]') { push @{$_[0]}, 'code'; ('code_start') } else { () } } -sub _raw_start { if(lc$_[1] eq '[raw]') { push @{$_[0]}, 'raw'; ('raw_start') } else { () } } -sub _spoiler_end { if(lc$_[1] eq '[/spoiler]') { pop @{$_[0]}; ('spoiler_end') } else { () } } -sub _quote_end { if(lc$_[1] eq '[/quote]' ) { pop @{$_[0]}; ('quote_end' ) } else { () } } -sub _code_end { if(lc$_[1] eq '[/code]' ) { pop @{$_[0]}; ('code_end' ) } else { () } } -sub _raw_end { if(lc$_[1] eq '[/raw]' ) { pop @{$_[0]}; ('raw_end' ) } else { () } } -sub _url_end { if(lc$_[1] eq '[/url]' ) { pop @{$_[0]}; ('url_end' ) } else { () } } - -sub _url_start { - if($_[1] =~ m{^\[url=((https?://|/)[^\]>]+)\]$}i) { - push @{$_[0]}, 'url'; - (url_start => $1) - } else { () } -} - -sub _link { - my(undef, $match, $char_pre, $char_post) = @_; - - # Tags arent links - return () if $match =~ /^\[/; - - # URLs (already "validated" in the parsing regex) - return ('link') if $match =~ /^[hf]t/; - - # Now we're left with various forms of IDs, just need to make sure it's not surrounded by word characters - return ('dblink') if $char_pre !~ /\w/ && $char_post !~ /\w/; - - (); -} - - -# Permitted actions to take in each state. The actions are run in order, if -# none succeed then the token is passed through as text. -# The "current state" is the most recent tag in the stack, or '' if no tags are open. -my %STATE = ( - '' => [ \&_link, \&_url_start, \&_raw_start, \&_spoiler_start, \&_quote_start, \&_code_start], - spoiler => [\&_spoiler_end, \&_link, \&_url_start, \&_raw_start], - quote => [\&_quote_end, \&_link, \&_url_start, \&_raw_start, \&_spoiler_start, \&_quote_start, \&_code_start], - code => [\&_code_end ], - url => [\&_url_end, \&_raw_start], - raw => [\&_raw_end ], -); - - -# Usage: -# -# parse $input, sub { -# my($raw, $token, @arg) = @_; -# return 1; # to continue processing, 0 to stop. (Note that _close tokens may still follow after stopping) -# }; -# -# $raw = the raw part that has been parsed -# $token = name of the parsed bbcode token, with some special cases (see below) -# @arg = $token-specific arguments. -# -# Tags: -# text -> literal text, $raw is the text to display -# spoiler_start -> start a spoiler -# spoiler_end -> end -# quote_start -> start a quote -# quote_end -> end -# code_start -> code block -# code_end -> end -# url_start -> [url=..], $arg[0] contains the url -# url_end -> [/url] -# raw_start -> [raw] -# raw_end -> [/raw] -# link -> http://.../, $raw is the link -# dblink -> v123, t13.1, etc. $raw is the dblink -# -# This function will ensure correct nesting of _start and _end tokens. -sub parse { - my($raw, $sub) = @_; - $raw =~ s/\r//g; - return if !$raw && $raw ne '0'; - - my $last = 0; - my @stack; - - while($raw =~ m{(?: - \[ \/? (?i: spoiler|quote|code|url|raw ) [^\s\]]* \] | # tag - d[1-9][0-9]* \# [1-9][0-9]* (?: \.[1-9][0-9]* )? | # d+#+[.+] - [tdvprcs][1-9][0-9]*\.[1-9][0-9]* | # v+.+ - [tdvprcsugi][1-9][0-9]* | # v+ - (?:https?|ftp)://[^><"\n\s\]\[]+[\d\w=/-] # link - )}xg) { - my $token = $&; - my $pre = substr $raw, $last, $-[0]-$last; - my $char_pre = $-[0] ? substr $raw, $-[0]-1, 1 : ''; - $last = pos $raw; - my $char_post = substr $raw, $last, 1; - - # Pass through the unformatted text before the match - $sub->($pre, 'text') || goto FINAL if length $pre; - - # Call the state functions. Arguments to these functions are implicitely - # passed through @_, which avoids allocating a new stack for each function - # call. - my $state = $STATE{ $stack[$#stack]||'' }; - my @ret; - @_ = (\@stack, $token, $char_pre, $char_post); - for(@$state) { - @ret = &$_; - last if @ret; - } - $sub->($token, @ret ? @ret : ('text')) || goto FINAL; - } - - $sub->(substr($raw, $last), 'text') if $last < length $raw; - -FINAL: - # Close all tags. This code is a bit of a hack, as it bypasses the state actions. - $sub->('', "${_}_end") for reverse @stack; -} - - -sub bb2html { - my($input, $maxlength, $charspoil) = @_; - - my $incode = 0; - my $rmnewline = 0; - my $length = 0; - my $ret = ''; - - # escapes, returns string, and takes care of $length and $maxlength; also - # takes care to remove newlines and double spaces when necessary - my $e = sub { - local $_ = shift; - - s/^\n// if $rmnewline && $rmnewline--; - s/\n{5,}/\n\n/g if !$incode; - s/ +/ /g if !$incode; - $length += length $_; - if($maxlength && $length > $maxlength) { - $_ = substr($_, 0, $maxlength-$length); - s/\W+\w*$//; # cleanly cut off on word boundary - } - s/&/&/g; - s/>/>/g; - s/</</g; - s/\n/<br>/g if !$maxlength; - s/\n/ /g if $maxlength; - $_; - }; - - parse $input, sub { - my($raw, $tag, @arg) = @_; - - #$ret .= "$tag {$raw}\n"; - #return 1; - - if($tag eq 'text') { - $ret .= $e->($raw); - - } elsif($tag eq 'spoiler_start') { - $ret .= !$charspoil - ? '<b class="spoiler">' - : '<b class="grayedout charspoil charspoil_-1"><hidden by spoiler settings></b><span class="charspoil charspoil_2 hidden">'; - } elsif($tag eq 'spoiler_end') { - $ret .= !$charspoil ? '</b>' : '</span>'; - - } elsif($tag eq 'quote_start') { - $ret .= '<div class="quote">' if !$maxlength; - $rmnewline = 1; - } elsif($tag eq 'quote_end') { - $ret .= '</div>' if !$maxlength; - $rmnewline = 1; - - } elsif($tag eq 'code_start') { - $ret .= '<pre>' if !$maxlength; - $rmnewline = 1; - $incode = 1; - } elsif($tag eq 'code_end') { - $ret .= '</pre>' if !$maxlength; - $rmnewline = 1; - $incode = 0; - - } elsif($tag eq 'url_start') { - $ret .= sprintf '<a href="%s" rel="nofollow">', xml_escape($arg[0]); - } elsif($tag eq 'url_end') { - $ret .= '</a>'; - - } elsif($tag eq 'link') { - $ret .= sprintf '<a href="%s" rel="nofollow">%s</a>', xml_escape($raw), $e->('link'); - - } elsif($tag eq 'dblink') { - (my $link = $raw) =~ s/^d(\d+)\.(\d+)\.(\d+)$/d$1#$2.$3/; - $ret .= sprintf '<a href="/%s">%s</a>', $link, $e->($raw); - } - - !$maxlength || $length < $maxlength; - }; - $ret; -} - - -# Convert bbcode into plain text, stripping all tags and spoilers. [url] tags -# only display the title. -sub bb2text { - my $input = shift; - - my $inspoil = 0; - my $ret = ''; - parse $input, sub { - my($raw, $tag, @arg) = @_; - if($tag eq 'spoiler_start') { - $inspoil = 1; - } elsif($tag eq 'spoiler_end') { - $inspoil = 0; - } else { - $ret .= $raw if !$inspoil && $tag !~ /_(start|end)$/; - } - 1; - }; - $ret; -} - - -# Turn (most) 'dblink's into [url=..] links. This function relies on TUWF to do -# the database querying, so can't be used from Multi. -# Doesn't handle: -# - d+, t+, r+ and u+ links -# - item revisions -sub bb_subst_links { - my $msg = shift; - - # Parse a message and create an index of links to resolve - my %lookup; - parse $msg, sub { - my($code, $tag) = @_; - $lookup{$1}{$2} = 1 if $tag eq 'dblink' && $code =~ /^(.)(\d+)/; - 1; - }; - return $msg unless %lookup; - - # Now resolve the links - state $types = { # Query must return 'id' and 'name' columns, list of IDs will be appended to it. - v => 'SELECT id, title AS name FROM vn WHERE id IN', - c => 'SELECT id, name FROM chars WHERE id IN', - p => 'SELECT id, name FROM producers WHERE id IN', - g => 'SELECT id, name FROM tags WHERE id IN', - i => 'SELECT id, name FROM traits WHERE id IN', - s => 'SELECT s.id, sa.name FROM staff_alias sa JOIN staff s ON s.aid = sa.id WHERE s.id IN', - }; - my %links; - for my $type (keys %$types) { - next if !$lookup{$type}; - my $lst = $TUWF::OBJ->dbAlli($types->{$type}, [keys %{$lookup{$type}}]); - $links{$type . $_->{id}} = $_->{name} for @$lst; - } - return $msg unless %links; - - # Now substitute - my $result = ''; - parse $msg, sub { - my($code, $tag) = @_; - $result .= $tag eq 'dblink' && $links{$code} - ? sprintf '[url=/%s]%s[/url]', $code, $links{$code} - : $code; - 1; - }; - return $result; -} - - -1; diff --git a/lib/VN3/Char/Edit.pm b/lib/VN3/Char/Edit.pm deleted file mode 100644 index e711eb17..00000000 --- a/lib/VN3/Char/Edit.pm +++ /dev/null @@ -1,168 +0,0 @@ -package VN3::Char::Edit; - -use VN3::Prelude; - - -my $FORM = { - alias => { required => 0, default => '', maxlength => 500 }, - desc => { required => 0, default => '', maxlength => 5000 }, - hidden => { anybool => 1 }, - locked => { anybool => 1 }, - original => { required => 0, default => '', maxlength => 200 }, - name => { maxlength => 200 }, - b_day => { uint => 1, range => [ 0, 31 ] }, - b_month => { uint => 1, range => [ 0, 12 ] }, - s_waist => { uint => 1, range => [ 0, 99999 ] }, - s_bust => { uint => 1, range => [ 0, 99999 ] }, - s_hip => { uint => 1, range => [ 0, 99999 ] }, - height => { uint => 1, range => [ 0, 99999 ] }, - weight => { uint => 1, range => [ 0, 99999 ], required => 0 }, - gender => { gender => 1 }, - bloodt => { blood_type => 1 }, - image => { required => 0, default => 0, id => 1 }, # X - main => { id => 1, required => 0 }, # X - main_spoil => { spoiler => 1 }, - main_name => { _when => 'out' }, - main_is => { _when => 'out', anybool => 1 }, # If true, this character is already a "main" character for other character(s) - traits => { maxlength => 200, sort_keys => 'tid', aoh => { - tid => { id => 1 }, # X - spoil => { spoiler => 1 }, - group => { _when => 'out' }, - name => { _when => 'out' }, - } }, - vns => { maxlength => 50, sort_keys => ['vid', 'rid'], aoh => { - vid => { id => 1 }, # X - rid => { id => 1, required => 0 }, # X - role => { char_role => 1 }, - spoil => { spoiler => 1 }, - title => { _when => 'out' }, - } }, - - vnrels => { _when => 'out', aoh => { - id => { id => 1 }, - releases => { aoh => { - id => { id => 1 }, - title => { }, - lang => { type => 'array', values => {} }, - } } - } }, - - id => { _when => 'out', required => 0, id => 1 }, - authmod => { _when => 'out', anybool => 1 }, - editsum => { _when => 'in out', editsum => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form CharEdit => $FORM_OUT, $FORM_IN; - - -sub vnrels { - my @vns = @_; - my $v = [ map +{ id => $_ }, @vns ]; - enrich_list releases => id => vid => sub { - sql q{SELECT rv.vid, r.id, r.title FROM releases r JOIN releases_vn rv ON rv.id = r.id WHERE NOT r.hidden AND rv.vid IN}, $_[0], q{ORDER BY r.id} - }, $v; - enrich_list1 lang => id => id => sub { sql 'SELECT id, lang FROM releases_lang WHERE id IN', $_[0], 'ORDER BY id, lang' }, map $_->{releases}, @$v; - $v -} - - -TUWF::get qr{/$CREV_RE/(?<type>edit|copy)} => sub { - my $c = entry c => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit c => $c; - my $copy = tuwf->capture('type') eq 'copy'; - - $c->{main_name} = $c->{main} ? tuwf->dbVali('SELECT name FROM chars WHERE id =', \$c->{main}) : ''; - $c->{main_is} = !$copy && tuwf->dbVali('SELECT 1 FROM chars WHERE main =', \$c->{id})||0; - - enrich tid => q{SELECT t.id AS tid, t.name, g.name AS group, g.order FROM traits t JOIN traits g ON g.id = t.group WHERE t.id IN} => $c->{traits}; - $c->{traits} = [ sort { $a->{order} <=> $b->{order} || $a->{name} cmp $b->{name} } @{$c->{traits}} ]; - - enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $c->{vns}; - $c->{vns} = [ sort { $a->{vid} <=> $b->{vid} } @{$c->{vns}} ]; - - my %vids = map +($_->{vid}, 1), @{$c->{vns}}; - $c->{vnrels} = vnrels keys %vids; - - $c->{authmod} = auth->permDbmod; - $c->{editsum} = $copy ? "Copied from c$c->{id}.$c->{chrev}" : $c->{chrev} == $c->{maxrev} ? '' : "Reverted to revision c$c->{id}.$c->{chrev}"; - - my $title = sprintf '%s %s', $copy ? 'Copy' : 'Edit', $c->{name}; - Framework index => 0, title => $title, - top => sub { - Div class => 'col-md', sub { - EntryEdit c => $c; - Div class => 'detail-page-title', sub { - Txt $title; - Debug $c; - }; - }; - }, sub { - FullPageForm module => 'CharEdit.Main', schema => $FORM_OUT, data => { %$c, $copy ? (id => undef) : () }, sections => [ - general => 'General info', - traits => 'Traits', - vns => 'Visual novels', - ]; - }; -}; - - -TUWF::get qr{/$VID_RE/addchar}, sub { - return tuwf->resDenied if !auth->permEdit; - - my $vn = tuwf->dbRowi('SELECT id, title FROM vn WHERE NOT hidden AND id =', \tuwf->capture('id')); - return tuwf->resNotFound if !$vn->{id}; - - my $data = { - vns => [ { vid => $vn->{id}, rid => undef, role => 'primary', spoil => 0, title => $vn->{title} } ], - vnrels => vnrels $vn->{id} - }; - - Framework index => 0, title => "Add a new character to $vn->{title}", narrow => 1, sub { - FullPageForm module => 'CharEdit.New', schema => $FORM_OUT, data => $data, sections => [ - general => 'General info', - format => 'Format', - relations => 'Relations' - ]; - }; -}; - - -json_api qr{/(?:$CID_RE/edit|c/add)}, $FORM_IN, sub { - my $data = shift; - my $new = !tuwf->capture('id'); - my $c = $new ? { id => 0 } : entry c => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit c => $c; - - if(!auth->permDbmod) { - $data->{hidden} = $c->{hidden}||0; - $data->{locked} = $c->{locked}||0; - } - $data->{main} = undef if $data->{hidden}; - $data->{main_spoil} = 0 if !$data->{main}; - - die "Image not found" if $data->{image} && !-e tuwf->imgpath(ch => $data->{image}); - if($data->{main}) { - die "Relation with self" if $data->{main} == $c->{id}; - die "Invalid main" if !tuwf->dbVali('SELECT 1 FROM chars WHERE main IS NULL AND id =', \$data->{main}); - die "Main set when self is main" if $c->{id} && tuwf->dbVali('SELECT 1 FROM chars WHERE main =', \$c->{id}); - } - validate_dbid 'SELECT id FROM traits WHERE id IN', map $_->{tid}, @{$data->{traits}}; - validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{vns}}; - for (grep $_->{rid}, @{$data->{vns}}) { - die "Invalid release $_->{rid}" if !tuwf->dbVali('SELECT 1 FROM releases_vn WHERE', { id => $_->{rid}, vid => $_->{vid} }); - } - - $data->{desc} = bb_subst_links $data->{desc}; - - return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $c; - - my($id,undef,$rev) = update_entry c => $c->{id}, $data; - $elm_Changed->($id, $rev); -}; - -1; diff --git a/lib/VN3/Char/JS.pm b/lib/VN3/Char/JS.pm deleted file mode 100644 index eafda3ad..00000000 --- a/lib/VN3/Char/JS.pm +++ /dev/null @@ -1,55 +0,0 @@ -package VN3::Char::JS; - -use VN3::Prelude; - - -my $elm_CharResult = elm_api CharResult => { aoh => { - id => { id => 1 }, - name => {}, - original => {}, - main => { type => 'hash', required => 0, keys => { - id => { id => 1 }, - name => {}, - original => {}, - }}, -}}; - -json_api '/js/char.json', { - search => { maxlength => 500 } -}, sub { - my $q = shift->{search}; - - # XXX: This query is kinda slow - my $qs = $q =~ s/[%_]//gr; - my $r = tuwf->dbAlli( - 'SELECT c.id, c.name, c.original, c.main, c2.name AS main_name, c2.original AS main_original', - 'FROM (', - # ID search - $q =~ /^$CID_RE$/ ? ('SELECT 1, id FROM chars WHERE id =', \"$1", 'UNION ALL') : (), - # exact match - 'SELECT 2, id FROM chars WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')', - 'UNION ALL', - # prefix match - 'SELECT 3, id FROM chars WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%", - 'UNION ALL', - # substring match - 'SELECT 4, id FROM chars WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%", - ') AS ct (ord, id)', - 'JOIN chars c ON c.id = ct.id', - 'LEFT JOIN chars c2 ON c2.id = c.main', - 'WHERE NOT c.hidden', - 'GROUP BY c.id, c.name, c.original, c.main, c2.name, c2.original', - 'ORDER BY MIN(ct.ord), c.name', - 'LIMIT 20' - ); - - for (@$r) { - $_->{main} = $_->{main} ? { id => $_->{main}, name => $_->{main_name}, original => $_->{main_original} } : undef; - delete $_->{main_name}; - delete $_->{main_original}; - } - - $elm_CharResult->($r); -}; - -1; diff --git a/lib/VN3/Char/Page.pm b/lib/VN3/Char/Page.pm deleted file mode 100644 index 11939060..00000000 --- a/lib/VN3/Char/Page.pm +++ /dev/null @@ -1,330 +0,0 @@ -package VN3::Char::Page; - -use VN3::Prelude; -use List::Util 'all', 'min'; - -sub Top { - my $e = shift; - - my $img = $e->{image} && tuwf->imgurl(ch => $e->{image}); - - Div class => 'fixed-size-left-sidebar-md', sub { - Img class => 'page-header-img-mobile img img--rounded d-md-none', src => $img; - Div class => 'detail-header-image-container', sub { - Img class => 'img img--fit img--rounded elevation-1 d-none d-md-block detail-header-image', src => $img; - }; - } if $img; - - Div class => 'col-md', sub { - EntryEdit c => $e; - Div class => 'detail-page-title', sub { - Txt $e->{name}; - Txt ' '.gender_icon $e->{gender}; - Txt ' '.blood_type_display $e->{bloodt} if $e->{bloodt} ne 'unknown'; - Debug $e; - }; - Div class => 'detail-page-subtitle', $e->{original} if $e->{original}; - }; -} - - -sub Settings { - my $spoil = auth->pref('spoilers') || 0; - my $ero = auth->pref('traits_sexual'); - - Div class => 'page-inner-controls', id => 'charpage_settings', sub { - Div class => 'page-inner-controls__option dropdown', sub { - A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub { - Span class => 'page-inner-controls__option-spoil', spoil_display $spoil; - Lit ' '; - Span class => 'caret', ''; - }; - Div class => 'dropdown-menu', sub { - A class => 'dropdown-menu__item page-inner-controls__option-spoil-0', href => 'javascript:;', spoil_display 0; - A class => 'dropdown-menu__item page-inner-controls__option-spoil-1', href => 'javascript:;', spoil_display 1; - A class => 'dropdown-menu__item page-inner-controls__option-spoil-2', href => 'javascript:;', spoil_display 2; - }; - }; - Div class => 'page-inner-controls__option', sub { - Switch 'Sexual traits', $ero, 'page-inner-controls__option-ero' => 1; - }; - }; -} - - -sub Description { - my $e = shift; - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - if($e->{image}) { - # second copy of image to ensure there's enough space (uh, mkay) - Img class => 'img img--fit d-none d-md-block detail-header-image-push', src => tuwf->imgurl(ch => $e->{image}); - } else { - H3 class => 'detail-page-sidebar-section-header', 'Description'; - } - }; - Div class => 'col-md', sub { - Div class => 'description serif mb-5', sub { - P sub { Lit bb2html $e->{desc} }; - }; - }; - } if $e->{desc}; -} - - -sub DetailsTable { - my $e = shift; - - my(%groups, @groups); - for(@{$e->{traits}}) { - push @groups, $_->{gid} if !$groups{$_->{gid}}; - push @{$groups{$_->{gid}}}, $_; - } - - # TODO: This was copy-pasted from VN::Page, need to consolidate (...once we figure out how to actually display chars on the VN page) - my @list = ( - $e->{alias} ? sub { - Dt 'Aliases'; - Dd $e->{alias} =~ s/\n/, /gr; - } : (), - - defined $e->{weight} || $e->{height} || $e->{s_bust} || $e->{s_waist} || $e->{s_hip} ? sub { - Dt 'Measurements'; - Dd join ', ', - $e->{height} ? "Height: $e->{height}cm" : (), - defined $e->{weight} ? "Weight: $e->{weight}kg" : (), - $e->{s_bust} || $e->{s_waist} || $e->{s_hip} ? - sprintf 'Bust-Waist-Hips: %s-%s-%scm', $e->{s_bust}||'??', $e->{s_waist}||'??', $e->{s_hip}||'??' : (); - } : (), - - $e->{b_month} && $e->{b_day} ? sub { - Dt 'Birthday'; - Dd sprintf '%d %s', $e->{b_day}, [qw{January February March April May June July August September October November December}]->[$e->{b_month}-1]; - } : (), - - # XXX: Group visibility is determined by the same 'charpage--x' classes - # as the individual traits (group is considered 'ero' if all traits are - # ero, and the lowest trait spoiler determines group spoiler level). - # But this has an unfortunate special case that isn't handled: A trait - # with (ero && spoil>0) in a group that isn't itself (ero && spoil>0) - # will display an empty group if settings are (ero && spoil==0). - # XXX#2: I'd rather have the traits delimited by a comma, but that's a - # hard problem to solve in combination with the dynamic hiding of - # traits. - (map { my $g = $_; sub { - my @c = mkclass - 'charpage--ero' => (all { $_->{sexual} } @{$groups{$g}}), - sprintf('charpage--spoil-%d', min map $_->{spoil}, @{$groups{$g}}) => 1; - - Dt @c, sub { A href => "/i$g", $groups{$g}[0]{group} }; - Dd @c, sub { - Join ' ', sub { - A mkclass('trait-summary--trait' => 1, 'charpage--ero' => $_[0]{sexual}, sprintf('charpage--spoil-%d', $_[0]{spoil}), 1), - style => 'padding-right: 15px; white-space: nowrap', - href => "/i$_[0]{tid}", $_[0]{name} - }, @{$groups{$g}}; - }; - } } @groups), - ); - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Details'; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Div class => 'card__section fs-medium', sub { - Div class => 'row', sub { - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] }; - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] }; - } - } - } - } - } if @list; -} - - -sub VNs { - my $e = shift; - - # TODO: Maybe this table should be full-width? - # TODO: Improved styling of release rows - - my $rows = sub { - for my $vn (@{$e->{vns}}) { - Tr class => sprintf('charpage--spoil-%d', $vn->{spoil}), sub { - Td class => 'tabular-nums muted', sub { ReleaseDate $vn->{c_released} }; - Td sub { - A href => "/v$vn->{vid}", title => $vn->{original}||$vn->{title}, $vn->{title}; - }; - Td $vn->{releases}[0]{rid} ? '' : join ', ', map char_role_display($_->{role}), @{$vn->{releases}}; - Td sub { - Join ', ', sub { - A href => "/s$_[0]{sid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name}; - Span class => 'muted', " ($_[0]{note})" if $_[0]{note}; - }, @{$vn->{seiyuu}}; - } - }; - for my $rel ($vn->{releases}[0]{rid} ? @{$vn->{releases}} : ()) { - Tr class => sprintf('charpage--spoil-%d', $rel->{spoil}), sub { - Td class => 'tabular-nums muted', $rel->{rid} ? sub { Lit ' '; ReleaseDate $rel->{released} } : ''; - Td sub { - Span class => 'muted', '» '; - A href => "/r$rel->{rid}", title => $rel->{title}||$rel->{original}, $rel->{title} if $rel->{rid}; - Span class => 'muted', 'Other releases' if !$rel->{rid}; - }; - Td char_role_display $rel->{role}; - Td ''; - }; - } - } - }; - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Visual Novels'; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Table class => 'table table--responsive-single-sm fs-medium', sub { - Thead sub { - Tr sub { - Th width => '15%', 'Date'; - Th width => '40%', 'Title'; - Th width => '20%', 'Role'; - Th width => '25%', 'Voiced by'; - }; - }; - Tbody $rows; - }; - } - } - } -} - - -sub Instances { - my $e = shift; - - return if !@{$e->{instances}}; - - my $minspoil = min map $_->{spoiler}, @{$e->{instances}}; - - Div class => sprintf('row charpage--spoil-%d', $minspoil), sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Other instances'; - }; - Div class => 'col-md', sub { - for my $c (@{$e->{instances}}) { - A class => sprintf('card card--white character-card mb-3 charpage--spoil-%d', $c->{spoiler}), href => "/c$c->{id}", sub { - Div class => 'character-card__left', sub { - Div class => 'character-card__image-container', sub { - Img class => 'character-card__image', src => tuwf->imgurl(ch => $c->{image}) if $c->{image}; - }; - Div class => 'character-card__main', sub { - Div class => 'character-card__name', sub { - Txt $c->{name}; - Txt ' '.gender_icon $c->{gender}; - Txt ' '.blood_type_display $c->{bloodt} if $c->{bloodt} ne 'unknown'; - }; - Div class => 'character-card__sub-name', $c->{original} if $c->{original}; - Div class => 'character-card__vns muted single-line', join ', ', map $_->{title}, @{$c->{vns}} if @{$c->{vns}}; - }; - Div class => 'character-card__right serif semi-muted', sub { - Lit bb2text $c->{desc}; # TODO: maxlength? - }; - } - } - } - }; - }; -} - - -TUWF::get qr{/$CREV_RE}, sub { - my $e = entry c => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resNotFound if !$e->{id} || $e->{hidden}; - - enrich tid => q{ - SELECT t.id AS tid, t.name, t.sexual, g.id AS gid, g.name AS group, g.order - FROM traits t - JOIN traits g ON g.id = t.group - WHERE t.id IN - }, $e->{traits}; - - $e->{traits} = [ sort { $a->{order} <=> $b->{order} || $a->{name} cmp $b->{name} } @{$e->{traits}} ]; - - $e->{vns} = tuwf->dbAlli(q{ - SELECT cv.vid, v.title, v.original, v.c_released, MIN(cv.spoil) AS spoil - FROM chars_vns_hist cv - JOIN vn v ON cv.vid = v.id - WHERE cv.chid =}, \$e->{chid}, q{ - GROUP BY v.c_released, cv.vid, v.title, v.original - ORDER BY v.c_released, cv.vid - }); - - enrich_list releases => vid => vid => sub {sql q{ - SELECT cv.rid, cv.vid, cv.role, cv.spoil, r.title, r.original, r.released - FROM chars_vns_hist cv - LEFT JOIN releases r ON r.id = cv.rid - WHERE cv.chid =}, \$e->{chid}, q{ - ORDER BY r.released, r.id - }}, $e->{vns}; - - enrich_list seiyuu => vid => vid => sub {sql q{ - SELECT vs.id AS vid, vs.note, sa.id AS sid, sa.aid, sa.name, sa.original - FROM vn_seiyuu vs - JOIN staff_alias sa ON vs.aid = sa.aid - WHERE vs.cid =}, \$e->{id}, q{ - ORDER BY sa.name, sa.aid - }}, $e->{vns}; - - $e->{instances} = tuwf->dbAlli(q{ - SELECT id, name, original, image, gender, bloodt, "desc", - (CASE WHEN id =}, \$e->{main}, THEN => \$e->{main_spoil}, q{ELSE main_spoil END) AS spoiler - FROM chars - WHERE NOT hidden - AND id <>}, \$e->{id}, q{ - AND ( main =}, \$e->{id}, q{ - OR main =}, \$e->{main}, q{ - OR id =}, \$e->{main}, q{ - ) - ORDER BY name, id - }); - enrich_list vns => id => cid => sub {sql q{ - SELECT cv.id AS cid, v.id, v.title - FROM chars_vns cv - JOIN vn v ON v.id = cv.vid - WHERE cv.id IN}, $_[0], q{ - AND cv.spoil = 0 - GROUP BY v.id, cv.id, v.title - ORDER BY MIN(cv.role), v.title, v.id - }}, $e->{instances}; - - my $spoil = auth->pref('spoilers') || 0; - my $ero = auth->pref('traits_sexual'); - - Framework - og => { - description => bb2text($e->{desc}), - $e->{image} ? (image => tuwf->imgurl(ch => $e->{image})) : () - }, - title => $e->{name}, - main_classes => { - 'charpage--hide-spoil-1' => $spoil < 1, - 'charpage--hide-spoil-2' => $spoil < 2, - 'charpage--hide-ero' => !$ero - }, - top => sub { Top $e }, - sub { - Settings $e; - Description $e; - DetailsTable $e; - VNs $e; - Instances $e; - }; -}; - -1; diff --git a/lib/VN3/DB.pm b/lib/VN3/DB.pm deleted file mode 100644 index 35b31660..00000000 --- a/lib/VN3/DB.pm +++ /dev/null @@ -1,287 +0,0 @@ -package VN3::DB; - -use v5.10; -use strict; -use warnings; -use TUWF; -use SQL::Interp ':all'; -use Carp 'carp'; -use VNWeb::DB (); # For the tuwf->dbVali etc methods -use base 'Exporter'; - -our @EXPORT = qw/ - sql - sql_join sql_comma sql_and sql_array sql_func sql_fromhex sql_tohex sql_fromtime sql_totime - enrich enrich_list enrich_list1 - entry update_entry -/; - - - -# sql_* are macros for SQL::Interp use - -# join(), but for sql objects. -sub sql_join { - my $sep = shift; - my @args = map +($sep, $_), @_; - shift @args; - return @args; -} - -# Join multiple arguments together with a comma, for use in a SELECT or IN -# clause or function arguments. -sub sql_comma { sql_join ',', @_ } - -sub sql_and { sql_join 'AND', map sql('(', $_, ')'), @_ } - -# Construct a PostgreSQL array type from the function arguments. -sub sql_array { 'ARRAY[', sql_join(',', map \$_, @_), ']' } - -# Call an SQL function -sub sql_func { - my($funcname, @args) = @_; - sql $funcname, '(', sql_comma(@args), ')'; -} - -# Convert a Perl hex value into Postgres bytea -sub sql_fromhex($) { - sql_func decode => \$_[0], "'hex'"; -} - -# Convert a Postgres bytea into a Perl hex value -sub sql_tohex($) { - sql_func encode => $_[0], "'hex'"; -} - -# Convert a Perl time value (UNIX timestamp) into a Postgres timestamp -sub sql_fromtime($) { - sql_func to_timestamp => \$_[0]; -} - -# Convert a Postgres timestamp into a Perl time value -sub sql_totime($) { - sql "extract('epoch' from ", $_[0], ')'; -} - - - -# Helper function for the enrich functions below. -sub _enrich { - my($merge, $key, $sql, @array) = @_; - - # 'flatten' the given array, so that you can also give arrayrefs as argument - @array = map +(ref $_ eq 'ARRAY' ? @$_ : $_), @array; - - # Create a list of unique identifiers to fetch, do nothing if there's nothing to fetch - my %ids = map +($_->{$key},1), @array; - return if !keys %ids; - - # Fetch the data - $sql = ref $sql eq 'CODE' ? $sql->([keys %ids]) : sql $sql, [keys %ids]; - my $data = tuwf->dbAlli($sql); - - # And merge - $merge->($data, \@array); -} - - -# This function is slightly magical: It is used to fetch information from the -# database and add it to an existing data structure. Usage: -# -# enrich $key, $sql, $object1, $object2, [$more_objects], ..; -# -# Where each $object is an hashref that will be modified in-place. $key is the -# name of a key that should be present in each $object, and indicates the value -# that should be used as database identifier to fetch more information. $sql is -# the SQL query that is used to fetch more information for each identifier. If -# $sql is a subroutine, then it is given an arrayref of keys (to be used in an -# WHERE x IN() clause), and should return a sql() query. If $sql is a string -# or sql() query itself, then the arrayref of keys is appended to it. The -# generated SQL query should return a column named $key, so that the other -# columns can be merged back into the $objects. -sub enrich { - my($key, $sql, @array) = @_; - _enrich sub { - my($data, $array) = @_; - my %ids = map +(delete($_->{$key}), $_), @$data; - # Copy the key to a temp variable to prevent stringifycation of integer keys - %$_ = (%$_, %{$ids{ (my $v = $_->{$key}) }}) for @$array; - }, $key, $sql, @array; -} - - -# Similar to enrich(), but instead of requiring a one-to-one mapping between -# $object->{$key} and the row returned by $sql, this function allows multiple -# rows to be returned by $sql. $object->{$key} is compared with $merge_col -# returned by the SQL query, the rows are stored as an arrayref in -# $object->{$name}. -sub enrich_list { - my($name, $key, $merge_col, $sql, @array) = @_; - _enrich sub { - my($data, $array) = @_; - my %ids = (); - push @{$ids{ delete $_->{$merge_col} }}, $_ for @$data; - $_->{$name} = $ids{ (my $v = $_->{$key}) }||[] for @$array; - }, $key, $sql, @array; -} - - -# Similar to enrich_list(), instead of returning each row as a hash, each row -# is taken to be a single value. -sub enrich_list1 { - my($name, $key, $merge_col, $sql, @array) = @_; - _enrich sub { - my($data, $array) = @_; - my %ids = (); - push @{$ids{ delete $_->{$merge_col} }}, values %$_ for @$data; - $_->{$name} = $ids{ (my $v = $_->{$key}) }||[] for @$array; - }, $key, $sql, @array; -} - - - - -# Database entry API: Intended to provide a low-level read/write interface for -# versioned database entires. The same data structure is used for reading and -# updating entries, and should support easy diffing/comparison. -# Probably not very convenient for general querying & searching, but we'll see. - -my %entry_prefixes = (qw{ - c chars - d docs - p producers - r releases - s staff - v vn -}); - -# Reads the database schema and creates a hash of -# 'table' => [versioned item-specific columns] -# for a particular entry prefix, where each column is a hash. -# -# These functions assume a specific table layout for versioned database -# entries, as documented in util/sql/schema.sql. -sub _entry_tables { - my $prefix = shift; - my $tables = tuwf->dbh->column_info(undef, undef, "$prefix%_hist", undef)->fetchall_arrayref({}); - my %tables; - for (@$tables) { - (my $t = $_->{TABLE_NAME}) =~ s/_hist$//; - next if $_->{COLUMN_NAME} eq 'chid'; - push @{$tables{$t}}, { - name => $_->{pg_column}, # Raw name, as it appears in the data structure - type => $_->{TYPE_NAME}, # Postgres type name - sql_ref => $_->{COLUMN_NAME}, # SQL to refer to this column - sql_read => $_->{COLUMN_NAME}, # SQL to read this column (could be used to transform the data to something perl likes) - sql_write => sub { \$_[0] }, # SQL to convert Perl data into something that can be assigned to the column - }; - } - \%tables; -} - - -sub _entry_type { - # Store the cached result of _entry_tables() for each entry type - state $types = { - map +($_, _entry_tables $entry_prefixes{$_}), - keys %entry_prefixes - }; - $types->{ shift() }; -} - - -# Returns everything for a specific entry ID. The top-level hash also includes -# the following keys: -# -# id, chid, rev, maxrev, hidden, locked, entry_hidden, entry_locked -# -# (Ordering of arrays is unspecified) -sub entry { - my($type, $id, $rev) = @_; - - my $prefix = $entry_prefixes{$type}||die; - my $t = _entry_type $type; - - my $maxrev = tuwf->dbVali('SELECT MAX(rev) FROM changes WHERE type =', \$type, ' AND itemid =', \$id); - return undef if !$maxrev; - $rev ||= $maxrev; - my $entry = tuwf->dbRowi(q{ - SELECT itemid AS id, id AS chid, rev AS chrev, ihid AS hidden, ilock AS locked - FROM changes - WHERE}, { type => $type, itemid => $id, rev => $rev } - ); - return undef if !$entry->{id}; - $entry->{maxrev} = $maxrev; - - if($maxrev == $rev) { - $entry->{entry_hidden} = $entry->{hidden}; - $entry->{entry_locked} = $entry->{locked}; - } else { - enrich id => "SELECT id, hidden AS entry_hidden, locked AS entry_locked FROM $prefix WHERE id IN", $entry; - } - - enrich chid => sql( - SELECT => sql_comma(chid => map $_->{sql_read}, @{$t->{$prefix}}), - FROM => "${prefix}_hist", - 'WHERE chid IN' - ), $entry; - - for my $tbl (grep /^${prefix}_/, keys %$t) { - (my $name = $tbl) =~ s/^${prefix}_//; - $entry->{$name} = tuwf->dbAlli( - SELECT => sql_comma(map $_->{sql_read}, @{$t->{$tbl}}), - FROM => "${tbl}_hist", - WHERE => { chid => $entry->{chid} }); - } - $entry -} - - -# Update or create an entry, usage: -# ($id, $chid, $rev) = update_entry $type, $id, $data, $uid; -# -# $id should be undef to create a new entry. -# $uid should be undef to use the currently logged in user. -# $data should have the same format as returned by entry(), but instead with -# the following additional keys in the top-level hash: -# -# hidden, locked, editsum -sub update_entry { - my($type, $id, $data, $uid) = @_; - $id ||= undef; - - my $prefix = $entry_prefixes{$type}||die; - my $t = _entry_type $type; - - tuwf->dbExeci("SELECT edit_${type}_init(", \$id, ', (SELECT MAX(rev) FROM changes WHERE type = ', \$type, ' AND itemid = ', \$id, '))'); - tuwf->dbExeci('UPDATE edit_revision SET', { - requester => $uid // scalar VNWeb::Auth::auth()->uid(), - ip => scalar tuwf->reqIP(), - comments => $data->{editsum}, - ihid => $data->{hidden}, - ilock => $data->{locked}, - }); - - tuwf->dbExeci("UPDATE edit_${prefix} SET ", - sql_comma(map sql($_->{sql_ref}, ' = ', $_->{sql_write}->($data->{$_->{name}})), @{$t->{$prefix}})); - - for my $tbl (grep /^${prefix}_/, keys %$t) { - (my $name = $tbl) =~ s/^${prefix}_//; - - my @rows = map { - my $d = $_; - sql '(', sql_comma(map $_->{sql_write}->($d->{$_->{name}}), @{$t->{$tbl}}), ')' - } @{$data->{$name}}; - - tuwf->dbExeci("DELETE FROM edit_${tbl}"); - tuwf->dbExeci("INSERT INTO edit_${tbl} ", - '(', sql_comma(map $_->{sql_ref}, @{$t->{$tbl}}), ')', - ' VALUES ', sql_comma(@rows) - ) if @rows; - } - - my $r = tuwf->dbRow("SELECT * FROM edit_${type}_commit()"); - ($r->{itemid}, $r->{chid}, $r->{rev}) -} - -1; diff --git a/lib/VN3/Docs/Edit.pm b/lib/VN3/Docs/Edit.pm deleted file mode 100644 index a93be5b2..00000000 --- a/lib/VN3/Docs/Edit.pm +++ /dev/null @@ -1,54 +0,0 @@ -package VN3::Docs::Edit; - -use VN3::Prelude; -use VN3::Docs::Lib; - - -my $FORM = { - title => { maxlength => 200 }, - content => { required => 0, default => '' }, - hidden => { anybool => 1 }, - locked => { anybool => 1 }, - - editsum => { _when => 'in out', editsum => 1 }, - id => { _when => 'out', id => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form DocEdit => $FORM_OUT, $FORM_IN; - - -TUWF::get qr{/$DREV_RE/edit} => sub { - my $d = entry d => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit d => $d; - - $d->{editsum} = $d->{chrev} == $d->{maxrev} ? '' : "Reverted to revision d$d->{id}.$d->{chrev}"; - - Framework title => "Edit $d->{title}", index => 0, - sub { - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md doc-list', \&Sidebar; - Div class => 'col-md col-md--4', sub { - Div 'data-elm-module' => 'DocEdit', - 'data-elm-flags' => JSON::XS->new->encode($FORM_OUT->analyze->coerce_for_json($d)), ''; - }; - }; - }; -}; - - -json_api qr{/$DOC_RE/edit}, $FORM_IN, sub { - my $data = shift; - my $doc = entry d => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit d => $doc; - return $elm_Unchanged->() if !form_changed $FORM_CMP, $data, $doc; - - my($id,undef,$rev) = update_entry d => $doc->{id}, $data; - $elm_Changed->($id, $rev); -}; - -1; diff --git a/lib/VN3/Docs/JS.pm b/lib/VN3/Docs/JS.pm deleted file mode 100644 index 397842fd..00000000 --- a/lib/VN3/Docs/JS.pm +++ /dev/null @@ -1,15 +0,0 @@ -package Docs::JS; - -use VN3::Prelude; -use VN3::Docs::Lib; - -my $elm_Content = elm_api Content => {}; - -json_api '/js/markdown.json', { - content => { required => 0, default => '' } -}, sub { - return $elm_Unauth->() if !auth->permDbmod; - $elm_Content->(md2html shift->{content}); -}; - -1; diff --git a/lib/VN3/Docs/Lib.pm b/lib/VN3/Docs/Lib.pm deleted file mode 100644 index e9239499..00000000 --- a/lib/VN3/Docs/Lib.pm +++ /dev/null @@ -1,86 +0,0 @@ -package VN3::Docs::Lib; - -use VN3::Prelude; -use Text::MultiMarkdown 'markdown'; - -our @EXPORT = qw/md2html Sidebar/; - - -sub md2html { - my $content = shift; - - $content =~ s{^:MODERATORS:$}{ - my %modperms = map auth->listPerms->{$_} & auth->defaultPerms ? () : ($_, auth->listPerms->{$_}), keys %{ auth->listPerms }; - my $l = tuwf->dbAlli('SELECT id, username, perm FROM users WHERE (perm & ', \(auth->allPerms &~ auth->defaultPerms), ') > 0 ORDER BY id LIMIT 100'); - '<dl>'.join('', map { - my $u = $_; - my $p = $u->{perm} >= auth->allPerms ? 'admin' - : join ', ', sort grep $u->{perm} & $modperms{$_}, keys %modperms; - sprintf '<dt><a href="/u%d">%s</a></dt><dd>%s</dd>', $_->{id}, $_->{username}, $p; - } @$l).'</dl>'; - }me; - - my $html = markdown $content, { - strip_metadata => 1, - img_ids => 0, - disable_footnotes => 1, - disable_bibliography => 1, - }; - - # Number sections and turn them into links - my($sec, $subsec) = (0,0); - $html =~ s{<h([1-2])[^>]+>(.*?)</h\1>}{ - if($1 == 1) { - $sec++; - $subsec = 0; - qq{<h2><a href="#$sec" name="$sec">$sec. $2</a></h2>} - } elsif($1 == 2) { - $subsec++; - qq|<h3><a href="#$sec.$subsec" name="$sec.$subsec">$sec.$subsec. $2</a></h3>\n| - } - }ge; - - # Text::MultiMarkdown doesn't handle fenced code blocks properly. The - # following solution breaks inline code blocks, but I don't use those anyway. - $html =~ s/<code>/<pre>/g; - $html =~ s#</code>#</pre>#g; - - $html -} - - -sub Cat { - Div class => 'doc-list__title', $_[0]; -} - -sub Doc { - A mkclass('doc-list__doc' => 1, 'doc-list__doc--active' => tuwf->capture('id') == $_[0]), - href => "/d$_[0]", $_[1]; -} - - -sub Sidebar { - # TODO: Turn this into a nav-sidebar for better mobile viewing? - Cat 'About VNDB'; - Doc 7, 'About us'; - Doc 6, 'FAQ'; - Doc 9, 'Discussion board'; - Doc 17, 'Privacy Policy & Licensing'; - Doc 11, 'Database API'; - Doc 14, 'Database Dumps'; - Doc 18, 'Database Querying'; - Doc 8, 'Development'; - - Cat 'Guidelines'; - Doc 5, 'Editing guidelines'; - Doc 2, 'Visual novels'; - Doc 15, 'Special games'; - Doc 3, 'Releases'; - Doc 4, 'Producers'; - Doc 16, 'Staff'; - Doc 12, 'Characters'; - Doc 10, 'Tags & Traits'; - Doc 13, 'Capturing screenshots'; -} - -1; diff --git a/lib/VN3/Docs/Page.pm b/lib/VN3/Docs/Page.pm deleted file mode 100644 index 0392434b..00000000 --- a/lib/VN3/Docs/Page.pm +++ /dev/null @@ -1,23 +0,0 @@ -package VN3::Docs::Page; - -use VN3::Prelude; -use VN3::Docs::Lib; - -TUWF::get qr{/$DREV_RE} => sub { - my $d = entry d => tuwf->capture('id'), tuwf->capture('rev'); - return tuwf->resNotFound if !$d || $d->{hidden}; - - Framework title => $d->{title}, - sub { - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md doc-list', \&Sidebar; - Div class => 'col-md doc', sub { - EntryEdit d => $d; - H1 $d->{title}; - Lit md2html $d->{content}; - }; - }; - }; -}; - -1; diff --git a/lib/VN3/ElmGen.pm b/lib/VN3/ElmGen.pm deleted file mode 100644 index fefc154e..00000000 --- a/lib/VN3/ElmGen.pm +++ /dev/null @@ -1,197 +0,0 @@ -# This module is responsible for generating elm3/Lib/Gen.elm. Variables and -# type definitions can be added from any Perl module by calling def(), -# elm_form() and elm_api() at file load time. - -package VN3::ElmGen; - -use strict; -use warnings; -use TUWF; -use Exporter 'import'; -use List::Util 'max'; -use VNWeb::Auth; -use VN3::Types; -use VNDB::Types; - -our @EXPORT = qw/ - elm_form elm_api - $elm_Unauth $elm_Unchanged $elm_Changed $elm_Success $elm_CSRF -/; - - -my $data = <<_; --- This file is automatically generated from lib/VN3/ElmGen.pm --- DO NOT EDIT! -module Lib.Gen exposing (..) - -import Http -import Json.Encode as JE -import Json.Decode as JD - -type alias Medium = - { qty : Bool - , single : String - , plural : String - } -_ - - - -# Formatting functions -sub indent($) { $_[0] =~ s/\n/\n /gr } -sub list { indent "\n[ ".join("\n, ", @_)."\n]" } -sub string($) { '"'.($_[0] =~ s/([\\"])/\\$1/gr).'"' } -sub tuple { '('.join(', ', @_).')' } -sub bool($) { $_[0] ? 'True' : 'False' } -sub to_camel { (ucfirst $_[0]) =~ s/_([a-z])/'_'.uc $1/egr; } - -# Output a variable definition: name, type, value -sub def($$$) { $data .= sprintf "\n%s : %s\n%1\$s = %s\n", @_; } - - -# Define an Elm type corresponding to a TUWF::Validate schema -sub def_type { - my($name, $obj) = @_; - my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys %{$obj->{keys}} : (); - - def_type($name . to_camel($_), $obj->{keys}{$_}{values} || $obj->{keys}{$_}) for @keys; - - $data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type( - keys => +{ map +($_, ($obj->{keys}{$_}{values} ? 'List ' : '') . $name . to_camel($_)), @keys } - ); -} - - -# Define an Elm JSON encoder taking a corresponding def_type() as input -sub encoder { - my($name, $type, $obj) = @_; - def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.'); -} - - -# Create type definitions and a JSON encoder for a typical form. -# Usage: -# -# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA; -# -# That will define: -# -# type alias FormName = { .. } -# type alias FormNameSend = { .. } -# formnameSendEncode : FormNameSend -> JE.Value -# -sub elm_form { - my($name, $out, $in) = @_; - def_type $name, $out->analyze; - def_type $name.'Send', $in->analyze; - encoder lc($name).'SendEncode', $name.'Send', $in->analyze; -} - - -my %apis; - -# Define an API response. This will be added to the 'Lib.Api.Response' union type. -# Usage: -# -# # At file scope: -# my $json_generator = elm_api_response UnionName => $SCHEMA1, $SCHEMA2, ..; -# -# # Later, to actually generate a JSON response: -# $json_generator->($data1, $data2, ..); -# -# Limitation: There may be only a single $SCHEMA with an embedded {type => 'hash'}. -sub elm_api { - my($name, @schema) = @_; - @schema = map tuwf->compile($_), @schema; - $apis{$name} = \@schema; - sub { - # TODO: Validate $data? Easier to catch bugs that way - tuwf->resJSON({$name, @schema ? [map $schema[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject'), 0..$#schema] : 1}) - } -} - -# Common API responses. -our $elm_Unauth = elm_api 'Unauth'; -our $elm_Unchanged = elm_api 'Unchanged'; -our $elm_Changed = elm_api 'Changed', { id => 1 }, { uint => 1 }; -our $elm_Success = elm_api 'Success'; -our $elm_CSRF = elm_api 'CSRF'; - - -sub print { - # Generate the ApiResponse type and decoder. - # - # Extract all { type => 'hash' } schemas and give them their own - # definition, so that it's easy to refer to those records in other places - # of the Elm code, similar to def_type(). - my(@union, @decode); - my $len = max map length, keys %apis; - for (sort keys %apis) { - my($name, $schema) = ($_, $apis{$_}); - my $def = $name; - my $dec = sprintf 'JD.field "%s"%s <| %s', $name, - ' 'x($len-(length $name)), - @$schema == 0 ? "JD.succeed $name" : - @$schema == 1 ? "JD.map $name" : sprintf 'JD.map%d %s', scalar @$schema, $name; - my $tname = "Api$name"; - for my $argn (0..$#$schema) { - my $arg = $schema->[$argn]->analyze(); - my $jd = $arg->elm_decoder(json_decode => 'JD.', level => 3); - $dec .= " (JD.index $argn $jd)"; - if($arg->{keys}) { - def_type $tname, $arg; - $def .= " $tname"; - #$dec .= $jd; - } elsif($arg->{values} && $arg->{values}{keys}) { - def_type $tname, $arg->{values}; - $def .= " (List $tname)"; - #$dec .= "(JD.list $jd)"; - } else { - $def .= ' '.$arg->elm_type(); - #$dec .= $jd; - } - #$dec .= ')'; - } - push @union, $def; - push @decode, $dec; - } - $data .= sprintf "\ntype ApiResponse\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union; - $data .= sprintf "\ndecodeApiResponse : JD.Decoder ApiResponse\ndecodeApiResponse = JD.oneOf\n [ %s\n ]", join "\n , ", @decode; - - print $data; -}; - - -my $perms = VNWeb::Auth::listPerms(); - -def urlStatic => String => string tuwf->conf->{url_static}; -def userPerms => 'List (Int, String)' => list map tuple($perms->{$_}, string $_), sort keys %$perms; -def vnLengths => 'List (Int, String)' => list map tuple($_, string vn_length_display $_), keys %VN_LENGTH; -def vnRelations => 'List (String, String)' => list map tuple(string $_, string vn_relation_display $_), keys %VN_RELATION; -def producerRelations => 'List (String, String)' => list map tuple(string $_, string producer_relation_display $_), keys %PRODUCER_RELATION; -def creditType => 'List (String, String)' => list map tuple(string $_, string $CREDIT_TYPE{$_}), keys %CREDIT_TYPE; -def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}), sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE; -def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORM{$_}), keys %PLATFORM; -def releaseTypes => 'List String' => list map string($_), release_types; -def producerTypes => 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPE{$_}), keys %PRODUCER_TYPE; -def minAges => 'List (Int, String)' => list map tuple($_, string minage_display_full $_), keys %AGE_RATING; -def resolutions => 'List (String, String)' => list map tuple(string $_, string resolution_display_full $_), keys %RESOLUTION; -def voiced => 'List (Int, String)' => list map tuple($_, string($VOICED{$_})), keys %VOICED; -def animated => 'List (Int, String)' => list map tuple($_, string($ANIMATED{$_})), keys %ANIMATED; -def genders => 'List (String, String)' => list map tuple(string $_, string gender_display $_), keys %GENDER; -def bloodTypes => 'List (String, String)' => list map tuple(string $_, string blood_type_display $_), keys %BLOOD_TYPE; -def charRoles => 'List (String, String)' => list map tuple(string $_, string char_role_display $_), keys %CHAR_ROLE; -def vnlistStatus => 'List (Int, String)' => list map tuple($_, string $VNLIST_STATUS{$_}), keys %VNLIST_STATUS; - -def emailPattern => String => string { tuwf->compile({ email => 1 })->analyze->html5_validation() }->{pattern}; -def weburlPattern => String => string { tuwf->compile({ weburl => 1 })->analyze->html5_validation() }->{pattern}; -def vnvotePattern => String => string { tuwf->compile({ vnvote => 1 })->analyze->html5_validation() }->{pattern}; - -def media => 'List (String, Medium)' => - list map tuple( - string($_), - sprintf('{ qty = %s, single = %s, plural = %s }', bool($MEDIUM{$_}{qty}), string($MEDIUM{$_}{txt}), string($MEDIUM{$_}{plural})) - ), keys %MEDIUM; - - -1; diff --git a/lib/VN3/HTML.pm b/lib/VN3/HTML.pm deleted file mode 100644 index 0dcd7241..00000000 --- a/lib/VN3/HTML.pm +++ /dev/null @@ -1,375 +0,0 @@ -# Convention: -# All HTML-generating functions are in CamelCase -# -# TODO: HTML generation for dropdowns can be abstracted more nicely. - -package VN3::HTML; - -use strict; -use warnings; -use v5.10; -use utf8; -use List::Util 'pairs', 'max', 'sum'; -use TUWF ':Html5', 'mkclass', 'uri_escape'; -use VNWeb::Auth; -use VN3::Types; -use VN3::Validation; -use base 'Exporter'; - -our @EXPORT = qw/Framework EntryEdit Switch Debug Join FullPageForm VoteGraph ListIcon GridIcon/; - - -sub Navbar { - Div class => 'nav navbar__nav navbar__main-nav', sub { - Div class => 'nav__item navbar__menu dropdown', sub { - A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt 'Database '; Span class => 'caret', '' }; - Div class => 'dropdown-menu database-menu', sub { - A class => 'dropdown-menu__item', href => '/v/all', 'Visual novels'; - A class => 'dropdown-menu__item', href => '/g', 'Tags'; - A class => 'dropdown-menu__item', href => '/c/all', 'Characters'; - A class => 'dropdown-menu__item', href => '/i', 'Traits'; - A class => 'dropdown-menu__item', href => '/p/all', 'Producers'; - A class => 'dropdown-menu__item', href => '/s/all', 'Staff'; - A class => 'dropdown-menu__item', href => '/r', 'Releases'; - }; - }; - Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/d6', 'FAQ' }; - Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/t', 'Forums' }; - Div class => 'nav__item navbar__menu dropdown', sub { - A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt 'Contribute '; Span class => 'caret', '' }; - Div class => 'dropdown-menu', sub { - A class => 'dropdown-menu__item', href => '/hist', 'Recent changes'; - A class => 'dropdown-menu__item', href => '/v/add', 'Add Visual Novel'; - A class => 'dropdown-menu__item', href => '/p/add', 'Add Producer'; - A class => 'dropdown-menu__item', href => '/s/new', 'Add Staff'; - }; - }; - Div class => 'nav__item navbar__menu', sub { - A href => '/v/all', class => 'nav__link', sub { - Span class => 'icon-desc d-md-none', 'Search '; - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/search.svg'; - }; - }; - }; - - Div class => 'nav navbar__nav', sub { - my $notifies = auth && tuwf->dbVali('SELECT count(*) FROM notifications WHERE uid =', \auth->uid, 'AND read IS NULL'); - Div class => 'nav__item navbar__menu', sub { - A href => '/'.auth->uid.'/notifies', class => 'nav__link notification-icon', sub { - Span class => 'icon-desc d-md-none', 'Notifications '; - Div class => 'icon-group', sub { - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/bell.svg'; - Div class => 'notification-icon__indicator', $notifies; - }; - }; - } if $notifies; - Div class => 'nav__item navbar__menu dropdown', sub { - A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt auth->username.' '; Span class => 'caret'; }; - Div class => 'dropdown-menu dropdown-menu--right', sub { - my $id = auth->uid; - A class => 'dropdown-menu__item', href => "/u$id", 'Profile'; - A class => 'dropdown-menu__item', href => "/u$id/edit", 'Settings'; - A class => 'dropdown-menu__item', href => "/u$id/list", 'List'; - A class => 'dropdown-menu__item', href => "/u$id/wish", 'Wishlist'; - A class => 'dropdown-menu__item', href => "/u$id/hist", 'Recent changes'; - A class => 'dropdown-menu__item', href => "/g/links?u=$id", 'Tags'; - Div class => 'dropdown__separator', ''; - A class => 'dropdown-menu__item', href => "/u$id/logout", 'Log out'; - }; - } if auth; - if(!auth) { - Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/u/register', 'Register'; }; - Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/u/login', 'Login'; }; - } - }; -} - - -sub Top { - my($opt) = @_; - Div class => 'raised-top-container', sub { - Div class => 'raised-top', sub { - Div class => 'container', sub { - Div class => 'navbar navbar--expand-md', sub { - Div class => 'navbar__logo', sub { - A href => '/', 'vndb'; - }; - A href => 'javascript:;', class => 'navbar__toggler', sub { - Div class => 'navbar__toggler-icon', ''; - }; - Div class => 'navbar__collapse', \&Navbar; - }; - Div class => 'row', $opt->{top} if $opt->{top}; - }; - }; - }; -} - - -sub Bottom { - Div class => 'col-md col-md--1', sub { - Div class => 'footer__logo', sub { - A href => '/', class => 'link-subtle', 'vndb'; - }; - }; - - state $sep = sub { Span class => 'footer__sep', sub { Lit '·'; }; }; - state $lnk = sub { A href => $_[0], class => 'link--subtle', $_[1]; }; - state $root = tuwf->root; - state $ver = `git -C "$root" describe` =~ /^(.+)$/ ? $1 : ''; - - Div class => 'col-md col-md--4', sub { - Div class => 'footer__nav', sub { - $lnk->('/d7', 'about us'); - $sep->(); - $lnk->('irc://irc.synirc.net/vndb', '#vndb'); - $sep->(); - $lnk->('mailto:contact@vndb.org', 'contact@vndb.org'); - $sep->(); - $lnk->('https://code.blicky.net/yorhel/vndb/src/branch/v3', 'source'); - $sep->(); - A href => '/v/rand', class => 'link--subtle footer__random', sub { - Txt 'random vn '; - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/random.svg'; - }; - $sep->(); - Txt $ver; - }; - - my $q = tuwf->dbRow('SELECT vid, quote FROM quotes ORDER BY random() LIMIT 1'); - Div class => 'footer__quote', sub { - $lnk->('/v'.$q->{vid}, $q->{quote}); - } if $q; - }; -} - - -sub Framework { - my $body = pop; - my %opt = @_; - Html sub { - Head prefix => 'og: http://ogp.me/ns#', sub { - Meta name => 'viewport', content => 'width=device-width, initial-scale=1, shrink-to-fit=no'; - Meta name => 'csrf-token', content => auth->csrftoken; - Meta charset => 'utf-8'; - Meta name => 'robots', content => 'noindex, follow' if exists $opt{index} && !$opt{index}; - Title $opt{title} . ' | vndb'; - Link rel => 'stylesheet', href => tuwf->conf->{url_static}.'/v3/style.css'; - Link rel => 'shortcut icon', href => '/favicon.ico', type => 'image/x-icon'; - Link rel => 'search', type => 'application/opensearchdescription+xml', title => 'VNDB VN Search', href => tuwf->reqBaseURI().'/opensearch.xml'; - - # TODO: Link to RSS feeds. - - # Opengraph metadata - if($opt{og}) { - $opt{og}{site_name} ||= 'The Visual Novel Database'; - $opt{og}{type} ||= 'object'; - $opt{og}{image} ||= 'https://s.vndb.org/s/angel/bg.jpg'; # TODO: Something better - $opt{og}{url} ||= tuwf->reqURI; - $opt{og}{title} ||= $opt{title}; - Meta property => "og:$_", content => ($opt{og}{$_} =~ s/\n/ /gr) for sort keys %{$opt{og}}; - } - }; - Body sub { - Div class => 'top-bar', id => 'top', ''; - Top \%opt; - Div class => 'page-container', sub { - Div mkclass( - container => 1, - 'main-container' => 1, - 'container--narrow' => $opt{narrow}, - 'flex-center-container' => $opt{center}, - 'main-container--single-col' => $opt{single_col}, - $opt{main_classes} ? %{$opt{main_classes}} :() - ), $body; - Div class => 'container', sub { - Div class => 'footer', sub { - Div class => 'row', \&Bottom; - }; - }; - }; - Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/elm.js', ''; - Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/vndb.js', ''; - #Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/min.js', ''; - }; - }; - if(tuwf->debug) { - tuwf->dbCommit; # Hack to measure the commit time - - my $sql = uri_escape join "\n", map { - my($sql, $params, $time) = @$_; - sprintf " [%6.2fms] %s | %s", $time*1000, $sql, - join ', ', map "$_:".DBI::neat($params->{$_}), - sort { $a =~ /^[0-9]+$/ && $b =~ /^[0-9]+$/ ? $a <=> $b : $a cmp $b } - keys %$params; - } @{ tuwf->{_TUWF}{DB}{queries} }; - A href => 'data:text/plain,'.$sql, 'SQL'; - - my $modules = uri_escape join "\n", sort keys %INC; - A href => 'data:text/plain,'.$modules, 'Modules'; - } -} - - -sub EntryEdit { - my($type, $e) = @_; - - return if $type eq 'u' && !auth->permUsermod; - - Div class => 'dropdown pull-right', sub { - A href => 'javascript:;', class => 'btn d-block dropdown__toggle', sub { - Div class => 'opacity-muted', sub { - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/edit.svg'; - Span class => 'caret', ''; - }; - }; - Div class => 'dropdown-menu dropdown-menu--right database-menu', sub { - A class => 'dropdown-menu__item', href => "/$type$e->{id}", 'Details'; - A class => 'dropdown-menu__item', href => "/$type$e->{id}/hist", 'History' if $type ne 'u'; - A class => 'dropdown-menu__item', href => "/$type$e->{id}/edit", 'Edit' if can_edit $type, $e; - A class => 'dropdown-menu__item', href => "/$type$e->{id}/add", 'Add release' if $type eq 'v' && can_edit $type, $e; - A class => 'dropdown-menu__item', href => "/$type$e->{id}/addchar",'Add character' if $type eq 'v' && can_edit $type, $e; - A class => 'dropdown-menu__item', href => "/$type$e->{id}/copy", 'Copy' if $type =~ /[cr]/ && can_edit $type, $e; - }; - } -} - - -sub Switch { - my $label = shift; - my $on = shift; - my @class = mkclass - 'switch' => 1, - 'switch--on' => $on, - @_; - - A @class, href => 'javascript:;', sub { - Div class => 'switch__label', $label; - Div class => 'switch__toggle', ''; - }; -} - - -# Throw any data structure on the page for inspection. -sub Debug { - return if !tuwf->debug; - require JSON::XS; - # This provides a nice JSON browser in FF, not sure how other browsers render it. - my $data = uri_escape(JSON::XS->new->canonical->encode($_[0])); - A style => 'margin: 0 5px', title => 'Debug', href => 'data:application/json,'.$data, ' ⚙ '; -} - - -# Similar to join($sep, map $item->($_), @list), but works for HTML generation functions. -# Join ', ', sub { A href => '#', $_[0] }, @list; -# Join \&Br, \&Txt, @list; -sub Join { - my($sep, $item, @list) = @_; - for my $i (0..$#list) { - ref $sep ? $sep->() : Txt $sep if $i > 0; - $item->($list[$i]); - } -} - - -# Full-page form, optionally with sections. Options: -# -# module => '', # Elm module to load -# data => $form_data, -# schema => $tuwf_validate_schema, # Optional TUWF::Validate schema to use to encode the data -# sections => [ # Optional list of sections -# anchor1 => 'Section 1', -# .. -# ] -# -# If no sections are given, the parent Framework() should have narrow => 1. -sub FullPageForm { - my %o = @_; - - my $form = sub { Div - 'data-elm-module' => $o{module}, - 'data-elm-flags' => JSON::XS->new->encode($o{schema} ? $o{schema}->analyze->coerce_for_json($o{data}) : $o{data}), - '' - }; - - Div class => 'row', $o{sections} ? sub { - - Div class => 'col-md col-md--1', sub { - Div class => 'nav-sidebar nav-sidebar--expand-md', sub { - A href => 'javascript:;', class => 'nav-sidebar__selection', sub { - Txt $o{sections}[1]; - Div class => 'caret', ''; - }; - Div class => 'nav nav--vertical', sub { - my $x = 0; - for my $s (pairs @{$o{sections}}) { - Div mkclass(nav__item => 1, 'nav__item--active' => !$x++), sub { - A class => 'nav__link', href => '#'.$s->key, $s->value; - } - } - }; - } - }; - Div class => 'col-md col-md--4', $form; - } : sub { - Div class => 'col-md col-md--1', $form; - }; -} - - -sub VoteGraph { - my($type, $id) = @_; - - my %histogram = map +($_->{vote}, $_), @{ tuwf->dbAlli(q{ - SELECT (vote::numeric/10)::int AS vote, COUNT(vote) as votes, SUM(vote) AS total - FROM votes}, - $type eq 'v' ? (q{ - JOIN users ON id = uid AND NOT ign_votes - WHERE vid =}, \$id - ) : (q{ - WHERE uid =}, \$id - ), q{ - GROUP BY (vote::numeric/10)::int - })}; - - my $max = max map $_->{votes}, values %histogram; - my $count = sum map $_->{votes}, values %histogram; - my $sum = sum map $_->{total}, values %histogram; - - my $Graph = sub { - Div class => 'vote-graph', sub { - Div class => 'vote-graph__scores', sub { - Div class => 'vote-graph__score', $_ for (reverse 1..10); - }; - Div class => 'vote-graph__bars', sub { - Div class => 'vote-graph__bar', style => sprintf('width: %.2f%%', ($histogram{$_}{votes}||0)/$max*100), sub { - Div class => 'vote-graph__bar-label', $histogram{$_}{votes}||'1'; - } for (reverse 1..10); - }; - }; - Div class => 'final-text', - sprintf '%d vote%s total, average %.2f%s', - $count, $count == 1 ? '' : 's', $sum/$count/10, - $type eq 'v' ? ' ('.vote_string($sum/$count).')' : ''; - }; - return ($count, $Graph); -} - -sub ListIcon { - Lit q{<svg class="svg-icon" xmlns="http://www.w3.org/2000/svg" width="14" height="14" version="1">} - .q{<g fill="currentColor" fill-rule="nonzero">} - .q{<path d="M0 2h14v2H0zM0 6h14v2H0zM0 10h14v2H0z"/>} - .q{</g>} - .q{</svg>}; -} - - -sub GridIcon { - Lit q{<svg class="svg-icon" xmlns="http://www.w3.org/2000/svg" width="14" height="14" version="1">} - .q{<g fill="currentColor" fill-rule="nonzero">} - .q{<path d="M0 0h3v3H0zM0 5h3v3H0zM0 10h3v3H0zM5 0h3v3H5zM5 5h3v3H5zM5 10h3v3H5zM10 0h3v3h-3zM10 5h3v3h-3zM10 10h3v3h-3z"/>} - .q{</g>} - .q{</svg>}; -} - -1; diff --git a/lib/VN3/Misc/Homepage.pm b/lib/VN3/Misc/Homepage.pm deleted file mode 100644 index b9939b07..00000000 --- a/lib/VN3/Misc/Homepage.pm +++ /dev/null @@ -1,31 +0,0 @@ -package VN3::User::Login; - -use VN3::Prelude; - - -TUWF::get '/' => sub { - Framework title => 'VNDB', sub { - H1 'Hello, World!'; - P sub { - Txt 'This is the place where version 3 of '; - A href => 'https://vndb.org/', 'VNDB.org'; - Txt ' is being developed. Some random notes:'; - Ul sub { - Li 'This test site interfaces directly with the same database as the main site, which makes it easier to test all the functionality and find odd test cases.'; - Li 'This test site is very incomplete, don\'t be surprised to see 404\'s or other things that don\'t work.'; - Li 'This is a long-term project, don\'t expect this new design to replace the main site anytime soon.'; - Li sub { - Txt 'Feedback/comments/ideas or want to help out? Post in '; - A href => 'https://code.blicky.net/yorhel/vndb/issues/2', 'this issue'; - Txt ' or create a new one.'; - }; - Li sub { - Txt 'You can follow development activity on the '; - A href => 'https://code.blicky.net/yorhel/vndb/src/branch/v3', 'git repo.'; - }; - }; - }; - }; -}; - -1; diff --git a/lib/VN3/Misc/ImageUpload.pm b/lib/VN3/Misc/ImageUpload.pm deleted file mode 100644 index 76a07975..00000000 --- a/lib/VN3/Misc/ImageUpload.pm +++ /dev/null @@ -1,70 +0,0 @@ -package VN3::Misc::ImageUpload; - -use VN3::Prelude; -use Image::Magick; - - -sub save_img { - my($im, $dir, $id, $ow, $oh, $pw, $ph) = @_; - - if($pw) { - my($nw, $nh) = imgsize($ow, $oh, $pw, $ph); - if($ow != $nw || $oh != $nh) { - $im->GaussianBlur(geometry => '0.5x0.5'); - $im->Resize(width => $nw, height => $nh); - $im->UnsharpMask(radius => 0, sigma => 0.75, amount => 0.75, threshold => 0.008); - } - } - - my $fn = tuwf->imgpath($dir, $id); - $im->Write($fn); - chmod 0666, $fn; -} - -my $elm_ImgFormat = elm_api 'ImgFormat'; -my $elm_Image = elm_api 'Image', {id=>1}, {uint=>1}, {uint=>1}; # id, width, height - - -TUWF::post '/js/imageupload.json', sub { - if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) { - warn "Invalid CSRF token in request"; - return $elm_CSRF->(); - } - return $elm_Unauth->() if !auth->permEdit; - - my $type = tuwf->validate(post => type => { enum => [qw/cv ch sf/] })->data; - my $imgdata = tuwf->reqUploadRaw('img'); - return $elm_ImgFormat->() if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG header - - my $im = Image::Magick->new; - $im->BlobToImage($imgdata); - $im->Set(magick => 'JPEG'); - $im->Set(background => '#ffffff'); - $im->Set(alpha => 'Remove'); - $im->Set(quality => 90); - my($ow, $oh) = ($im->Get('width'), $im->Get('height')); - my $id; - - - # VN cover image - if($type eq 'cv') { - $id = tuwf->dbVali("SELECT nextval('covers_seq')"); - save_img $im, cv => $id, $ow, $oh, 256, 400; - - # Screenshot - } elsif($type eq 'sf') { - $id = tuwf->dbVali('INSERT INTO screenshots', { width => $ow, height => $oh }, 'RETURNING id'); - save_img $im, sf => $id; - save_img $im, st => $id, $ow, $oh, 136, 102; - - # Character image - } elsif($type eq 'ch') { - $id = tuwf->dbVali("SELECT nextval('charimg_seq')"); - save_img $im, ch => $id, $ow, $oh, 256, 300; - } - - $elm_Image->($id, $ow, $oh); -}; - - -1; diff --git a/lib/VN3/Prelude.pm b/lib/VN3/Prelude.pm deleted file mode 100644 index a10a66ac..00000000 --- a/lib/VN3/Prelude.pm +++ /dev/null @@ -1,104 +0,0 @@ -# Importing this module is equivalent to: -# -# use strict; -# use warnings; -# use v5.10; -# use utf8; -# -# use TUWF ':Html5', 'mkclass'; -# use Exporter 'import'; -# use Time::HiRes 'time'; -# -# use VNDBUtil; -# use VNDB::Types; -# use VNWeb::Auth; -# use VN3::HTML; -# use VN3::DB; -# use VN3::Types; -# use VN3::Validation; -# use VN3::BBCode; -# use VN3::ElmGen; -# -# WARNING: This should not be used from the above modules. -# -# This module also exports a few utility functions for writing URI handlers. -package VN3::Prelude; - -use strict; -use warnings; -use utf8; -use feature ':5.10'; -use TUWF; -use VNWeb::Auth; -use VN3::ElmGen; - -sub import { - my $c = caller; - - strict->import; - warnings->import; - feature->import(':5.10'); - utf8->import; - - die $@ if !eval <<" EOM;"; - package $c; - - use TUWF ':Html5', 'mkclass'; - use Exporter 'import'; - use Time::HiRes 'time'; - - use VNDBUtil; - use VNDB::Types; - use VNWeb::Auth; - use VN3::HTML; - use VN3::DB; - use VN3::Types; - use VN3::Validation; - use VN3::BBCode; - use VN3::ElmGen; - 1; - EOM; - - no strict 'refs'; - *{$c.'::json_api'} = \&json_api; -} - - - -# Easy wrapper to create a simple API that accepts JSON data on POST requests. -# The CSRF token and the input data are validated before the subroutine is -# called. -# -# Usage: -# -# json_api '/some/url', { -# username => { maxlength => 10 }, -# }, sub { -# my $validated_data = shift; -# }; -my $elm_Invalid = elm_api 'Invalid', {}; -sub json_api { - my($path, $keys, $sub) = @_; - - my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys; - - TUWF::post $path => sub { - if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) { - warn "Invalid CSRF token in request\n"; - $elm_CSRF->(); - return; - } - - my $data = tuwf->validate(json => $schema); - if(!$data) { - warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n"; - $elm_Invalid->($data->err); - return; - } - - $sub->($data->data); - warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/; - }; -} - -1; diff --git a/lib/VN3/Producer/Edit.pm b/lib/VN3/Producer/Edit.pm deleted file mode 100644 index 3643d771..00000000 --- a/lib/VN3/Producer/Edit.pm +++ /dev/null @@ -1,136 +0,0 @@ -package VN3::Producer::Edit; - -use VN3::Prelude; - - -my $FORM = { - alias => { required => 0, default => '', maxlength => 500 }, - desc => { required => 0, default => '', maxlength => 5000 }, - hidden => { anybool => 1 }, - l_wp => { required => 0, default => '', maxlength => 150 }, - lang => { language => 1 }, - locked => { anybool => 1 }, - original => { required => 0, default => '', maxlength => 200 }, - name => { maxlength => 200 }, - ptype => { enum => \%PRODUCER_TYPE }, # This is 'type' in the database, but renamed for Elm compat - relations => { maxlength => 50, sort_keys => 'pid', aoh => { - pid => { id => 1 }, # X - relation => { producer_relation => 1 }, - name => { _when => 'out' }, - } }, - website => { required => 0, default => '', weburl => 1 }, - - id => { _when => 'out', required => 0, id => 1 }, - authmod => { _when => 'out', anybool => 1 }, - editsum => { _when => 'in out', editsum => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form ProdEdit => $FORM_OUT, $FORM_IN; - - -TUWF::get qr{/$PREV_RE/edit} => sub { - my $p = entry p => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit p => $p; - - enrich pid => q{SELECT id AS pid, name FROM producers WHERE id IN} => $p->{relations}; - - $p->{l_wp} //= ''; # TODO: The DB currently uses NULL when no wp link is provided, this should be an empty string instead to be consistent with most other fields. - $p->{ptype} = delete $p->{type}; - $p->{authmod} = auth->permDbmod; - $p->{editsum} = $p->{chrev} == $p->{maxrev} ? '' : "Reverted to revision p$p->{id}.$p->{chrev}"; - - Framework index => 0, title => "Edit $p->{name}", - top => sub { - Div class => 'col-md', sub { - EntryEdit p => $p; - Div class => 'detail-page-title', sub { - Txt $p->{name}; - Debug $p; - }; - }; - }, sub { - FullPageForm module => 'ProdEdit.Main', data => $p, schema => $FORM_OUT, sections => [ - general => 'General info', - relations => 'Relations', - ]; - }; -}; - - -TUWF::get '/p/add', sub { - return tuwf->resDenied if !auth->permEdit; - Framework index => 0, title => 'Add a new producer', narrow => 1, sub { - Div class => 'row', sub { - Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'ProdEdit.New', '' }; - }; - }; -}; - - -json_api qr{/(?:$PID_RE/edit|p/add)}, $FORM_IN, sub { - my $data = shift; - my $new = !tuwf->capture('id'); - my $p = $new ? { id => 0 } : entry p => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit p => $p; - - $data->{l_wp} ||= undef; - if(!auth->permDbmod) { - $data->{hidden} = $p->{hidden}||0; - $data->{locked} = $p->{locked}||0; - } - $data->{relations} = [] if $data->{hidden}; - - die "Relation with self" if grep $_->{pid} == $p->{id}, @{$data->{relations}}; - validate_dbid 'SELECT id FROM producers WHERE id IN', map $_->{pid}, @{$data->{relations}}; - - $data->{desc} = bb_subst_links $data->{desc}; - - $p->{ptype} = delete $p->{type}; - return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $p; - $data->{type} = delete $data->{ptype}; - - my($id,undef,$rev) = update_entry p => $p->{id}, $data; - - update_reverse($id, $rev, $p, $data); - - $elm_Changed->($id, $rev); -}; - - -sub update_reverse { - my($id, $rev, $old, $new) = @_; - - my %old = map +($_->{pid}, $_), $old->{relations} ? @{$old->{relations}} : (); - my %new = map +($_->{pid}, $_), @{$new->{relations}}; - - # Updates to be performed, pid => { pid => x, relation => y } or undef if the relation should be removed. - my %upd; - - for my $i (keys %old, keys %new) { - if($old{$i} && !$new{$i}) { - $upd{$i} = undef; - } elsif(!$old{$i} || $old{$i}{relation} ne $new{$i}{relation}) { - $upd{$i} = { - pid => $id, - relation => producer_relation_reverse($new{$i}{relation}), - }; - } - } - - for my $i (keys %upd) { - my $p = entry p => $i; - $p->{relations} = [ - $upd{$i} ? $upd{$i} : (), - grep $_->{pid} != $id, @{$p->{relations}} - ]; - $p->{editsum} = "Reverse relation update caused by revision p$id.$rev"; - update_entry p => $i, $p, 1; - } -} - -1; diff --git a/lib/VN3/Producer/JS.pm b/lib/VN3/Producer/JS.pm deleted file mode 100644 index 50161ce5..00000000 --- a/lib/VN3/Producer/JS.pm +++ /dev/null @@ -1,47 +0,0 @@ -package VN3::Producer::JS; - -use VN3::Prelude; - - -my $elm_ProducerResult = elm_api ProducerResult => { aoh => { - id => { id => 1 }, - name => {}, - original => {}, - hidden => { anybool => 1 }, -}}; - - -json_api '/js/producer.json', { - search => { type => 'array', scalar => 1, minlength => 1, values => { maxlength => 500 } }, - hidden => { anybool => 1 } -}, sub { - my $data = shift; - - my $r = tuwf->dbAlli( - 'SELECT p.id, p.name, p.original, p.hidden', - 'FROM (', (sql_join 'UNION ALL', map { - my $q = $_; - my $qs = s/[%_]//gr; - +( - # ID search - /^$PID_RE$/ ? (sql 'SELECT 1, id FROM producers WHERE id =', \"$1") : (), - # exact match - sql('SELECT 2, id FROM producers WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')'), - # prefix match - sql('SELECT 3, id FROM producers WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%"), - # substring match - sql('SELECT 4, id FROM producers WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%", ' OR alias ILIKE', \"%$qs%") - ) - } @{$data->{search}}), - ') AS pt (ord, id)', - 'JOIN producers p ON p.id = pt.id', - $data->{hidden} ? () : ('WHERE NOT p.hidden'), - 'GROUP BY p.id', - 'ORDER BY MIN(pt.ord), p.name', - 'LIMIT 20' - ); - - $elm_ProducerResult->($r); -}; - -1; diff --git a/lib/VN3/Producer/Page.pm b/lib/VN3/Producer/Page.pm deleted file mode 100644 index 89cd9dd8..00000000 --- a/lib/VN3/Producer/Page.pm +++ /dev/null @@ -1,117 +0,0 @@ -package VN3::Producer::Page; - -use VN3::Prelude; - -# TODO: Releases/VNs -# TODO: Relation graph - -sub Notes { - my $e = shift; - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Notes'; - }; - Div class => 'col-md', sub { - Div class => 'description serif mb-5', sub { - P sub { Lit bb2html $e->{desc} }; - }; - }; - } if $e->{desc}; -} - - -sub DetailsTable { - my $e = shift; - - my @links = ( - $e->{website} ? [ 'Official website', $e->{website} ] : (), - $e->{l_wp} ? [ 'Wikipedia', "https://en.wikipedia.org/wiki/$e->{l_wp}" ] : (), - ); - - my %rel; - push @{$rel{$_->{relation}}}, $_ for (sort { $a->{name} cmp $b->{name} } @{$e->{relations}}); - - my @list = ( - $e->{alias} ? sub { - Dt $e->{alias} =~ /\n/ ? 'Aliases' : 'Alias'; - Dd $e->{alias} =~ s/\n/, /gr; - } : (), - - sub { - Dt 'Type'; - Dd $PRODUCER_TYPE{$e->{type}}; - }, - - sub { - Dt 'Language'; - Dd sub { - Lang $e->{lang}; - Txt " $LANGUAGE{$e->{lang}}"; - } - }, - - @links ? sub { - Dt 'Links'; - Dd sub { - Join ', ', sub { A href => $_[0][1], rel => 'nofollow', $_[0][0] }, @links; - }; - } : (), - - (map { - my $r = $_; - sub { - Dt producer_relation_display $r; - Dd sub { - Join ', ', sub { - A href => "/p$_[0]{pid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name}; - }, @{$rel{$r}} - } - } - } grep $rel{$_}, keys %PRODUCER_RELATION) - ); - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Details'; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Div class => 'card__section fs-medium', sub { - Div class => 'row', sub { - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] }; - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] }; - } - } - } - } - } if @list; -} - - -TUWF::get qr{/$PREV_RE}, sub { - my $e = entry p => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resNotFound if !$e->{id} || $e->{hidden}; - - enrich pid => q{SELECT id AS pid, name, original FROM producers WHERE id IN}, $e->{relations}; - - Framework - title => $e->{name}, - top => sub { - Div class => 'col-md', sub { - EntryEdit p => $e; - Div class => 'detail-page-title', sub { - Txt $e->{name}; - Debug $e; - }; - Div class => 'detail-page-subtitle', $e->{original} if $e->{original}; - # TODO: link to discussions page. Prolly needs a TopNav - } - }, - sub { - DetailsTable $e; - Notes $e; - }; -}; - -1; diff --git a/lib/VN3/Release/Edit.pm b/lib/VN3/Release/Edit.pm deleted file mode 100644 index 030c0711..00000000 --- a/lib/VN3/Release/Edit.pm +++ /dev/null @@ -1,130 +0,0 @@ -package VN3::Release::Edit; - -use VN3::Prelude; - -my $FORM = { - hidden => { anybool => 1 }, - locked => { anybool => 1 }, - title => { maxlength => 250 }, - original => { required => 0, default => '', maxlength => 250 }, - rtype => { enum => [ release_types ] }, # This is 'type' in the database, but renamed for Elm compat - patch => { anybool => 1 }, - freeware => { anybool => 1 }, - doujin => { anybool => 1 }, - lang => { minlength => 1, sort_keys => 'lang', aoh => { lang => { language => 1 } } }, - gtin => { gtin => 1 }, - catalog => { required => 0, default => '', maxlength => 50 }, - website => { required => 0, default => '', weburl => 1 }, - released => { rdate => 1, min => 1 }, - minage => { required => 0, minage => 1 }, - uncensored => { anybool => 1 }, - notes => { required => 0, default => '', maxlength => 10240 }, - resolution => { resolution => 1 }, - voiced => { voiced => 1 }, - ani_story => { animated => 1 }, - ani_ero => { animated => 1 }, - platforms => { sort_keys => 'platform', aoh => { platform => { platform => 1 } } }, - media => { sort_keys => ['media', 'qty'], aoh => { - medium => { medium => 1 }, - qty => { uint => 1, range => [0,20] }, - } }, - vn => { length => [1,50], sort_keys => 'vid', aoh => { - vid => { id => 1 }, # X - title => { _when => 'out' }, - } }, - producers => { maxlength => 50, sort_keys => 'pid', aoh => { - pid => { id => 1 }, # X - developer => { anybool => 1 }, - publisher => { anybool => 1 }, - name => { _when => 'out' }, - } }, - - id => { _when => 'out', required => 0, id => 1 }, - authmod => { _when => 'out', anybool => 1 }, - editsum => { _when => 'in out', editsum => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form RelEdit => $FORM_OUT, $FORM_IN; - -TUWF::get qr{/$RREV_RE/(?<type>edit|copy)}, sub { - my $r = entry r => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit r => $r; - my $copy = tuwf->capture('type') eq 'copy'; - - enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $r->{vn}; - enrich pid => q{SELECT id AS pid, name FROM producers WHERE id IN} => $r->{producers}; - - $r->{rtype} = delete $r->{type}; - $r->{authmod} = auth->permDbmod; - $r->{editsum} = $copy ? "Copied from r$r->{id}.$r->{chrev}" : $r->{chrev} == $r->{maxrev} ? '' : "Reverted to revision r$r->{id}.$r->{chrev}"; - - my $title = sprintf '%s %s', $copy ? 'Copy' : 'Edit', $r->{title}; - Framework title => $title, - top => sub { - Div class => 'col-md', sub { - EntryEdit r => $r; - Div class => 'detail-page-title', sub { - Txt $title; - Debug $r; - }; - }; - }, sub { - FullPageForm module => 'RelEdit.Main', schema => $FORM_OUT, data => { %$r, $copy ? (id => undef) : () }, sections => [ - general => 'General info', - format => 'Format', - relations => 'Relations' - ]; - }; -}; - - -TUWF::get qr{/$VID_RE/add}, sub { - return tuwf->resDenied if !auth->permEdit; - - my $vn = tuwf->dbRowi('SELECT id, title, original FROM vn WHERE NOT hidden AND id =', \tuwf->capture('id')); - return tuwf->resNotFound if !$vn->{id}; - - Framework index => 0, title => "Add a new release to $vn->{title}", narrow => 1, sub { - FullPageForm module => 'RelEdit.New', data => $vn, sections => [ - general => 'General info', - format => 'Format', - relations => 'Relations' - ]; - }; -}; - - -json_api qr{/(?:$RID_RE/edit|r/add)}, $FORM_IN, sub { - my $data = shift; - my $new = !tuwf->capture('id'); - my $rel = $new ? { id => 0 } : entry r => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit r => $rel; - - if(!auth->permDbmod) { - $data->{hidden} = $rel->{hidden}||0; - $data->{locked} = $rel->{locked}||0; - } - $data->{doujin} = $data->{voiced} = $data->{ani_story} = $data->{ani_ero} = 0 if $data->{patch}; - $data->{resolution} = 'unknown' if $data->{patch}; - $data->{uncensored} = 0 if !$data->{minage} || $data->{minage} != 18; - $_->{qty} = $MEDIUM{$_->{medium}}{qty} ? $_->{qty}||1 : 0 for @{$data->{media}}; - - validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{vn}}; - validate_dbid 'SELECT id FROM producers WHERE id IN', map $_->{pid}, @{$data->{producers}}; - - $data->{notes} = bb_subst_links $data->{notes}; - - $rel->{rtype} = delete $rel->{type}; - return $elm_Unchanged() if !$new && !form_changed $FORM_CMP, $data, $rel; - $data->{type} = delete $data->{rtype}; - - my($id,undef,$rev) = update_entry r => $rel->{id}, $data; - $elm_Changed->($id, $rev); -}; - -1; diff --git a/lib/VN3/Release/JS.pm b/lib/VN3/Release/JS.pm deleted file mode 100644 index 152fd69a..00000000 --- a/lib/VN3/Release/JS.pm +++ /dev/null @@ -1,32 +0,0 @@ -package VN3::Release::JS; - -use VN3::Prelude; - - -my $elm_ReleaseResult = elm_api ReleaseResult => { aoh => { - id => { id => 1 }, - title => {}, - lang => { type => 'array', values => {} }, -}}; - - -# Fetch all releases assigned to a VN -json_api '/js/release.json', { - vid => { id => 1 }, -}, sub { - my $vid = shift->{vid}; - - my $r = tuwf->dbAlli(q{ - SELECT r.id, r.title - FROM releases r - JOIN releases_vn rv ON rv.id = r.id - WHERE NOT r.hidden - AND rv.vid =}, \$vid, q{ - ORDER BY r.id - }); - enrich_list1 lang => id => id => sub { sql 'SELECT id, lang FROM releases_lang WHERE id IN', $_[0], 'ORDER BY id, lang' }, $r; - - $elm_ReleaseResult->($r); -}; - -1; diff --git a/lib/VN3/Release/Page.pm b/lib/VN3/Release/Page.pm deleted file mode 100644 index 03d3bd5c..00000000 --- a/lib/VN3/Release/Page.pm +++ /dev/null @@ -1,184 +0,0 @@ -package VN3::Release::Page; - -use VN3::Prelude; - -# TODO: Userlist options - - -sub Notes { - my $e = shift; - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Notes'; - }; - Div class => 'col-md', sub { - Div class => 'description serif mb-5', sub { - P sub { Lit bb2html $e->{notes} }; - }; - }; - } if $e->{notes}; -} - - -sub DetailsTable { - my $e = shift; - - # TODO: Some of these properties could be moved into the title header thing - # (type and languages, in particular) - # (Not even sure this table format makes sense for all properties, there's gotta be a nicer way) - my @list = ( - @{$e->{vn}} ? sub { - Dt @{$e->{vn}} == 1 ? 'Visual Novel' : 'Visual Novels'; - Dd sub { - Join \&Br, sub { - A href => "/v$_[0]{vid}", title => $_[0]{original}||$_[0]{title}, $_[0]{title}; - }, @{$e->{vn}}; - } - } : (), - - sub { - Dt 'Type'; - Dd sub { - Txt ucfirst $e->{type}; - Txt ", patch" if $e->{patch}; - } - }, - - sub { - Dt 'Released'; - Dd sub { ReleaseDate $e->{released} }; - }, - - sub { - Dt @{$e->{lang}} > 1 ? 'Languages' : 'Language'; - Dd sub { - Join \&Br, sub { - Lang $_[0]{lang}; - Txt " $LANGUAGE{$_[0]{lang}}"; - }, @{$e->{lang}}; - } - }, - - sub { - Dt 'Publication'; - Dd join ', ', - $e->{freeware} ? 'Freeware' : 'Non-free', - $e->{patch} ? () : ($e->{doujin} ? 'doujin' : 'commercial') - }, - - $e->{minage} && $e->{minage} >= 0 ? sub { - Dt 'Age rating'; - Dd minage_display $e->{minage}; - } : (), - - @{$e->{platforms}} ? sub { - Dt @{$e->{platforms}} == 1 ? 'Platform' : 'Platforms'; - Dd sub { - Join \&Br, sub { - Platform $_[0]{platform}; - Txt " $PLATFORM{$_[0]{platform}}"; - }, @{$e->{platforms}}; - } - } : (), - - @{$e->{media}} ? sub { - Dt @{$e->{media}} == 1 ? 'Medium' : 'Media'; - Dd join ', ', map media_display($_->{medium}, $_->{qty}), @{$e->{media}}; - } : (), - - $e->{voiced} ? sub { - Dt 'Voiced'; - Dd $VOICED{$e->{voiced}}{txt}; - } : (), - - $e->{ani_story} ? sub { - Dt 'Story animation'; - Dd $ANIMATED{$e->{ani_story}}{txt}; - } : (), - - $e->{ani_ero} ? sub { - Dt 'Ero animation'; - Dd $ANIMATED{$e->{ani_ero}}{txt}; - } : (), - - $e->{minage} && $e->{minage} == 18 ? sub { - Dt 'Censoring'; - Dd $e->{uncensored} ? 'No optical censoring (e.g. mosaics)' : 'May include optical censoring (e.g. mosaics)'; - } : (), - - $e->{gtin} ? sub { - Dt gtintype($e->{gtin}) || 'GTIN'; - Dd $e->{gtin}; - } : (), - - $e->{catalog} ? sub { - Dt 'Catalog no.'; - Dd $e->{catalog}; - } : (), - - (map { - my $type = $_; - my @prod = grep $_->{$type}, @{$e->{producers}}; - @prod ? sub { - Dt ucfirst($type) . (@prod == 1 ? '' : 's'); - Dd sub { - Join \&Br, sub { - A href => "/p$_[0]{pid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name}; - }, @prod; - } - } : () - } 'developer', 'publisher'), - - $e->{website} ? sub { - Dt 'Links'; - Dd sub { - A href => $e->{website}, rel => 'nofollow', 'Official website'; - }; - } : (), - ); - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Details'; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Div class => 'card__section fs-medium', sub { - Div class => 'row', sub { - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] }; - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] }; - } - } - } - } - } if @list; -} - - -TUWF::get qr{/$RREV_RE}, sub { - my $e = entry r => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resNotFound if !$e->{id} || $e->{hidden}; - - enrich vid => q{SELECT id AS vid, title, original FROM vn WHERE id IN}, $e->{vn}; - enrich pid => q{SELECT id AS pid, name, original FROM producers WHERE id IN}, $e->{producers}; - - Framework - title => $e->{title}, - top => sub { - Div class => 'col-md', sub { - EntryEdit r => $e; - Div class => 'detail-page-title', sub { - Txt $e->{title}; - Debug $e; - }; - Div class => 'detail-page-subtitle', $e->{original} if $e->{original}; - } - }, - sub { - DetailsTable $e; - Notes $e; - }; -}; - -1; diff --git a/lib/VN3/Staff/Edit.pm b/lib/VN3/Staff/Edit.pm deleted file mode 100644 index 0b9c3af4..00000000 --- a/lib/VN3/Staff/Edit.pm +++ /dev/null @@ -1,108 +0,0 @@ -package VN3::Staff::Edit; - -use VN3::Prelude; - - -my $FORM = { - aid => { int => 1, range => [ -1000, 1<<40 ] }, # X - alias => { maxlength => 100, sort_keys => 'aid', aoh => { - aid => { int => 1, range => [ -1000, 1<<40 ] }, # X, negative IDs are for new aliases - name => { maxlength => 200 }, - original => { maxlength => 200, required => 0, default => '' }, - inuse => { anybool => 1, _when => 'out' }, - } }, - desc => { required => 0, default => '', maxlength => 5000 }, - gender => { gender => 1 }, - hidden => { anybool => 1 }, - l_site => { required => 0, default => '', weburl => 1 }, - l_wp => { required => 0, default => '', maxlength => 150 }, - l_twitter => { required => 0, default => '', maxlength => 150 }, - l_anidb => { required => 0, id => 1 }, - lang => { language => 1 }, - locked => { anybool => 1 }, - - id => { _when => 'out', required => 0, id => 1 }, - authmod => { _when => 'out', anybool => 1 }, - editsum => { _when => 'in out', editsum => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form StaffEdit => $FORM_OUT, $FORM_IN; - - -TUWF::get qr{/$SREV_RE/edit} => sub { - my $e = entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit s => $e; - - $e->{authmod} = auth->permDbmod; - $e->{editsum} = $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision s$e->{id}.$e->{chrev}"; - - enrich aid => sub { sql ' - SELECT aid, EXISTS(SELECT 1 FROM vn_staff WHERE aid = x.aid UNION ALL SELECT 1 FROM vn_seiyuu WHERE aid = x.aid) AS inuse - FROM unnest(', sql_array(@{$_[0]}), '::int[]) AS x(aid)' - }, $e->{alias}; - - my $name = (grep $_->{aid} == $e->{aid}, @{$e->{alias}})[0]{name}; - Framework index => 0, narrow => 1, title => "Edit $name", - top => sub { - Div class => 'col-md', sub { - EntryEdit s => $e; - Div class => 'detail-page-title', sub { - Txt $name, - Debug $e; - }; - }; - }, sub { - FullPageForm module => 'StaffEdit.Main', data => $e, schema => $FORM_OUT; - }; -}; - - -TUWF::get '/s/new', sub { - return tuwf->resDenied if !auth->permEdit; - Framework index => 0, title => 'Add a new staff entry', narrow => 1, sub { - Div class => 'row', sub { - Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'StaffEdit.New', '' }; - }; - }; -}; - - -json_api qr{/(?:$SID_RE/edit|s/add)}, $FORM_IN, sub { - my $data = shift; - my $new = !tuwf->capture('id'); - my $e = $new ? { id => 0 } : entry s => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit s => $e; - - if(!auth->permDbmod) { - $data->{hidden} = $e->{hidden}||0; - $data->{locked} = $e->{locked}||0; - } - - # For positive alias IDs: Make sure they exist and are owned by this entry. - validate_dbid - sub { sql 'SELECT aid FROM staff_alias WHERE id =', \$e->{id}, ' AND aid IN', $_[0] }, - grep $_>=0, map $_->{aid}, @{$data->{alias}}; - - # For negative alias IDs: Assign a new ID. - for my $alias (@{$data->{alias}}) { - if($alias->{aid} < 0) { - my $new = tuwf->dbVali(select => sql_func nextval => \'staff_alias_aid_seq'); - $data->{aid} = $new if $alias->{aid} == $data->{aid}; - $alias->{aid} = $new; - } - } - # We rely on Postgres to throw an error if we attempt to delete an alias that is still being referenced. - - $data->{desc} = bb_subst_links $data->{desc}; - - return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $e; - my($id,undef,$rev) = update_entry s => $e->{id}, $data; - $elm_Changed->($id, $rev); -}; - -1; diff --git a/lib/VN3/Staff/JS.pm b/lib/VN3/Staff/JS.pm deleted file mode 100644 index 58ce947b..00000000 --- a/lib/VN3/Staff/JS.pm +++ /dev/null @@ -1,43 +0,0 @@ -package Staff::JS; - -use VN3::Prelude; - -my $elm_StaffResult = elm_api StaffResult => { aoh => { - id => { id => 1 }, - aid => { id => 1 }, - name => {}, - original => {}, -}}; - -json_api '/js/staff.json', { - search => { maxlength => 500 } -}, sub { - my $q = shift->{search}; - - # XXX: This query is kinda slow - my $qs = $q =~ s/[%_]//gr; - my $r = tuwf->dbAlli( - 'SELECT s.id, st.aid, st.name, st.original', - 'FROM (', - # ID search - $q =~ /^$SID_RE$/ ? ('SELECT 1, id, aid, name, original FROM staff_alias WHERE id =', \"$1", 'UNION ALL') : (), - # exact match - 'SELECT 2, id, aid, name, original FROM staff_alias WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')', - 'UNION ALL', - # prefix match - 'SELECT 3, id, aid, name, original FROM staff_alias WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%", - 'UNION ALL', - # substring match - 'SELECT 4, id, aid, name, original FROM staff_alias WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%", - ') AS st (ord, id, aid, name, original)', - 'JOIN staff s ON s.id = st.id', - 'WHERE NOT s.hidden', - 'GROUP BY s.id, st.aid, st.name, st.original', - 'ORDER BY MIN(st.ord), st.name', - 'LIMIT 20' - ); - - $elm_StaffResult->($r); -}; - -1; diff --git a/lib/VN3/Staff/Page.pm b/lib/VN3/Staff/Page.pm deleted file mode 100644 index 2d8cd349..00000000 --- a/lib/VN3/Staff/Page.pm +++ /dev/null @@ -1,213 +0,0 @@ -package VN3::Staff::Page; - -use VN3::Prelude; - -sub Notes { - my $e = shift; - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Notes'; - }; - Div class => 'col-md', sub { - Div class => 'description serif mb-5', sub { - P sub { Lit bb2html $e->{desc} }; - }; - }; - } if $e->{desc}; -} - - -sub DetailsTable { - my $e = shift; - - my @links = ( - $e->{l_site} ? [ 'Official website', $e->{l_site} ] : (), - $e->{l_wp} ? [ 'Wikipedia', "https://en.wikipedia.org/wiki/$e->{l_wp}" ] : (), - $e->{l_twitter} ? [ 'Twitter', "https://twitter.com/$e->{l_twitter}" ] : (), - $e->{l_anidb} ? [ 'AniDB', "http://anidb.net/cr$e->{l_anidb}" ] : (), - ); - my @alias = grep $_->{aid} != $e->{aid}, @{$e->{alias}}; - - my @list = ( - @alias ? sub { - Dt @alias > 1 ? 'Aliases' : 'Alias'; - Dd sub { - Join \&Br, sub { - Txt $_[0]{name}; - Txt " ($_[0]{original})" if $_[0]{original}; - }, sort { $a->{name} cmp $b->{name} || $a->{original} cmp $b->{original} } @alias; - } - } : (), - - sub { - Dt 'Language'; - Dd sub { - Lang $e->{lang}; - Txt " $LANGUAGE{$e->{lang}}"; - } - }, - - @links ? sub { - Dt 'Links'; - Dd sub { - Join ', ', sub { A href => $_[0][1], rel => 'nofollow', $_[0][0] }, @links; - }; - } : (), - ); - - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Details'; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Div class => 'card__section fs-medium', sub { - Div class => 'row', sub { - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] }; - Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] }; - } - } - } - } - } if @list; -} - - -sub Roles { - my $e = shift; - - my $roles = tuwf->dbAlli(q{ - SELECT sa.id, sa.aid, v.id AS vid, sa.name, sa.original, v.c_released, v.title, v.original AS t_original, vs.role, vs.note - FROM vn_staff vs - JOIN vn v ON v.id = vs.id - JOIN staff_alias sa ON vs.aid = sa.aid - WHERE sa.id =}, \$e->{id}, q{ AND NOT v.hidden - ORDER BY v.c_released ASC, v.title ASC, vs.role ASC - }); - return if !@$roles; - - my $rows = sub { - for my $r (@$roles) { - Tr sub { - Td class => 'tabular-nums muted', sub { ReleaseDate $r->{c_released} }; - Td sub { - A href => "/v$r->{vid}", title => $r->{t_original}||$r->{title}, $r->{title}; - }; - Td $CREDIT_TYPE{$r->{role}}; - Td title => $r->{original}||$r->{name}, $r->{name}; - Td $r->{note}; - }; - } - }; - - # TODO: Full-width table? It's pretty dense - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Credits'; - Debug $roles; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Table class => 'table table--responsive-single-sm fs-medium', sub { - Thead sub { - Tr sub { - Th width => '15%', 'Date'; - Th width => '30%', 'Title'; - Th width => '20%', 'Role'; - Th width => '20%', 'As'; - Th width => '15%', 'Note'; - }; - }; - Tbody $rows; - }; - } - } - } -} - - -sub Cast { - my $e = shift; - - my $cast = tuwf->dbAlli(q{ - SELECT sa.id, sa.aid, v.id AS vid, sa.name, sa.original, v.c_released, v.title, v.original AS t_original, c.id AS cid, c.name AS c_name, c.original AS c_original, vs.note - FROM vn_seiyuu vs - JOIN vn v ON v.id = vs.id - JOIN chars c ON c.id = vs.cid - JOIN staff_alias sa ON vs.aid = sa.aid - WHERE sa.id =}, \$e->{id}, q{ AND NOT v.hidden - ORDER BY v.c_released ASC, v.title ASC - }); - return if !@$cast; - - my $rows = sub { - for my $c (@$cast) { - Tr sub { - Td class => 'tabular-nums muted', sub { ReleaseDate $c->{c_released} }; - Td sub { - A href => "/v$c->{vid}", title => $c->{t_original}||$c->{title}, $c->{title}; - }; - Td sub { - A href => "/c$c->{cid}", title => $c->{c_original}||$c->{c_name}, $c->{c_name}; - }; - Td title => $c->{original}||$c->{name}, $c->{name}; - Td $c->{note}; - }; - } - }; - - # TODO: Full-width table? It's pretty dense - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - H2 class => 'detail-page-sidebar-section-header', 'Voiced Characters'; - Debug $cast; - }; - Div class => 'col-md', sub { - Div class => 'card card--white mb-5', sub { - Table class => 'table table--responsive-single-sm fs-medium', sub { - Thead sub { - Tr sub { - Th width => '15%', 'Date'; - Th width => '30%', 'Title'; - Th width => '20%', 'Cast'; - Th width => '20%', 'As'; - Th width => '15%', 'Note'; - }; - }; - Tbody $rows; - }; - } - } - } -} - - -TUWF::get qr{/$SREV_RE}, sub { - my $e = entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resNotFound if !$e->{id} || $e->{hidden}; - - ($e->{name}, $e->{original}) = @{(grep $_->{aid} == $e->{aid}, @{$e->{alias}})[0]}{'name', 'original'}; - - Framework - title => $e->{name}, - top => sub { - Div class => 'col-md', sub { - EntryEdit s => $e; - Div class => 'detail-page-title', sub { - Txt $e->{name}; - Txt ' '.gender_icon $e->{gender}; - Debug $e; - }; - Div class => 'detail-page-subtitle', $e->{original} if $e->{original}; - } - }, - sub { - DetailsTable $e; - Notes $e; - Roles $e; - Cast $e; - }; -}; - -1; diff --git a/lib/VN3/Trait/JS.pm b/lib/VN3/Trait/JS.pm deleted file mode 100644 index 05e1d03d..00000000 --- a/lib/VN3/Trait/JS.pm +++ /dev/null @@ -1,44 +0,0 @@ -package VN3::Trait::JS; - -use VN3::Prelude; - -my $elm_TraitResult = elm_api TraitResult => { aoh => { - id => { id => 1 }, - name => {}, - gid => { id => 1, required => 0 }, - group => { required => 0 } -}}; - -# Returns only approved and applicable traits -json_api '/js/trait.json', { - search => { maxlength => 500 } -}, sub { - my $q = shift->{search}; - - my $qs = $q =~ s/[%_]//gr; - my $r = tuwf->dbAlli( - 'SELECT t.id, t.name, g.id AS gid, g.name AS group', - 'FROM (', - # ID search - $q =~ /^$IID_RE$/ ? ('SELECT 1, id FROM traits WHERE id =', \"$1", 'UNION ALL') : (), - # exact match - 'SELECT 2, id FROM traits WHERE lower(name) = lower(', \$q, ")", - 'UNION ALL', - # prefix match - 'SELECT 3, id FROM traits WHERE name ILIKE', \"$qs%", - 'UNION ALL', - # substring match + alias search - 'SELECT 4, id FROM traits WHERE name ILIKE', \"%$qs%", ' OR alias ILIKE', \"%$qs%", - ') AS tt (ord, id)', - 'JOIN traits t ON t.id = tt.id', - 'LEFT JOIN traits g ON g.id = t.group', - 'WHERE t.state = 2 AND t.applicable', - 'GROUP BY t.id, t.name, g.id, g.name', - 'ORDER BY MIN(tt.ord), t.name', - 'LIMIT 20' - ); - - $elm_TraitResult->($r); -}; - -1; diff --git a/lib/VN3/Types.pm b/lib/VN3/Types.pm deleted file mode 100644 index 273f8b79..00000000 --- a/lib/VN3/Types.pm +++ /dev/null @@ -1,171 +0,0 @@ -# Listings and formatting functions for various data types in the database. - -package VN3::Types; - -use strict; -use warnings; -use utf8; -use TUWF ':Html5'; -use POSIX 'strftime', 'ceil'; -use Exporter 'import'; -use VNDB::Types; - -our @EXPORT = qw/ - $UID_RE $VID_RE $RID_RE $SID_RE $CID_RE $PID_RE $IID_RE $DOC_RE - $VREV_RE $RREV_RE $PREV_RE $SREV_RE $CREV_RE $DREV_RE - Lang - Platform - media_display - ReleaseDate - vn_length_time vn_length_display - char_roles char_role_display - vote_display vote_string - date_display - vn_relation_reverse vn_relation_display - producer_relation_reverse producer_relation_display - spoil_display - release_types - minage_display minage_display_full - resolution_display_full - gender_display gender_icon - blood_type_display -/; - - -# Regular expressions for use in path registration -my $num = qr{[1-9][0-9]{0,6}}; -our $UID_RE = qr{u(?<id>$num)}; -our $VID_RE = qr{v(?<id>$num)}; -our $RID_RE = qr{r(?<id>$num)}; -our $SID_RE = qr{s(?<id>$num)}; -our $CID_RE = qr{c(?<id>$num)}; -our $PID_RE = qr{p(?<id>$num)}; -our $IID_RE = qr{i(?<id>$num)}; -our $DOC_RE = qr{d(?<id>$num)}; -our $VREV_RE = qr{$VID_RE(?:\.(?<rev>$num))?}; -our $RREV_RE = qr{$RID_RE(?:\.(?<rev>$num))?}; -our $PREV_RE = qr{$PID_RE(?:\.(?<rev>$num))?}; -our $SREV_RE = qr{$SID_RE(?:\.(?<rev>$num))?}; -our $CREV_RE = qr{$CID_RE(?:\.(?<rev>$num))?}; -our $DREV_RE = qr{$DOC_RE(?:\.(?<rev>$num))?}; - - -sub Lang { - Span class => 'lang-badge', uc $_[0]; -} - - - -sub Platform { - # TODO: Icons - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/windows.svg', title => $PLATFORM{$_[0]}; -} - - -sub media_display { - my($media, $qty) = @_; - my $med = $MEDIUM{$media}; - return $med->{txt} if !$med->{qty}; - sprintf '%d %s', $qty, $qty == 1 ? $med->{txt} : $med->{plural}; -} - - - - -sub ReleaseDate { - my $date = sprintf '%08d', shift||0; - my $future = $date > strftime '%Y%m%d', gmtime; - my($y, $m, $d) = ($1, $2, $3) if $date =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/; - - my $str = $y == 0 ? 'unknown' : $y == 9999 ? 'TBA' : - $m == 99 ? sprintf('%04d', $y) : - $d == 99 ? sprintf('%04d-%02d', $y, $m) : - sprintf('%04d-%02d-%02d', $y, $m, $d); - - Txt $str if !$future; - B class => 'future', $str if $future; -} - - -sub vn_length_time { - my $l = $VN_LENGTH{$_[0]}; - $l->{time} || $l->{txt}; -} - -sub vn_length_display { - my $l = $VN_LENGTH{$_[0]}; - $l->{txt}.($l->{time} ? " ($l->{time})" : '') -} - - - -sub char_role_display { - my($role, $num) = @_; - $CHAR_ROLE{$role}{!$num || $num == 1 ? 'txt' : 'plural'}; -} - - - -sub vote_display { - !$_[0] ? '-' : $_[0] % 10 == 0 ? $_[0]/10 : sprintf '%.1f', $_[0]/10; -} - -sub vote_string { - ['worst ever', - 'awful', - 'bad', - 'weak', - 'so-so', - 'decent', - 'good', - 'very good', - 'excellent', - 'masterpiece']->[ceil(shift()/10)-2]; -} - - - -sub date_display { - strftime '%Y-%m-%d', gmtime $_[0]; -} - - - -sub vn_relation_reverse { $VN_RELATION{$_[0]}{reverse} } -sub vn_relation_display { $VN_RELATION{$_[0]}{txt} } - - - -sub producer_relation_reverse { $PRODUCER_RELATION{$_[0]}{reverse} } -sub producer_relation_display { $PRODUCER_RELATION{$_[0]}{txt} } - - - -sub spoil_display { - ['No spoilers' - ,'Minor spoilers' - ,'Spoil me!']->[$_[0]]; -} - - - -sub release_types { keys %RELEASE_TYPE } - - -sub minage_display { $AGE_RATING{$_[0]}{txt} } -sub minage_display_full { my $e = $AGE_RATING{$_[0]}; $e->{txt}.($e->{ex} ? " (e.g. $e->{ex})" : '') }; - - - -sub resolution_display_full { my $e = $RESOLUTION{$_[0]}; ($e->{cat} ? ucfirst "$e->{cat}: " : '').$e->{txt} } - - -sub gender_display { $GENDER{$_[0]} } -sub gender_icon { +{qw/m ♂ f ♀ mf ♂♀/}->{$_[0]}||'' } - - - -sub blood_type_display { $BLOOD_TYPE{$_[0]} } - - -1; diff --git a/lib/VN3/User/Lib.pm b/lib/VN3/User/Lib.pm deleted file mode 100644 index c63e4286..00000000 --- a/lib/VN3/User/Lib.pm +++ /dev/null @@ -1,31 +0,0 @@ -package VN3::User::Lib; - -use VN3::Prelude; - -our @EXPORT = qw/show_list TopNav/; - - -# Whether we can see the user's list -sub show_list { - my $u = shift; - die "Can't determine show_list() when hide_list preference is not known" if !exists $u->{hide_list}; - auth->permUsermod || !$u->{hide_list} || $u->{id} == (auth->uid||0); -} - - -sub TopNav { - my($page, $u) = @_; - - Div class => 'nav raised-top-nav', sub { - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'details'), sub { A href => "/u$u->{id}", class => 'nav__link', 'Details'; }; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'list'), sub { A href => "/u$u->{id}/list", class => 'nav__link', 'List'; } if show_list $u; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'wish'), sub { A href => "/u$u->{id}/wish", class => 'nav__link', 'Wishlist'; } if show_list $u; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'posts'), sub { A href => "/u$u->{id}/posts", class => 'nav__link', 'Posts'; }; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'discussions'),sub { A href => "/t/u$u->{id}", class => 'nav__link', 'Discussions'; }; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'tags'), sub { A href => "/g/links?uid=$u->{id}", class => 'nav__link', 'Tags'; }; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'hist'), sub { A href => "/u$u->{id}/hist", class => 'nav__link', 'Contributions'; }; - }; -} - -1; - diff --git a/lib/VN3/User/Login.pm b/lib/VN3/User/Login.pm deleted file mode 100644 index 7660762a..00000000 --- a/lib/VN3/User/Login.pm +++ /dev/null @@ -1,50 +0,0 @@ -package VN3::User::Login; - -use VN3::Prelude; - -# TODO: Redirect to a password change form when a user logs in with an insecure password. - -TUWF::get '/u/login' => sub { - return tuwf->resRedirect('/', 'temp') if auth; - Framework title => 'Login', center => 1, sub { - Div 'data-elm-module' => 'User.Login', ''; - }; -}; - - -my $elm_Throttled = elm_api 'Throttled'; -my $elm_BadLogin = elm_api 'BadLogin'; - -json_api '/u/login', { - username => { username => 1 }, - password => { password => 1 } -}, sub { - my $data = shift; - - my $conf = tuwf->conf->{login_throttle} || [ 24*3600/10, 24*3600 ]; - my $ip = norm_ip tuwf->reqIP; - - my $tm = tuwf->dbVali( - 'SELECT', sql_totime('greatest(timeout, now())'), 'FROM login_throttle WHERE ip =', \$ip - ) || time; - - return $elm_Throttled->() if $tm-time() > $conf->[1]; - return $elm_Success->() if auth->login($data->{username}, $data->{password}); - - # Failed login, update throttle. - my $upd = { - ip => \$ip, - timeout => sql_fromtime $tm+$conf->[0] - }; - tuwf->dbExeci('INSERT INTO login_throttle', $upd, 'ON CONFLICT (ip) DO UPDATE SET', $upd); - $elm_BadLogin->() -}; - - -TUWF::get qr{/$UID_RE/logout}, sub { - return tuwf->resNotFound if !auth || auth->uid != tuwf->capture('id'); - auth->logout; - tuwf->resRedirect('/', 'temp'); -}; - -1; diff --git a/lib/VN3/User/Page.pm b/lib/VN3/User/Page.pm deleted file mode 100644 index 886ad39a..00000000 --- a/lib/VN3/User/Page.pm +++ /dev/null @@ -1,207 +0,0 @@ -package VN3::User::Page; - -use VN3::Prelude; -use VN3::User::Lib; - - -sub StatsLeft { - my $u = shift; - my $vns = show_list($u) && tuwf->dbVali('SELECT COUNT(*) FROM vnlists WHERE uid =', \$u->{id}); - my $rel = show_list($u) && tuwf->dbVali('SELECT COUNT(*) FROM rlists WHERE uid =', \$u->{id}); - my $posts = tuwf->dbVali('SELECT COUNT(*) FROM threads_posts WHERE uid =', \$u->{id}); - my $threads = tuwf->dbVali('SELECT COUNT(*) FROM threads_posts WHERE num = 1 AND uid =', \$u->{id}); - - Div class => 'card__title mb-4', 'Stats'; - Div class => 'big-stats mb-5', sub { - A href => "/u$u->{id}/list", class => 'big-stats__stat', sub { - Txt 'Votes'; - Div class => 'big-stats__value', show_list($u) ? $u->{c_votes} : '-'; - }; - A href => "/u$u->{id}/hist", class => 'big-stats__stat', sub { - Txt 'Edits'; - Div class => 'big-stats__value', $u->{c_changes}; - }; - A href => "/g/links?u=$u->{id}", class => 'big-stats__stat', sub { - Txt 'Tags'; - Div class => 'big-stats__value', $u->{c_tags}; - }; - }; - Div class => 'user-stats__text', sub { - Dl class => 'dl--horizontal', sub { - if(show_list $u) { - Dt 'List stats'; - Dd sprintf '%d release%s of %d visual novel%s', $rel, $rel == 1 ? '' : 's', $vns, $vns == 1 ? '' : 's'; - } - Dt 'Forum stats'; - Dd sprintf '%d post%s, %d new thread%s', $posts, $posts == 1 ? '' : 's', $threads, $threads == 1 ? '' : 's'; - Dt 'Registered'; - Dd date_display $u->{registered}; - }; - }; -} - - -sub Stats { - my $u = shift; - - my($count, $Graph) = show_list($u) ? VoteGraph u => $u->{id} : (); - - Div class => 'card card--white card--no-separators flex-expand mb-5', sub { - Div class => 'card__section fs-medium', sub { - Div class => 'user-stats', sub { - Div class => 'user-stats__left', sub { StatsLeft $u }; - Div class => 'user-stats__right', sub { - Div class => 'card__title mb-2', 'Vote distribution'; - $Graph->(); - } if $count; - } - } - } -} - - -sub List { - my $u = shift; - return if !show_list $u; - - # XXX: This query doesn't catch vote or list *changes*, only new entries. - # We don't store the modification date in the DB at the moment. - my $l = tuwf->dbAlli(q{ - SELECT il.vid, EXTRACT('epoch' FROM GREATEST(v.date, l.added)) AS date, vn.title, vn.original, v.vote, l.status - FROM ( - SELECT vid FROM votes WHERE uid = }, \$u->{id}, q{ - UNION SELECT vid FROM vnlists WHERE uid = }, \$u->{id}, q{ - ) AS il (vid) - LEFT JOIN votes v ON v.vid = il.vid - LEFT JOIN vnlists l ON l.vid = il.vid - JOIN vn ON vn.id = il.vid - WHERE v.uid = }, \$u->{id}, q{ - AND l.uid = }, \$u->{id}, q{ - ORDER BY GREATEST(v.date, l.added) DESC - LIMIT 10 - }); - return if !@$l; - - Div class => 'card card--white card--no-separators mb-5', sub { - Div class => 'card__header', sub { - Div class => 'card__title', 'Recent list additions'; - }; - Table class => 'table table--responsive-single-sm fs-medium', sub { - Thead sub { - Tr sub { - Th width => '15%', 'Date'; - Th width => '50%', 'Visual novel'; - Th width => '10%', 'Vote'; - Th width => '25%', 'Status'; - }; - }; - Tbody sub { - for my $i (@$l) { - Tr sub { - Td class => 'tabular-nums muted', date_display $i->{date}; - Td sub { - A href => "/v$i->{vid}", title => $i->{original}||$i->{title}, $i->{title}; - }; - Td vote_display $i->{vote}; - Td $i->{status} ? $VNLIST_STATUS{$i->{status}} : ''; - }; - } - }; - }; - Div class => 'card__section fs-medium', sub { - A href => "/u$u->{id}/list", 'View full list'; - } - }; -} - - -sub Edits { - my $u = shift; - # XXX: This is a lazy implementation, could probably share code/UI with the database entry history tables (as in VNDB 2) - - my $l = tuwf->dbAlli(q{ - SELECT ch.id, ch.itemid, ch.rev, ch.type, EXTRACT('epoch' FROM ch.added) AS added - FROM changes ch - WHERE ch.requester =}, \$u->{id}, q{ - ORDER BY ch.added DESC LIMIT 10 - }); - return if !@$l; - - # This can also be written as a UNION, haven't done any benchmarking yet. - # It doesn't matter much with only 10 entries, but it will matter if this - # query is re-used for other history browsing purposes. - enrich id => q{ - SELECT ch.id, COALESCE(d.title, v.title, p.name, r.title, c.name, sa.name) AS title - FROM changes ch - LEFT JOIN docs_hist d ON ch.type = 'd' AND d.chid = ch.id - LEFT JOIN vn_hist v ON ch.type = 'v' AND v.chid = ch.id - LEFT JOIN producers_hist p ON ch.type = 'p' AND p.chid = ch.id - LEFT JOIN releases_hist r ON ch.type = 'r' AND r.chid = ch.id - LEFT JOIN chars_hist c ON ch.type = 'c' AND c.chid = ch.id - LEFT JOIN staff_hist s ON ch.type = 's' AND s.chid = ch.id - LEFT JOIN staff_alias_hist sa ON ch.type = 's' AND sa.chid = ch.id AND s.aid = sa.aid - WHERE ch.id IN}, $l; - - Div class => 'card card--white card--no-separators mb-5', sub { - Div class => 'card__header', sub { - Div class => 'card__title', 'Recent database contributions'; - }; - Table class => 'table table--responsive-single-sm fs-medium', sub { - Thead sub { - Tr sub { - Th width => '15%', 'Date'; - Th width => '10%', 'Rev.'; - Th width => '75%', 'Entry'; - }; - }; - Tbody sub { - for my $i (@$l) { - my $id = "$i->{type}$i->{itemid}.$i->{rev}"; - Tr sub { - Td class => 'tabular-nums muted', date_display $i->{added}; - Td sub { - A href => "/$id", $id; - }; - Td sub { - A href => "/$id", $i->{title}; - }; - } - } - } - }; - Div class => 'card__section fs-medium', sub { - A href => "/u$u->{id}/hist", 'View all'; - } - }; -} - - -TUWF::get qr{/$UID_RE}, sub { - my $uid = tuwf->capture('id'); - my $u = tuwf->dbRowi(q{ - SELECT u.id, u.username, EXTRACT('epoch' FROM u.registered) AS registered, u.c_votes, u.c_changes, u.c_tags, hd.value AS hide_list - FROM users u - LEFT JOIN users_prefs hd ON hd.uid = u.id AND hd.key = 'hide_list' - WHERE u.id =}, \$uid - ); - return tuwf->resNotFound if !$u->{id}; - - Framework - title => lcfirst($u->{username}), - index => 0, - single_col => 1, - top => sub { - Div class => 'col-md', sub { - EntryEdit u => $u; - Div class => 'detail-page-title', ucfirst $u->{username}; - TopNav details => $u; - } - }, - sub { - Stats $u; - List $u; - Edits $u; - }; -}; - -1; diff --git a/lib/VN3/User/RegReset.pm b/lib/VN3/User/RegReset.pm deleted file mode 100644 index ed815547..00000000 --- a/lib/VN3/User/RegReset.pm +++ /dev/null @@ -1,137 +0,0 @@ -# User registration and password reset. These functions share some common code. -package VN3::User::RegReset; - -use VN3::Prelude; - - -TUWF::get '/u/newpass' => sub { - return tuwf->resRedirect('/', 'temp') if auth; - Framework title => 'Password reset', center => 1, sub { - Div 'data-elm-module' => 'User.PassReset', ''; - }; -}; - - -my $elm_BadEmail = elm_api 'BadEmail'; -my $elm_BadPass = elm_api 'BadPass'; -my $elm_Bot = elm_api 'Bot'; -my $elm_Taken = elm_api 'Taken'; -my $elm_DoubleEmail = elm_api 'DoubleEmail'; -my $elm_DoubleIP = elm_api 'DoubleIP'; - - -json_api '/u/newpass', { - email => { email => 1 }, -}, sub { - my $data = shift; - - my($id, $token) = auth->resetpass($data->{email}); - return $elm_BadEmail->() if !$id; - - my $name = tuwf->dbVali('SELECT username FROM users WHERE id =', \$id); - my $body = sprintf - "Hello %s," - ."\n\n" - ."Your VNDB.org login has been disabled, you can now set a new password by following the link below:" - ."\n\n" - ."%s" - ."\n\n" - ."Now don't forget your password again! :-)" - ."\n\n" - ."vndb.org", - $name, tuwf->reqBaseURI()."/u$id/setpass/$token"; - - tuwf->mail($body, - To => $data->{email}, - From => 'VNDB <noreply@vndb.org>', - Subject => "Password reset for $name", - ); - $elm_Success->(); -}; - - -my $reset_url = qr{/$UID_RE/setpass/(?<token>[a-f0-9]{40})}; - -TUWF::get $reset_url, sub { - return tuwf->resRedirect('/', 'temp') if auth; - - my $id = tuwf->capture('id'); - my $token = tuwf->capture('token'); - my $name = tuwf->dbVali('SELECT username FROM users WHERE id =', \$id); - - return tuwf->resNotFound if !$name || !auth->isvalidtoken($id, $token); - - Framework title => 'Set password', center => 1, sub { - Div 'data-elm-module' => 'User.PassSet', 'data-elm-flags' => '"'.tuwf->reqPath().'"', ''; - }; -}; - - -json_api $reset_url, { - pass => { password => 1 }, -}, sub { - my $data = shift; - my $id = tuwf->capture('id'); - my $token = tuwf->capture('token'); - - return $elm_BadPass->() if tuwf->isUnsafePass($data->{pass}); - die "Invalid reset token" if !auth->setpass($id, $token, undef, $data->{pass}); - tuwf->dbExeci('UPDATE users SET email_confirmed = true WHERE id =', \$id); - $elm_Success->() -}; - - -TUWF::get '/u/register', sub { - return tuwf->resRedirect('/', 'temp') if auth; - Framework title => 'Register', center => 1, sub { - Div 'data-elm-module' => 'User.Register', ''; - }; -}; - - -json_api '/u/register', { - username => { username => 1 }, - email => { email => 1 }, - vns => { int => 1 }, -}, sub { - my $data = shift; - - my $num = tuwf->dbVali("SELECT count FROM stats_cache WHERE section = 'vn'"); - return $elm_Bot->() if $data->{vns} < $num*0.995 || $data->{vns} > $num*1.005; - return $elm_Taken->() if tuwf->dbVali('SELECT 1 FROM users WHERE username =', \$data->{username}); - return $elm_DoubleEmail->() if tuwf->dbVali(select => sql_func user_emailexists => \$data->{email}); - - my $ip = tuwf->reqIP; - return $elm_DoubleIP->() if tuwf->dbVali( - q{SELECT 1 FROM users WHERE registered >= NOW()-'1 day'::interval AND ip <<}, - $ip =~ /:/ ? \"$ip/48" : \"$ip/30" - ); - - my $id = tuwf->dbVali('INSERT INTO users', { - username => $data->{username}, - mail => $data->{email}, - ip => $ip, - }, 'RETURNING id'); - my(undef, $token) = auth->resetpass($data->{email}); - - my $body = sprintf - "Hello %s," - ."\n\n" - ."Someone has registered an account on VNDB.org with your email address. To confirm your registration, follow the link below." - ."\n\n" - ."%s" - ."\n\n" - ."If you don't remember creating an account on VNDB.org recently, please ignore this e-mail." - ."\n\n" - ."vndb.org", - $data->{username}, tuwf->reqBaseURI()."/u$id/setpass/$token"; - - tuwf->mail($body, - To => $data->{email}, - From => 'VNDB <noreply@vndb.org>', - Subject => "Confirm registration for $data->{username}", - ); - $elm_Success->() -}; - -1; diff --git a/lib/VN3/User/Settings.pm b/lib/VN3/User/Settings.pm deleted file mode 100644 index a63de232..00000000 --- a/lib/VN3/User/Settings.pm +++ /dev/null @@ -1,98 +0,0 @@ -package VN3::User::Settings; - -use VN3::Prelude; - - -my $FORM = { - username => { username => 1 }, - mail => { email => 1 }, - perm => { uint => 1, func => sub { ($_[0] & ~auth->allPerms) == 0 } }, - ign_votes => { anybool => 1 }, - hide_list => { anybool => 1 }, - show_nsfw => { anybool => 1 }, - traits_sexual => { anybool => 1 }, - tags_all => { anybool => 1 }, - tags_cont => { anybool => 1 }, - tags_ero => { anybool => 1 }, - tags_tech => { anybool => 1 }, - spoilers => { uint => 1, range => [ 0, 2 ] }, - - password => { _when => 'in', required => 0, type => 'hash', keys => { - old => { password => 1 }, - new => { password => 1 } - } }, - - id => { _when => 'out', uint => 1 }, - authmod => { _when => 'out', anybool => 1 }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; - -elm_form UserEdit => $FORM_OUT, $FORM_IN; - -my $elm_BadPass = elm_api 'BadPass'; -my $elm_BadLogin = elm_api 'BadLogin'; - -TUWF::get qr{/$UID_RE/edit}, sub { - my $u = tuwf->dbRowi('SELECT id, username, perm, ign_votes FROM users WHERE id =', \tuwf->capture('id')); - - return tuwf->resNotFound if !can_edit u => $u; - - $u->{mail} = tuwf->dbVali(select => sql_func user_getmail => \$u->{id}, \auth->uid, sql_fromhex auth->token); - $u->{authmod} = auth->permUsermod; - - # Let's not disclose this (though it's not hard to find out through other means) - if(!auth->permUsermod) { - $u->{ign_votes} = 0; - $u->{perm} = auth->defaultPerms; - } - - my $prefs = { map +($_->{key}, $_->{value}), @{ tuwf->dbAlli('SELECT key, value FROM users_prefs WHERE uid =', \$u->{id}) }}; - $u->{$_} = $prefs->{$_}||'' for qw/hide_list show_nsfw traits_sexual tags_all spoilers/; - $u->{spoilers} ||= 0; - $u->{"tags_$_"} = (($prefs->{tags_cat}||'cont,tech') =~ /$_/) for qw/cont ero tech/; - - my $title = $u->{id} == auth->uid ? 'My Preferences' : "Edit $u->{username}"; - Framework title => $title, noindex => 1, narrow => 1, sub { - FullPageForm module => 'User.Settings', data => $u, schema => $FORM_OUT; - }; -}; - - -json_api qr{/$UID_RE/edit}, $FORM_IN, sub { - my $data = shift; - my $id = tuwf->capture('id'); - - return $elm_Unauth->() if !can_edit u => { id => $id }; - - if(auth->permUsermod) { - tuwf->dbExeci(update => users => set => { - username => $data->{username}, - ign_votes => $data->{ign_votes}, - email_confirmed => 1, - }, where => { id => $id }); - tuwf->dbExeci(select => sql_func user_setperm => \$id, \auth->uid, sql_fromhex(auth->token), \$data->{perm}); - } - - if($data->{password}) { - return $elm_BadPass->() if tuwf->isUnsafePass($data->{password}{new}); - - if(auth->uid == $id) { - return $elm_BadLogin->() if !auth->setpass($id, undef, $data->{password}{old}, $data->{password}{new}); - } else { - tuwf->dbExeci(select => sql_func user_admin_setpass => \$id, \auth->uid, - sql_fromhex(auth->token), sql_fromhex auth->_preparepass($data->{password}{new}) - ); - } - } - - tuwf->dbExeci(select => sql_func user_setmail => \$id, \auth->uid, sql_fromhex(auth->token), \$data->{mail}); - - auth->prefSet($_, $data->{$_}, $id) for qw/hide_list show_nsfw traits_sexual tags_all spoilers/; - auth->prefSet(tags_cat => join(',', map $data->{"tags_$_"} ? $_ : (), qw/cont ero tech/), $id); - - $elm_Success->(); -}; - -1; diff --git a/lib/VN3/User/VNList.pm b/lib/VN3/User/VNList.pm deleted file mode 100644 index 922f81d6..00000000 --- a/lib/VN3/User/VNList.pm +++ /dev/null @@ -1,325 +0,0 @@ -package VN3::User::VNList; - -use POSIX 'ceil'; -use VN3::Prelude; -use VN3::User::Lib; - - -sub mkurl { - my $opt = shift; - $opt = { %$opt, @_ }; - delete $opt->{t} if $opt->{t} == -1; - delete $opt->{g} if !$opt->{g}; - '?'.join ';', map "$_=$opt->{$_}", sort keys %$opt; -} - - -sub SideBar { - my $opt = shift; - - Div class => 'fixed-size-left-sidebar-xl', sub { - Div class => 'vertical-selector-label', 'Status'; - Div class => 'vertical-selector', sub { - for (-1, keys %VNLIST_STATUS) { - A href => mkurl($opt, t => $_, p => 1), mkclass( - 'vertical-selector__item' => 1, - 'vertical-selector__item--active' => $_ == $opt->{t} - ), $_ < 0 ? 'All' : $VNLIST_STATUS{$_}; - } - }; - }; -} - - -sub NextPrev { - my($opt, $count) = @_; - my $numpage = ceil($count/50); - - Div class => 'd-lg-flex jc-between align-items-center', sub { - Div class => 'd-flex align-items-center', ''; - Div class => 'd-block d-lg-none mb-2', ''; - Div class => 'd-flex jc-right align-items-center', sub { - A href => mkurl($opt, p => $opt->{p}-1), mkclass(btn => 1, 'btn--disabled' => $opt->{p} <= 1), '< Prev'; - Div class => 'mx-3 semi-muted', sprintf 'page %d of %d', $opt->{p}, $numpage; - A href => mkurl($opt, p => $opt->{p}+1), mkclass(btn => 1, 'btn--disabled' => $opt->{p} >= $numpage), 'Next >'; - }; - }; -} - - -sub EditDropDown { - my($u, $opt, $item) = @_; - return if $u->{id} != (auth->uid||0); - Div 'data-elm-module' => 'UVNList.Options', - 'data-elm-flags' => JSON::XS->new->encode({uid => $u->{id}, item => $item}), - ''; -} - - -sub VNTable { - my($u, $lst, $opt) = @_; - - my $SortHeader = sub { - my($id, $label) = @_; - my $isasc = $opt->{s} eq $id && $opt->{o} eq 'a'; - A mkclass( - 'table-header' => 1, - 'with-sort-icon' => 1, - 'with-sort-icon--down' => !$isasc, - 'with-sort-icon--up' => $isasc, - 'with-sort-icon--active' => $opt->{s} eq $id, - ), href => mkurl($opt, p => 1, s => $id, o => $isasc ? 'd' : 'a'), $label; - }; - - Table class => 'table table--responsive-single-sm fs-medium vn-list', sub { - Thead sub { - Tr sub { - Th width => '15%', class => 'th--nopad', sub { $SortHeader->(date => 'Date' ) }; - Th width => '40%', class => 'th--nopad', sub { $SortHeader->(title => 'Title') }; - Th width => '10%', class => 'th--nopad', sub { $SortHeader->(vote => 'Vote' ) }; - Th width => '13%', 'Status'; - Th width => '7.33%', ''; - Th width => '7.33%', ''; - Th width => '7.33%', ''; - }; - }; - Tbody sub { - for my $l (@$lst) { - Tr sub { - Td class => 'tabular-nums muted', date_display $l->{date}; - Td sub { - A href => "/v$l->{id}", title => $l->{original}||$l->{title}, $l->{title}; - }; - - if($u->{id} == (auth->uid||0)) { - Td class => 'table-edit-overlay-base', sub { - Div 'data-elm-module' => 'UVNList.Vote', - 'data-elm-flags' => JSON::XS->new->encode({uid => int $u->{id}, vid => int $l->{id}, vote => ''.vote_display $l->{vote}}), - vote_display $l->{vote}; - }; - Td class => 'table-edit-overlay-base', sub { - Div 'data-elm-module' => 'UVNList.Status', - 'data-elm-flags' => JSON::XS->new->encode({uid => int $u->{id}, vid => int $l->{id}, status => int $l->{status}||0}), - $VNLIST_STATUS{$l->{status}||0}; - }; - } else { - Td vote_display $l->{vote}; - Td $VNLIST_STATUS{$l->{status}||0}; - } - - # Release info - Td sub { - A href => 'javascript:;', class => 'vn-list__expand-releases', sub { - Span class => 'expand-arrow mr-2', ''; - Txt sprintf '%d/%d', (scalar grep $_->{status}==2, @{$l->{rel}}), scalar @{$l->{rel}}; - } if @{$l->{rel}}; - }; - - # Notes - Td sub { - # TODO: vn-list__expand-comment--empty for 'add comment' things - A href => 'javascript:;', class => 'vn-list__expand-comment', sub { - Span class => 'expand-arrow mr-2', ''; - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/comment.svg'; - } if $l->{notes}; - }; - - Td sub { EditDropDown $u, $opt, $l }; - }; - - # Release info - Tr class => 'vn-list__releases-row d-none', sub { - Td colspan => '6', sub { - Div class => 'vn-list__releases', sub { - Table class => 'table table--responsive-single-sm ml-3', sub { - Tbody sub { - for my $r (@{$l->{rel}}) { - Tr sub { - Td width => '15%', class => 'tabular-nums muted pl-0', date_display $r->{date}; - Td width => '50%', sub { - A href => "/v$r->{rid}", title => $r->{original}||$r->{title}, $r->{title}; - }; - # TODO: Editabe - Td width => '20%', $RLIST_STATUS{$l->{status}}; - Td width => '15%', ''; # TODO: Edit menu - } - } - } - } - } - } - } if @{$l->{rel}}; - - # Notes - Tr class => 'vn-list__comment-row d-none', sub { - Td colspan => '6', sub { - # TODO: Editable - Div class => 'vn-list__comment ml-3', $l->{notes}; - } - } if $l->{notes}; - }; - }; - }; -} - - -sub VNGrid { - my($u, $lst, $opt) = @_; - - Div class => 'vn-grid mb-4', sub { - for my $l (@$lst) { - Div class => 'vn-grid__item', sub { - # TODO: NSFW hiding? What about missing images? - Div class => 'vn-grid__item-bg', style => sprintf("background-image: url('%s')", tuwf->imgurl(cv => $l->{image})), ''; - Div class => 'vn-grid__item-overlay', sub { - A href => 'javascript:;', class => 'vn-grid__item-link', ''; # TODO: Open modal on click - Div class => 'vn-grid__item-top', sub { - EditDropDown $u, $opt, $l; - Div class => 'vn-grid__item-rating', sub { - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/comment.svg' if $l->{notes}; - Lit ' '; - Txt vote_display $l->{vote}; - } - }; - Div class => 'vn-grid__item-name', $l->{title}; - } - } - } - } -} - - -sub List { - my($u, $opt) = @_; - - my $lst = tuwf->dbAlli(q{ - SELECT v.id, v.title, v.original, vl.status, vl.notes, vo.vote, v.image, }, - sql_totime('LEAST(vl.added, vo.date)'), q{AS date, - count(*) OVER() AS full_count - FROM vn v - LEFT JOIN votes vo ON vo.vid = v.id AND vo.uid =}, \$u->{id}, q{ - LEFT JOIN vnlists vl ON vl.vid = v.id AND vl.uid =}, \$u->{id}, q{ - WHERE }, sql_and( - 'vo.vid IS NOT NULL OR vl.vid IS NOT NULL', - $opt->{t} >= 1 ? sql('vl.status =', \$opt->{t}) : $opt->{t} == 0 ? 'vl.status = 0 OR vl.status IS NULL' : () - ), - 'ORDER BY', { - title => 'v.title', - date => 'LEAST(vl.added, vo.date)', - vote => 'vo.vote', - }->{$opt->{s}}, - $opt->{o} eq 'a' ? 'ASC' : 'DESC', - 'NULLS LAST', - 'LIMIT', \50, - 'OFFSET', \(($opt->{p}-1)*50) - ); - my $count = @$lst ? $lst->[0]{full_count} : 0; - delete $_->{full_count} for @$lst; - - enrich_list rel => id => vid => sub { sql q{ - SELECT rv.vid, rl.rid, rl.status, r.title, r.original, }, sql_totime('rl.added'), q{ AS date - FROM rlists rl - JOIN releases r ON r.id = rl.rid - JOIN releases_vn rv ON rv.id = r.id - WHERE rl.uid =}, \$u->{id}, q{AND rv.vid IN}, $_[0] - }, $lst; - - Div class => 'col-md', sub { - Div class => 'card card--white card--no-separators mb-5', sub { - Div class => 'card__header', sub { - Div class => 'card__title', 'List'; - Debug $lst; - Div class => 'card__header-buttons', sub { - Div class => 'btn-group', sub { - A href => mkurl($opt, g => 0), mkclass(btn => 1, active => !$opt->{g}, 'js-show-vn-list' => 1), \&ListIcon; - A href => mkurl($opt, g => 1), mkclass(btn => 1, active => $opt->{g}, 'js-show-vn-grid' => 1), \&GridIcon; - }; - }; - }; - - VNTable $u, $lst, $opt unless $opt->{g}; - Div class => 'card__body fs-medium', sub { - VNGrid $u, $lst, $opt if $opt->{g}; - NextPrev $opt, $count; - }; - } - }; -} - - -TUWF::get qr{/$UID_RE/list}, sub { - my $uid = tuwf->capture('id'); - my $u = tuwf->dbRowi(q{ - SELECT u.id, u.username, hd.value AS hide_list - FROM users u - LEFT JOIN users_prefs hd ON hd.uid = u.id AND hd.key = 'hide_list' - WHERE u.id =}, \$uid - ); - return tuwf->resNotFound if !$u->{id} || !show_list $u; - - my $opt = tuwf->validate(get => - t => { vnlist_status => 1, required => 0, default => -1 }, # status - p => { page => 1 }, # page - o => { enum => ['d','a'], required => 0, default => 'a' }, # order (asc/desc) - s => { enum => ['title', 'date', 'vote'], required => 0, default => 'title' }, # sort column - g => { anybool => 1 }, # grid - )->data; - - Framework - title => $u->{username}, - index => 0, - top => sub { - Div class => 'col-md', sub { - Div class => 'detail-page-title', ucfirst $u->{username}; - TopNav list => $u; - } - }, - sub { - Div class => 'row', sub { - SideBar $opt; - List $u, $opt; - }; - }; -}; - - -json_api '/u/setvote', { - uid => { id => 1 }, - vid => { id => 1 }, - vote => { vnvote => 1 } -}, sub { - my $data = shift; - return $elm_Unauth->() if (auth->uid||0) != $data->{uid}; - - tuwf->dbExeci( - 'DELETE FROM votes WHERE', - { vid => $data->{vid}, uid => $data->{uid} } - ) if !$data->{vote}; - - tuwf->dbExeci( - 'INSERT INTO votes', - { vid => $data->{vid}, uid => $data->{uid}, vote => $data->{vote} }, - 'ON CONFLICT (vid, uid) DO UPDATE SET', - { vote => $data->{vote} } - ) if $data->{vote}; - - $elm_Success->() -}; - - -json_api '/u/setvnstatus', { - uid => { id => 1 }, - vid => { id => 1 }, - status => { vnlist_status => 1 } -}, sub { - my $data = shift; - return $elm_Unauth->() if (auth->uid||0) != $data->{uid}; - - tuwf->dbExeci( - 'INSERT INTO vnlists', - { vid => $data->{vid}, uid => $data->{uid}, status => $data->{status} }, - 'ON CONFLICT (vid, uid) DO UPDATE SET', - { status => $data->{status} } - ); - $elm_Success->(); -}; diff --git a/lib/VN3/VN/Edit.pm b/lib/VN3/VN/Edit.pm deleted file mode 100644 index bee48a5f..00000000 --- a/lib/VN3/VN/Edit.pm +++ /dev/null @@ -1,187 +0,0 @@ -package VN3::VN::Edit; - -use VN3::Prelude; -use VN3::VN::Lib; - - -my $FORM = { - alias => { required => 0, default => '', maxlength => 500 }, - anime => { maxlength => 50, sort_keys => 'aid', aoh =>{ - aid => { id => 1 } - } }, - desc => { required => 0, default => '', maxlength => 10240 }, - image => { required => 0, default => 0, id => 1 }, # X - img_nsfw => { anybool => 1 }, - hidden => { anybool => 1 }, - l_encubed => { required => 0, default => '', maxlength => 100 }, - l_renai => { required => 0, default => '', maxlength => 100 }, - l_wp => { required => 0, default => '', maxlength => 150 }, - length => { vn_length => 1 }, - locked => { anybool => 1 }, - original => { required => 0, default => '', maxlength => 250 }, - relations => { maxlength => 50, sort_keys => 'vid', aoh => { - vid => { id => 1 }, # X - relation => { vn_relation => 1 }, - official => { anybool => 1 }, - title => { _when => 'out' }, - } }, - screenshots => { maxlength => 10, sort_keys => 'scr', aoh => { - scr => { id => 1 }, # X - rid => { id => 1 }, # X - nsfw => { anybool => 1 }, - width => { _when => 'out', uint => 1 }, - height => { _when => 'out', uint => 1 }, - } }, - seiyuu => { sort_keys => ['aid','cid'], aoh => { - aid => { id => 1 }, # X - cid => { id => 1 }, # X - note => { required => 0, default => '', maxlength => 250 }, - id => { _when => 'out', id => 1 }, - name => { _when => 'out' }, - } }, - staff => { sort_keys => ['aid','role'], aoh => { - aid => { id => 1 }, # X - role => { staff_role => 1 }, - note => { required => 0, default => '', maxlength => 250 }, - id => { _when => 'out', id => 1 }, - name => { _when => 'out' }, - } }, - title => { maxlength => 250 }, - - id => { _when => 'out', required => 0, id => 1 }, - authmod => { _when => 'out', anybool => 1 }, - editsum => { _when => 'in out', editsum => 1 }, - chars => { _when => 'out', aoh => { - id => { id => 1 }, - name => {}, - } }, - releases => { _when => 'out', aoh => { - id => { id => 1 }, - title => {}, - original => {}, - display => {}, - resolution=> {}, - } }, -}; - -my $FORM_OUT = form_compile out => $FORM; -my $FORM_IN = form_compile in => $FORM; -my $FORM_CMP = form_compile cmp => $FORM; - -elm_form VNEdit => $FORM_OUT, $FORM_IN; - - -TUWF::get qr{/$VREV_RE/edit} => sub { - my $vn = entry v => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resDenied if !can_edit v => $vn; - - enrich aid => q{SELECT id, aid, name FROM staff_alias WHERE aid IN} => $vn->{staff}, $vn->{seiyuu}; - enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $vn->{relations}; - enrich scr => q{SELECT id AS scr, width, height FROM screenshots WHERE id IN}, $vn->{screenshots}; - $vn->{chars} = tuwf->dbAlli('SELECT id, name FROM chars c WHERE id IN(SELECT id FROM chars_vns WHERE vid =', \$vn->{id}, ') ORDER BY name'); - - $vn->{releases} = tuwf->dbAlli('SELECT id, title, original, resolution FROM releases WHERE id IN(SELECT id FROM releases_vn WHERE vid =', \$vn->{id}, ') ORDER BY id'); - enrich_list1 lang => id => id => q{SELECT id, lang FROM releases_lang WHERE id IN}, $vn->{releases}; - $_->{display} = sprintf '[%s] %s (r%d)', join(',', @{ delete $_->{lang} }), $_->{title}, $_->{id} for @{$vn->{releases}}; - - $vn->{authmod} = auth->permDbmod; - $vn->{editsum} = $vn->{chrev} == $vn->{maxrev} ? '' : "Reverted to revision v$vn->{id}.$vn->{chrev}"; - - Framework index => 0, title => "Edit $vn->{title}", - top => sub { - Div class => 'col-md', sub { - EntryEdit v => $vn; - Div class => 'detail-page-title', sub { - Txt $vn->{title}; - Debug $vn; - }; - TopNav edit => $vn; - }; - }, sub { - FullPageForm module => 'VNEdit.Main', data => $vn, schema => $FORM_OUT, sections => [ - general => 'General info', - staff => 'Staff', - cast => 'Cast', - relations => 'Relations', - screenshots => 'Screenshots', - ]; - }; -}; - - -TUWF::get '/v/add', sub { - return tuwf->resDenied if !auth->permEdit; - Framework index => 0, title => 'Add a new visual novel', narrow => 1, sub { - Div class => 'row', sub { - Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'VNEdit.New', '' }; - }; - }; -}; - - -json_api qr{/(?:$VID_RE/edit|v/add)}, $FORM_IN, sub { - my $data = shift; - my $new = !tuwf->capture('id'); - my $vn = $new ? { id => 0 } : entry v => tuwf->capture('id') or return tuwf->resNotFound; - - return $elm_Unauth->() if !can_edit v => $vn; - - if(!auth->permDbmod) { - $data->{hidden} = $vn->{hidden}||0; - $data->{locked} = $vn->{locked}||0; - } - - # Elm doesn't actually verify this one - die "Image not found" if $data->{image} && !-e tuwf->imgpath(cv => $data->{image}); - - die "Relation with self" if grep $_->{vid} == $vn->{id}, @{$data->{relations}}; - validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{relations}}; - validate_dbid 'SELECT id FROM screenshots WHERE id IN', map $_->{scr}, @{$data->{screenshots}}; - validate_dbid sql('SELECT DISTINCT id FROM releases_vn WHERE vid =', \$vn->{id}, ' AND id IN'), map $_->{rid}, @{$data->{screenshots}}; - validate_dbid 'SELECT aid FROM staff_alias WHERE aid IN', map $_->{aid}, @{$data->{seiyuu}}, @{$data->{staff}}; - validate_dbid sql('SELECT DISTINCT id FROM chars_vns WHERE vid =', \$vn->{id}, ' AND id IN'), map $_->{cid}, @{$data->{seiyuu}}; - - $data->{desc} = bb_subst_links $data->{desc}; - return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $vn; - - my($id,undef,$rev) = update_entry v => $vn->{id}, $data; - - update_reverse($id, $rev, $vn, $data); - - $elm_Changed->($id, $rev); -}; - - -sub update_reverse { - my($id, $rev, $old, $new) = @_; - - my %old = map +($_->{vid}, $_), $old->{relations} ? @{$old->{relations}} : (); - my %new = map +($_->{vid}, $_), @{$new->{relations}}; - - # Updates to be performed, vid => { vid => x, relation => y, official => z } or undef if the relation should be removed. - my %upd; - - for my $i (keys %old, keys %new) { - if($old{$i} && !$new{$i}) { - $upd{$i} = undef; - } elsif(!$old{$i} || $old{$i}{relation} ne $new{$i}{relation} || !$old{$i}{official} != !$new{$i}{official}) { - $upd{$i} = { - vid => $id, - relation => vn_relation_reverse($new{$i}{relation}), - official => $new{$i}{official} - }; - } - } - - for my $i (keys %upd) { - my $v = entry v => $i; - $v->{relations} = [ - $upd{$i} ? $upd{$i} : (), - grep $_->{vid} != $id, @{$v->{relations}} - ]; - $v->{editsum} = "Reverse relation update caused by revision v$id.$rev"; - update_entry v => $i, $v, 1; - } -} - -1; diff --git a/lib/VN3/VN/JS.pm b/lib/VN3/VN/JS.pm deleted file mode 100644 index ec98b768..00000000 --- a/lib/VN3/VN/JS.pm +++ /dev/null @@ -1,46 +0,0 @@ -package VN3::VN::JS; - -use VN3::Prelude; - - -my $elm_VNResult = elm_api VNResult => { aoh => { - id => { id => 1 }, - title => {}, - original => {}, - hidden => { anybool => 1 }, -}}; - - -json_api '/js/vn.json', { - search => { type => 'array', scalar => 1, minlength => 1, values => { maxlength => 500 } }, - hidden => { anybool => 1 } -}, sub { - my $data = shift; - - my $r = tuwf->dbAlli( - 'SELECT v.id, v.title, v.original, v.hidden', - 'FROM (', (sql_join 'UNION ALL', map { - my $qs = s/[%_]//gr; - my @q = normalize_query $_; - +( - # ID search - /^$VID_RE$/ ? (sql 'SELECT 1, id FROM vn WHERE id =', \"$1") : (), - # prefix match - sql('SELECT 2, id FROM vn WHERE title ILIKE', \"$qs%"), - # substring match - @q ? (sql 'SELECT 3, id FROM vn WHERE', sql_and map sql('c_search ILIKE', \"%$_%"), @q) : () - ) - } @{$data->{search}}), - ') AS vt (ord, id)', - 'JOIN vn v ON v.id = vt.id', - $data->{hidden} ? () : ('WHERE NOT v.hidden'), - 'GROUP BY v.id, v.title, v.original', - 'ORDER BY MIN(vt.ord), v.title', - 'LIMIT 20' - ); - - $elm_VNResult->($r); -}; - -1; - diff --git a/lib/VN3/VN/Lib.pm b/lib/VN3/VN/Lib.pm deleted file mode 100644 index 9571cef8..00000000 --- a/lib/VN3/VN/Lib.pm +++ /dev/null @@ -1,20 +0,0 @@ -package VN3::VN::Lib; - -use VN3::Prelude; - -our @EXPORT = qw/TopNav/; - - -sub TopNav { - my($page, $v) = @_; - - my $rg = exists $v->{rgraph} ? $v->{rgraph} : tuwf->dbVali('SELECT rgraph FROM vn WHERE id=', \$v->{id}); - - Div class => 'nav raised-top-nav', sub { - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'details'), sub { A href => "/v$v->{id}", class => 'nav__link', 'Details'; }; - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'discussions'),sub { A href => "/t/v$v->{id}", class => 'nav__link', 'Discussions'; }; # TODO: count - Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'relations'), sub { A href => "/v$v->{id}/rg", class => 'nav__link', 'Relations'; } if $rg; - }; -} - -1; diff --git a/lib/VN3/VN/Page.pm b/lib/VN3/VN/Page.pm deleted file mode 100644 index a09bbeb9..00000000 --- a/lib/VN3/VN/Page.pm +++ /dev/null @@ -1,631 +0,0 @@ -package VN3::VN::Page; - -use VN3::Prelude; -use VN3::VN::Lib; - - -TUWF::get '/v/rand', sub { - # TODO: Apply stored filters? - my $vid = tuwf->dbVal('SELECT id FROM vn WHERE NOT hidden ORDER BY RANDOM() LIMIT 1'); - tuwf->resRedirect("/v$vid", 'temp'); -}; - - -sub CVImage { - my($vn, $class, $class_sfw, $class_nsfw) = @_; - return if !$vn->{image}; - - my $img = tuwf->imgurl(cv => $vn->{image}); - my $nsfw = tuwf->conf->{url_static}.'/v3/nsfw.svg'; - Img class => $class.' '.($vn->{img_nsfw} ? $class_nsfw : $class_sfw), - !$vn->{img_nsfw} ? (src => $img) - : auth->pref('show_nsfw') ? (src => $img, 'data-toggle-img' => $nsfw) - : (src => $nsfw, 'data-toggle-img' => $img); -} - - -sub Top { - my $vn = shift; - Div class => 'fixed-size-left-sidebar-md', ''; - Div class => 'col-md', sub { - Div class => 'vn-header', sub { - EntryEdit v => $vn; - CVImage $vn, 'page-header-img-mobile img img--rounded d-md-none', '', 'nsfw-outline'; - Div class => 'vn-header__title', $vn->{title}; - Div class => 'vn-header__original-title', $vn->{original} if $vn->{original}; - Div class => 'vn-header__details', sub { - Txt $vn->{c_rating} ? sprintf '%.1f ', $vn->{c_rating}/10 : '-'; - Div class => 'vn-header__sep', ''; - Txt vn_length_time $vn->{length}; - Div class => 'vn-header__sep', ''; - Txt join ', ', map $LANGUAGE{$_}, @{$vn->{c_languages}}; - Debug $vn; - }; - }; - TopNav details => $vn; - }; -} - - -sub SidebarProd { - my $vn = shift; - - my $prod = tuwf->dbAlli(q{ - SELECT p.id, p.name, p.original, bool_or(rp.developer) AS dev, bool_or(rp.publisher) AS pub - FROM releases r - JOIN releases_producers rp ON rp.id = r.id - JOIN releases_vn rv ON rv.id = r.id - JOIN producers p ON rp.pid = p.id - WHERE rv.vid =}, \$vn->{id}, q{ - AND NOT r.hidden - GROUP BY p.id, p.name, p.original - ORDER BY p.name - }); - - my $Fmt = sub { - my($single, $multi, @lst) = @_; - - Dt @lst == 1 ? $single : $multi; - Dd sub { - Join ', ', sub { - A href => "/p$_[0]{id}", title => $_[0]{original}||$_[0]{name}, $_[0]{name} - }, @lst; - }; - }; - - $Fmt->('Developer', 'Developers', grep $_->{dev}, @$prod); - $Fmt->('Publisher', 'Publishers', grep $_->{pub}, @$prod); -} - - -sub SidebarRel { - my $vn = shift; - return if !@{$vn->{relations}}; - - Dt 'Relations'; - Dd sub { - Dl sub { - for my $type (keys %VN_RELATION) { - my @rel = grep $_->{relation} eq $type, @{$vn->{relations}}; - next if !@rel; - Dt vn_relation_display $type; - Dd class => 'single-line-md', sub { - Span 'unofficial ' if !$_->{official}; - A href => "/v$_->{vid}", title => $_->{original}||$_->{title}, $_->{title}; - } for @rel; - } - } - } -} - - -sub Sidebar { - my $vn = shift; - - CVImage $vn, 'img img--fit img--rounded d-none d-md-block vn-img-desktop', 'elevation-1', 'elevation-1-nsfw' if $vn->{image}; - Div class => 'vn-image-placeholder img--rounded elevation-1 d-none d-md-block vn-img-desktop', sub { - Div class => 'vn-image-placeholder__icon', sub { - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/camera-alt.svg'; - } - } if !$vn->{image}; - - Div class => 'add-to-list elevated-button elevation-1', sub { - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/plus.svg'; - Txt 'Add to my list'; - }; - - Dl class => 'vn-page__dl', sub { - if($vn->{original}) { - Dt 'Original Title'; - Dd $vn->{original}; - } - - Dt 'Main Title'; - Dd $vn->{title}; - - if($vn->{alias}) { - Dt 'Aliases'; - Dd $vn->{alias} =~ s/\n/, /gr; - } - - if($vn->{length}) { - Dt 'Length'; - Dd vn_length_display $vn->{length}; - } - - SidebarProd $vn; - SidebarRel $vn; - - # TODO: Affiliate links - # TODO: Anime - }; -} - - -sub Tags { - my $vn = shift; - - my $tag_rating = 'avg(CASE WHEN tv.ignore THEN NULL ELSE tv.vote END)'; - my $tags = tuwf->dbAlli(qq{ - SELECT tv.tag, t.name, t.cat, count(*) as cnt, $tag_rating as rating, - COALESCE(avg(CASE WHEN tv.ignore THEN NULL ELSE tv.spoiler END), t.defaultspoil) as spoiler - FROM tags_vn tv - JOIN tags t ON tv.tag = t.id - WHERE tv.vid =}, \$vn->{id}, qq{ - AND t.state = 1+1 - GROUP BY tv.tag, t.name, t.cat, t.defaultspoil - HAVING $tag_rating > 0 - ORDER BY $tag_rating DESC - }); - - my $spoil = auth->pref('spoilers') || 0; - my $cat = auth->pref('tags_cat') || 'cont,tech'; - my %cat = map +($_, !!($cat =~ /$_/)), qw/cont ero tech/; - - Div mkclass( - 'tag-summary__tags' => 1, - 'tag-summary--collapsed' => 1, - 'tag-summary--hide-spoil-1' => $spoil < 1, - 'tag-summary--hide-spoil-2' => $spoil < 2, - map +("tag-summary--hide-$_", !$cat{$_}), keys %cat - ), sub { - for my $tag (@$tags) { - Div class => sprintf( - 'tag-summary__tag tag-summary__tag--%s tag-summary__tag--spoil-%d', - $tag->{cat}, $tag->{spoiler} > 1.3 ? 2 : $tag->{spoiler} > 0.4 ? 1 : 0 - ), sub { - A href => "/g$tag->{tag}", class => 'link--subtle', $tag->{name}; - Div class => 'tag-summary__tag-meter', style => sprintf('width: %dpx', $tag->{rating}*10), ''; - }; - } - }; - - Div class => 'tag-summary__options', sub { - Div class => 'tag-summary__options-left', sub { - A href => 'javascript:;', class => 'link--subtle d-none tag-summary__show-all', sub { - Span class => 'caret caret--pre', ''; - Txt ' Show all tags'; - }; - Debug $tags; - }; - Div class => 'tag-summary__options-right', sub { - Div class => 'tag-summary__option dropdown', sub { - A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub { - Span class => 'tag-summary_option--spoil', spoil_display $spoil; - Lit ' '; - Span class => 'caret', ''; - }; - Div class => 'dropdown-menu', sub { - A class => 'dropdown-menu__item tag-summary_option--spoil-0', href => 'javascript:;', spoil_display 0; - A class => 'dropdown-menu__item tag-summary_option--spoil-1', href => 'javascript:;', spoil_display 1; - A class => 'dropdown-menu__item tag-summary_option--spoil-2', href => 'javascript:;', spoil_display 2; - }; - }; - Div class => 'tag-summary__option', sub { Switch 'Content', $cat{cont}, 'tag-summary__option--cont' => 1; }; - Div class => 'tag-summary__option', sub { Switch 'Sexual', $cat{ero}, 'tag-summary__option--ero' => 1; }; - Div class => 'tag-summary__option', sub { Switch 'Technical', $cat{tech}, 'tag-summary__option--tech' => 1; }; - }; - }; -} - - -sub Releases { - my $vn = shift; - - my %lang; - my @lang = grep !$lang{$_}++, map @{$_->{lang}}, @{$vn->{releases}}; - - for my $lang (@lang) { - Div class => 'relsm__language', sub { - Lang $lang; - Txt " $LANGUAGE{$lang}"; - }; - Div class => 'relsm__table', sub { - Div class => 'relsm__rel', sub { - my $rel = $_; - - Div class => 'relsm__rel-col relsm__rel-date tabular-nums', sub { ReleaseDate $rel->{released}; }; - A class => 'relsm__rel-col relsm__rel-name', href => "/r$rel->{id}", title => $rel->{original}||$rel->{title}, $rel->{title}; - Div class => 'relsm__rel-col relsm__rel-platforms', sub { Platform $_ for @{$rel->{platforms}} }; - Div class => 'relsm__rel-col relsm__rel-mylist', sub { - # TODO: Make this do something - Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/plus-circle.svg'; - }; - if($rel->{website}) { - Div class => 'relsm__rel-col relsm__rel-link', sub { - A href => $rel->{website}, 'Link'; - }; - } else { - Div class => 'relsm__rel-col relsm__rel-link relsm__rel-link--none', 'Link'; - } - - # TODO: Age rating - # TODO: Release type - # TODO: Release icons - } for grep grep($_ eq $lang, @{$_->{lang}}), @{$vn->{releases}}; - } - } -} - - -sub Staff { - my $vn = shift; - return if !@{$vn->{staff}}; - - my $Role = sub { - my $role = shift; - my @staff = grep $_->{role} eq $role, @{$vn->{staff}}; - return if !@staff; - - Div class => 'staff-credits__section', sub { - Div class => 'staff-credits__section-title', $CREDIT_TYPE{$role}; - Div class => 'staff-credits__item', sub { - A href => "/s$_->{id}", title => $_->{original}||$_->{name}, $_->{name}; - Span class => 'staff-credits__note', " $_->{note}" if $_->{note}; - } for (@staff); - }; - }; - - Div class => 'section', id => 'staff', sub { - H2 class => 'section__title', 'Staff'; - Div class => 'staff-credits js-columnize', 'data-columns' => 3, sub { - $Role->($_) for keys %CREDIT_TYPE; - }; - }; -} - - -sub Gallery { - my $vn = shift; - - return if !@{$vn->{screenshots}}; - my $show = auth->pref('show_nsfw'); - - Div mkclass(section => 1, gallery => 1, 'gallery--show-r18' => $show), id => 'gallery', sub { - H2 class => 'section__title', sub { - Switch '18+', $show, 'gallery-r18-toggle' => 1 if grep $_->{nsfw}, @{$vn->{screenshots}}; - Txt 'Gallery'; - }; - - # TODO: Thumbnails are being upscaled, we should probably recreate all thumbnails at higher resolution - - Div class => 'gallery__section', sub { - for my $s (@{$vn->{screenshots}}) { - my $r = (grep $_->{id} == $s->{rid}, @{$vn->{releases}})[0]; - my $meta = { - width => 1*$s->{width}, - height => 1*$s->{height}, - rel => { - id => 1*$s->{rid}, - title => $r->{title}, - lang => $r->{lang}, - plat => $r->{platforms}, - } - }; - - A mkclass('gallery__image-link' => 1, 'gallery__image--r18' => $s->{nsfw}), - 'data-lightbox-nfo' => JSON::XS->new->encode($meta), - href => tuwf->imgurl(sf => $s->{scr}), - sub { - Img mkclass(gallery__image => 1, 'nsfw-outline' => $s->{nsfw}), src => tuwf->imgurl(st => $s->{scr}); - } - } - } - }; -} - - -sub CharacterList { - my($vn, $roles, $first_char) = @_; - - # TODO: Implement spoiler & sexual stuff settings - # TODO: Make long character lists collapsable - - Div class => 'character-browser__top-item dropdown', sub { - A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub { - Txt spoil_display 0; - Lit ' '; - Span class => 'caret', ''; - }; - Div class => 'dropdown-menu', sub { - A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 0; - A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 1; - A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 2; - }; - }; - Div class => 'character-browser__top-item d-none d-md-block', sub { Switch 'Sexual traits', 0 }; - Div class => 'character-browser__top-item', sub { - A href => "/v$vn->{id}/chars", 'View all on one page'; - }; - - Div class => 'character-browser__list', sub { - Div class => 'character-browser__list-title', char_role_display $_, scalar @{$roles->{$_}}; - A mkclass('character-browser__char' => 1, 'character-browser__char--active' => $_->{id} == $first_char), - href => "/c$_->{id}", title => $_->{original}||$_->{name}, 'data-character' => $_->{id}, $_->{name} - for @{$roles->{$_}}; - } for grep @{$roles->{$_}}, keys %CHAR_ROLE; -} - - -sub CharacterInfo { - my $char = shift; - - Div class => 'row', sub { - Div class => 'col-md', sub { - # TODO: Gender & blood type - Div class => 'character__name', $char->{name}; - Div class => 'character__subtitle', $char->{original} if $char->{original}; - Div class => 'character__description serif', sub { - P sub { Lit bb2html $char->{desc}, 0, 1 }; - }; - }; - Div class => 'col-md character__image', sub { - Img class => 'img img--fit img--rounded', - src => tuwf->imgurl(ch => $char->{image}) - } if $char->{image}; - }; - - my(%groups, @groups); - for(@{$char->{traits}}) { - push @groups, $_->{gid} if !$groups{$_->{gid}}; - push @{$groups{$_->{gid}}}, $_; - } - - # Create a list of key/value things, so that we can neatly split them in - # two. The split occurs on the number of sections, so long sections can - # still cause some imbalance. - # TODO: Date of birth? - my @traits = ( - $char->{alias} ? sub { - Dt 'Aliases'; - Dd $char->{alias} =~ s/\n/, /gr; - } : (), - - $char->{weight} || $char->{height} || $char->{s_bust} || $char->{s_waist} || $char->{s_hip} ? sub { - Dt 'Measurements'; - Dd join ', ', - $char->{height} ? "Height: $char->{height}cm" : (), - $char->{weight} ? "Weight: $char->{weight}kg" : (), - $char->{s_bust} || $char->{s_waist} || $char->{s_hip} ? - sprintf 'Bust-Waist-Hips: %s-%s-%scm', $char->{s_bust}||'??', $char->{s_waist}||'??', $char->{s_hip}||'??' : (); - } : (), - - # TODO: Do something with spoiler settings. - (map { my $g = $_; sub { - Dt sub { A href => "/i$g", $groups{$g}[0]{group} }; - Dd sub { - Join ', ', sub { - A href => "/i$_[0]{tid}", $_[0]{name}; - }, @{$groups{$g}}; - }; - } } @groups), - - @{$char->{seiyuu}} ? sub { - Dt 'Voiced by'; - Dd sub { - my $prev = ''; - for my $s (sort { $a->{name} cmp $b->{name} } @{$char->{seiyuu}}) { - next if $s->{name} eq $prev; - A href => "/s$s->{id}", title => $s->{original}||$s->{name}, $s->{name}; - Txt ' ('.$s->{note}.')' if $s->{note}; - } - }; - } : (), - ); - - Div class => 'character__traits row mt-4', sub { - Dl class => 'col-md dl--horizontal', sub { $_->() for @traits[0..$#traits/2]; }; - Dl class => 'col-md dl--horizontal', sub { $_->() for @traits[$#traits/2+1..$#traits]; }; - } if @traits; -} - - -sub Characters { - my $vn = shift; - - # XXX: Fetching and rendering all character details on the VN page is a bit - # inefficient and bloats the HTML. We should probably load data from other - # characters on demand. - - my $chars = tuwf->dbAlli(q{ - SELECT id, name, original, alias, image, "desc", gender, s_bust, s_waist, s_hip, - b_month, b_day, height, weight, bloodt - FROM chars - WHERE NOT hidden - AND id IN(SELECT id FROM chars_vns WHERE vid =}, \$vn->{id}, q{) - ORDER BY name - }); - return if !@$chars; - - enrich_list releases => id => id => - sql('SELECT id, rid, spoil, role FROM chars_vns WHERE vid =', \$vn->{id}, ' AND id IN'), - $chars; - - # XXX: Just fetching this list takes ~10ms for a large VN (v92). I worry - # about formatting and displaying it on every page view. (This query can - # probably be sped up by grabbing/caching the group tag names separately, - # there are only 12 groups in the DB anyway). - enrich_list traits => id => id => sub {sql q{ - SELECT ct.id, ct.tid, ct.spoil, t.name, t.sexual, g.id AS gid, g.name AS group, g.order - FROM chars_traits ct - JOIN traits t ON t.id = ct.tid - JOIN traits g ON g.id = t.group - WHERE ct.id IN}, $_[0], q{ - ORDER BY g.order, t.name - }}, $chars; - - enrich_list seiyuu => id => cid => sub{sql q{ - SELECT va.id, vs.aid, vs.cid, vs.note, va.name, va.original - FROM vn_seiyuu_hist vs JOIN staff_alias va ON va.aid = vs.aid - WHERE vs.chid =}, \$vn->{chid} - }, $chars; - - my %done; - my %roles = map { - my $r = $_; - ($r, [ grep grep($_->{role} eq $r, @{$_->{releases}}) && !$done{$_->{id}}++, @$chars ]); - } keys %CHAR_ROLE; - - my($first_char) = map @{$roles{$_}} ? $roles{$_}[0]{id} : (), keys %CHAR_ROLE; - - Div class => 'section', id => 'characters', sub { - H2 class => 'section__title', sub { Txt 'Characters'; Debug \%roles }; - Div class => 'character-browser', sub { - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md', sub { - Div class => 'character-browser__top-items', sub { CharacterList $vn, \%roles, $first_char; } - }; - Div class => 'col-md col-md--3 d-none d-md-block', sub { - Div mkclass(character => 1, 'd-none' => $_->{id} != $first_char), 'data-character' => $_->{id}, - sub { CharacterInfo $_ } - for @$chars; - }; - }; - }; - }; -} - - -sub Stats { - my $vn = shift; - - my($has_data, $Dist) = VoteGraph v => $vn->{id}; - return if !$has_data; - - my $recent_votes = tuwf->dbAlli(q{ - SELECT v.vid, v.vote,}, sql_totime('v.date'), q{AS date, u.id, u.username - FROM votes v JOIN users u ON u.id = v.uid - WHERE NOT EXISTS(SELECT 1 FROM users_prefs WHERE uid = u.id AND key = 'hide_list') - AND NOT u.ign_votes - AND v.vid =}, \$vn->{id}, q{ - ORDER BY v.date DESC LIMIT 10 - }); - my $Recent = sub { - H4 'Recent votes'; - Div class => 'recent-votes', sub { - Table class => 'recent-votes__table tabular-numbs', sub { - Tbody sub { - Tr sub { - Td sub { A href => "/u$_->{id}", $_->{username}; }; - Td vote_display $_->{vote}; - Td date_display $_->{date}; - } for @$recent_votes; - }; - }; - Div class => 'final-text', sub { - A href => "/v$vn->{id}/votes", 'All votes'; - }; - }; - }; - - - my $popularity_rank = tuwf->dbVali( - 'SELECT COUNT(*)+1 FROM vn WHERE NOT hidden AND c_popularity >', - \($vn->{c_popularity}||0) - ); - my $rating_rank = tuwf->dbVali( - 'SELECT COUNT(*)+1 FROM vn WHERE NOT hidden AND c_rating >', - \($vn->{c_rating}||0) - ); - - my $Popularity = sub { - H4 'Ranking'; - Dl class => 'stats__ranking', sub { - Dt 'Popularity'; - Dd sprintf 'ranked #%d with a score of %.2f', $popularity_rank, 100*($vn->{c_popularity}||0); - Dt 'Bayesian rating'; - Dd sprintf 'ranked #%d with a rating of %.2f', $rating_rank, $vn->{c_rating}/10; - }; - Div class => 'final-text', sub { - A href => '/v/all', 'See best rated games'; - }; - }; - - - Div class => 'section stats', id => 'stats', sub { - H2 class => 'section__title', 'Stats'; - Div class => 'row semi-muted', sub { - Div class => 'stats__col col-md col-md-1', sub { - H4 'Vote distribution'; - $Dist->(); - }; - Div class => 'stats__col col-md col-md-1', $Recent if @$recent_votes; - Div class => 'stats__col col-md col-md-1', $Popularity; - }; - }; -} - - -sub Contents { - my $vn = shift; - - Div class => 'vn-page', sub { - Div class => 'row', sub { - Div class => 'col-md', sub { - Div class => 'row', sub { - Div class => 'fixed-size-left-sidebar-md vn-page__top-details', sub { Sidebar $vn }; - Div class => 'fixed-size-left-sidebar-md', ''; - Div class => 'col-md', sub { - Div class => 'description serif', id => 'about', sub { - P sub { Lit bb2html $vn->{desc}||'No description.' }; - }; - Div class => 'section', id => 'tags', sub { - Div class => 'tag-summary', sub { Tags $vn }; - }; - Div class => 'section', id => 'releases', sub { - H2 class => 'section__title', 'Releases'; - Div class => 'relsm', sub { Releases $vn }; - }; - Staff $vn; - Gallery $vn; - }; - }; - }; - }; - Div class => 'row', sub { - Div class => 'col-xxl', sub { - Characters $vn; - Stats $vn; - }; - }; - }; -} - - -TUWF::get qr{/$VREV_RE}, sub { - my $vn = entry v => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound; - return tuwf->resNotFound if !$vn->{id} || $vn->{hidden}; - - enrich id => q{SELECT id, rgraph, c_languages::text[], c_popularity, c_rating, c_votecount FROM vn WHERE id IN}, $vn; - enrich scr => q{SELECT id AS scr, width, height FROM screenshots WHERE id IN}, $vn->{screenshots}; - enrich vid => q{SELECT id AS vid, title, original FROM vn WHERE id IN}, $vn->{relations}; - enrich aid => q{SELECT aid, id, name, original FROM staff_alias WHERE aid IN}, $vn->{staff}; - - enrich_list releases => id => vid => sub {sql q{ - SELECT rv.vid, r.id, r.title, r.original, r.type, r.website, r.released, r.notes, - r.minage, r.patch, r.freeware, r.doujin, r.resolution, r.voiced, r.ani_story, r.ani_ero - FROM releases r - JOIN releases_vn rv ON r.id = rv.id - WHERE NOT r.hidden AND rv.vid IN}, $_[0], q{ - ORDER BY r.released - }}, $vn; - - enrich_list1 platforms => id => id => 'SELECT id, platform FROM releases_platforms WHERE id IN', $vn->{releases}; - enrich_list1 lang => id => id => 'SELECT id, lang FROM releases_lang WHERE id IN', $vn->{releases}; - enrich_list media => id => id => 'SELECT id, medium, qty FROM releases_media WHERE id IN', $vn->{releases}; - - Framework - og => { - description => bb2text($vn->{desc}), - $vn->{image} && !$vn->{img_nsfw} ? ( - image => tuwf->imgurl(cv => $vn->{image}) - ) : (($_) = grep !$_->{nsfw}, @{$vn->{screenshots}}) ? ( - image => tuwf->imgurl(st => $_->{scr}) - ) : () - }, - title => $vn->{title}, - top => sub { Top $vn }, - sub { Contents $vn }; -}; - -1; diff --git a/lib/VN3/Validation.pm b/lib/VN3/Validation.pm deleted file mode 100644 index 73bf7d62..00000000 --- a/lib/VN3/Validation.pm +++ /dev/null @@ -1,168 +0,0 @@ -# This module provides additional validations for tuwf->validate(), and exports -# a few convenient form handling/validation functions. -package VN3::Validation; - -use strict; -use warnings; -use TUWF; -use VNDBUtil; -use VNDB::Types; -use VNWeb::Auth; -use VN3::DB; -use VN3::Types; -use JSON::XS; -use Exporter 'import'; -use Time::Local 'timegm'; -use Carp 'croak'; -our @EXPORT = ('form_compile', 'form_changed', 'validate_dbid', 'can_edit'); - - -TUWF::set custom_validations => { - id => { uint => 1, max => 1<<40 }, - page => { uint => 1, min => 1, max => 1000, required => 0, default => 1 }, - username => { regex => qr/^[a-z0-9-]{2,15}$/ }, - password => { length => [ 4, 500 ] }, - editsum => { required => 1, length => [ 2, 5000 ] }, - vn_length => { required => 0, default => 0, uint => 1, enum => \%VN_LENGTH }, - vn_relation => { enum => \%VN_RELATION }, - producer_relation => { enum => \%PRODUCER_RELATION }, - staff_role => { enum => \%CREDIT_TYPE }, - char_role => { enum => \%CHAR_ROLE }, - language => { enum => \%LANGUAGE }, - platform => { enum => \%PLATFORM }, - medium => { enum => \%MEDIUM }, - resolution => { enum => \%RESOLUTION }, - gender => { enum => \%GENDER }, - blood_type => { enum => \%BLOOD_TYPE }, - gtin => { uint => 1, func => sub { $_[0] eq 0 || gtintype($_[0]) } }, - minage => { uint => 1, enum => \%AGE_RATING }, - animated => { uint => 1, enum => \%ANIMATED }, - voiced => { uint => 1, enum => \%VOICED }, - rdate => { uint => 1, func => \&_validate_rdate }, - spoiler => { uint => 1, range => [ 0, 2 ] }, - vnlist_status=>{ enum => \%VNLIST_STATUS }, - # Accepts a user-entered vote string (or '-' or empty) and converts that into a DB vote number (or undef) - vnvote => { regex => qr/^(?:|-|[1-9]|10|[1-9]\.[0-9]|10\.0)$/, required => 0, func => sub { $_[0] = $_[0] eq '-' ? undef : 10*$_[0]; 1 } }, - # Sort an array by the listed hash keys, using string comparison on each key - sort_keys => sub { - my @keys = ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0]; - +{ type => 'array', sort => sub { - for(@keys) { - my $c = defined($_[0]{$_}) cmp defined($_[1]{$_}) || (defined($_[0]{$_}) && $_[0]{$_} cmp $_[1]{$_}); - return $c if $c; - } - 0 - } } - }, - # Sorted and unique array-of-hashes (default order is sort_keys on the sorted keys...) - aoh => sub { +{ type => 'array', unique => 1, sort_keys => [sort keys %{$_[0]}], values => { type => 'hash', keys => $_[0] } } }, -}; - - -sub _validate_rdate { - return 0 if $_[0] ne 0 && $_[0] !~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/; - my($y, $m, $d) = $_[0] eq 0 ? (0,0,0) : ($1, $2, $3); - - # Re-normalize - ($m, $d) = (0, 0) if $y == 0; - $m = 99 if $y == 9999; - $d = 99 if $m == 99; - $_[0] = $y*10000 + $m*100 + $d; - - return 0 if $y && $y != 9999 && ($y < 1980 || $y > 2100); - return 0 if $y && $m != 99 && (!$m || $m > 12); - return 0 if $y && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) }; - return 1; -} - - -# Recursively remove keys from hashes that have a '_when' key that doesn't -# match $when. This is a quick and dirty way to create multiple validation -# schemas from a single schema. For example: -# -# { -# title => { _when => 'input' }, -# name => { }, -# } -# -# If $when is 'input', then this function returns: -# { title => {}, name => {} } -# Otherwise, it returns: -# { name => {} } -sub stripwhen { - my($when, $o) = @_; - return $o if ref $o ne 'HASH'; - +{ map $_ eq '_when' || (ref $o->{$_} eq 'HASH' && defined $o->{$_}{_when} && $o->{$_}{_when} !~ $when) ? () : ($_, stripwhen($when, $o->{$_})), keys %$o } -} - - -# Short-hand to compile a validation schema for a form. Usage: -# -# form_compile $when, { -# title => { _when => 'input' }, -# name => { }, -# .. -# }; -sub form_compile { - tuwf->compile({ type => 'hash', keys => stripwhen @_ }); -} - - -sub eq_deep { - my($a, $b) = @_; - return 0 if ref $a ne ref $b; - return 0 if defined $a != defined $b; - return 1 if !defined $a; - return 1 if !ref $a && $a eq $b; - return 1 if ref $a eq 'ARRAY' && (@$a == @$b && !grep !eq_deep($a->[$_], $b->[$_]), 0..$#$a); - return 1 if ref $a eq 'HASH' && eq_deep([sort keys %$a], [sort keys %$b]) && !grep !eq_deep($a->{$_}, $b->{$_}), keys %$a; - 0 -} - - -# Usage: form_changed $schema, $a, $b -# Returns 1 if there is a difference between the data ($a) and the form input -# ($b), using the normalization defined in $schema. The $schema must validate. -sub form_changed { - my($schema, $a, $b) = @_; - my $na = $schema->validate($a)->data; - my $nb = $schema->validate($b)->data; - - #warn "a=".JSON::XS->new->pretty->canonical->encode($na); - #warn "b=".JSON::XS->new->pretty->canonical->encode($nb); - !eq_deep $na, $nb; -} - - -# Validate identifiers against an SQL query. The query must end with a 'id IN' -# clause, where the @ids array is appended. The query must return exactly 1 -# column, the id of each entry. This function throws an error if an id is -# missing from the query. For example, to test for non-hidden VNs: -# -# validate_dbid 'SELECT id FROM vn WHERE NOT hidden AND id IN', 2,3,5,7,...; -# -# If any of those ids is hidden or not in the database, an error is thrown. -sub validate_dbid { - my($sql, @ids) = @_; - return if !@ids; - $sql = ref $sql eq 'CODE' ? sql $sql->(\@ids) : sql $sql, \@ids; - my %dbids = map +((values %$_)[0],1), @{ tuwf->dbAlli($sql) }; - my @missing = grep !$dbids{$_}, @ids; - croak "Invalid database IDs: ".join(',', @missing) if @missing; -} - - -# Returns whether the current user can edit the given database entry. -sub can_edit { - my($type, $entry) = @_; - - return auth->permUsermod || $entry->{id} == (auth->uid||0) if $type eq 'u'; - return auth->permDbmod if $type eq 'd'; - - die "Can't do authorization test when entry_hidden/entry_locked fields aren't present" - if $entry->{id} && (!exists $entry->{entry_hidden} || !exists $entry->{entry_locked}); - - auth->permDbmod || (auth->permEdit && !($entry->{entry_hidden} || $entry->{entry_locked})); -} - -1; diff --git a/lib/VNDB/DB/ULists.pm b/lib/VNDB/DB/ULists.pm index 6f061e97..4c1d10ae 100644 --- a/lib/VNDB/DB/ULists.pm +++ b/lib/VNDB/DB/ULists.pm @@ -7,9 +7,8 @@ use Exporter 'import'; our @EXPORT = qw| - dbRListGet dbVNListGet dbVNListList dbVNListAdd dbVNListDel dbRListAdd dbRListDel - dbVoteGet dbVoteStats dbVoteAdd dbVoteDel - dbWishListGet dbWishListAdd dbWishListDel + dbRListGet dbRListAdd dbRListDel + dbVoteStats |; @@ -30,121 +29,6 @@ sub dbRListGet { ); } -# Options: uid vid -sub dbVNListGet { - my($self, %o) = @_; - - my %where = ( - 'uid = ?' => $o{uid}, - $o{vid} ? ('vid IN(!l)' => [ ref $o{vid} ? $o{vid} : [$o{vid}] ]) : (), - ); - - return $self->dbAll(q| - SELECT uid, vid, status - FROM vnlists - !W|, - \%where - ); -} - - -# Options: uid char voted page results sort reverse -# sort: title vote -sub dbVNListList { - my($self, %o) = @_; - $o{results} ||= 50; - $o{page} ||= 1; - - my %where = ( - 'vl.uid = ?' => $o{uid}, - defined($o{voted}) ? ('vo.vote !s NULL' => $o{voted} ? 'IS NOT' : 'IS') : (), - defined($o{status})? ('vl.status = ?' => $o{status}) : (), - $o{char} ? ('LOWER(SUBSTR(v.title, 1, 1)) = ?' => $o{char} ) : (), - defined $o{char} && !$o{char} ? ( - '(ASCII(v.title) < 97 OR ASCII(v.title) > 122) AND (ASCII(v.title) < 65 OR ASCII(v.title) > 90)' => 1 ) : (), - ); - - my $order = sprintf { - title => 'v.title %s', - vote => 'vo.vote %s NULLS LAST, v.title ASC', - }->{ $o{sort}||'title' }, $o{reverse} ? 'DESC' : 'ASC'; - - # execute query - my($r, $np) = $self->dbPage(\%o, qq| - SELECT vl.vid, v.title, v.original, vl.status, vl.notes, COALESCE(vo.vote, 0) AS vote - FROM vnlists vl - JOIN vn v ON v.id = vl.vid - LEFT JOIN votes vo ON vo.vid = vl.vid AND vo.uid = vl.uid - !W - ORDER BY !s|, - \%where, $order - ); - - # fetch releases and link to VNs - if(@$r) { - my %vns = map { - $_->{rels}=[]; - $_->{vid}, $_->{rels} - } @$r; - - my $rel = $self->dbAll(q| - SELECT rv.vid, rl.rid, r.title, r.original, r.released, r.type, rl.status - FROM rlists rl - JOIN releases r ON rl.rid = r.id - JOIN releases_vn rv ON rv.id = r.id - WHERE rl.uid = ? - AND rv.vid IN(!l) - ORDER BY r.released ASC|, - $o{uid}, [ keys %vns ] - ); - - if(@$rel) { - my %rel = map { $_->{rid} => [] } @$rel; - push(@{$rel{$_->{id}}}, $_->{lang}) for (@{$self->dbAll(q| - SELECT id, lang - FROM releases_lang - WHERE id IN(!l)|, - [ keys %rel ] - )}); - for(@$rel) { - $_->{languages} = $rel{$_->{rid}}; - push @{$vns{$_->{vid}}}, $_; - } - } - } - - return wantarray ? ($r, $np) : $r; -} - - -# Arguments: uid vid status notes -# vid can be an arrayref only when the rows are already present, in which case an update is done -# status and notes can be undef when an update is done, in which case these fields aren't updated -sub dbVNListAdd { - my($self, $uid, $vid, $stat, $notes) = @_; - $self->dbExec( - 'UPDATE vnlists !H WHERE uid = ? AND vid IN(!l)', - {defined($stat) ? ('status = ?' => $stat ):(), - defined($notes)? ('notes = ?' => $notes):()}, - $uid, ref($vid) ? $vid : [ $vid ] - ) - || - $self->dbExec( - 'INSERT INTO vnlists (uid, vid, status, notes) VALUES(?, ?, ?, ?)', - $uid, $vid, $stat||0, $notes||'' - ); -} - - -# Arguments: uid, vid -sub dbVNListDel { - my($self, $uid, $vid) = @_; - $self->dbExec( - 'DELETE FROM vnlists WHERE uid = ? AND vid IN(!l)', - $uid, ref($vid) ? $vid : [ $vid ] - ); -} - # Arguments: uid rid status # rid can be an arrayref only when the rows are already present, in which case an update is done @@ -172,180 +56,22 @@ sub dbRListDel { } -# Options: uid vid hide_ign results page what sort reverse -# what: user, vn, hide_list -sub dbVoteGet { - my($self, %o) = @_; - $o{results} ||= 50; - $o{page} ||= 1; - $o{what} ||= ''; - $o{sort} ||= 'date'; - $o{reverse} //= 1; - - my %where = ( - $o{uid} ? ( 'n.uid = ?' => $o{uid} ) : (), - $o{vid} ? ( 'n.vid = ?' => $o{vid} ) : (), - $o{hide_ign} ? ( '(NOT u.ign_votes OR u.id = ?)' => $self->authInfo->{id}||0 ) : (), - $o{vn_char} ? ( 'LOWER(SUBSTR(v.title, 1, 1)) = ?' => $o{vn_char} ) : (), - defined $o{vn_char} && !$o{vn_char} ? ( - '(ASCII(v.title) < 97 OR ASCII(v.title) > 122) AND (ASCII(v.title) < 65 OR ASCII(v.title) > 90)' => 1 ) : (), - ); - - my @select = ( - qw|n.vid n.vote n.uid|, q|extract('epoch' from n.date) as date|, - $o{what} =~ /user/ ? (VNWeb::DB::sql_user()) : (), - $o{what} =~ /vn/ ? (qw|v.title v.original|) : (), - $o{what} =~ /hide_list/ ? ('u.hide_list') : (), - ); - - my @join = ( - $o{what} =~ /vn/ ? ( - 'JOIN vn v ON v.id = n.vid', - ) : (), - $o{what} =~ /user/ || $o{hide} || $o{what} =~ /hide_list/ ? ( - 'JOIN users u ON u.id = n.uid' - ) : (), - ); - - my $order = sprintf { - date => 'n.date %s', - # Hidden users should not be sorted among the rest. as that would still give them away - username => $o{what} =~ /hide_list/ ? '(CASE WHEN u.hide_list THEN NULL ELSE u.username END) %s, n.date' : 'u.username %s', - title => 'v.title %s', - vote => 'n.vote %s'.($o{what} =~ /vn/ ? ', v.title ASC' : $o{what} =~ /user/ ? ', u.username ASC' : ''), - }->{$o{sort}}, $o{reverse} ? 'DESC' : 'ASC'; - - my($r, $np) = $self->dbPage(\%o, q| - SELECT !s - FROM votes n - !s - !W - ORDER BY !s|, - join(',', @select), join(' ', @join), \%where, $order - ); - - return wantarray ? ($r, $np) : $r; -} - - -# Arguments: (uid|vid), id, use_ignore_list +# Arguments: 'vid', id # Returns an arrayref with 10 elements containing the [ count(vote), sum(vote) ] # for votes in the range of ($index+0.5) .. ($index+1.4) sub dbVoteStats { my($self, $col, $id, $ign) = @_; - my $u = $self->authInfo->{id}; my $r = [ map [0,0], 0..9 ]; $r->[$_->{idx}] = [ $_->{votes}, $_->{total} ] for (@{$self->dbAll(q| - SELECT (vote::numeric/10)::int-1 AS idx, COUNT(vote) as votes, SUM(vote) AS total - FROM votes - !s - !W - GROUP BY (vote::numeric/10)::int|, - $ign ? 'JOIN users ON id = uid AND (NOT ign_votes'.($u?sprintf(' OR id = %d',$u):'').')' : '', - $col ? { '!s = ?' => [ $col, $id ] } : {}, + SELECT (vote::numeric/10)::int-1 AS idx, COUNT(vote) as votes, SUM(vote) AS total + FROM ulist_vns uv + WHERE uv.vote IS NOT NULL AND NOT EXISTS(SELECT 1 FROM users u WHERE u.id = uv.uid AND u.ign_votes) + AND uv.vid = ? + GROUP BY (vote::numeric/10)::int|, + $id )}); return $r; } - -# Adds a new vote or updates an existing one -# Arguments: vid, uid, vote -# vid can be an arrayref only when the rows are already present, in which case an update is done -sub dbVoteAdd { - my($self, $vid, $uid, $vote) = @_; - $self->dbExec(q| - UPDATE votes - SET vote = ? - WHERE vid IN(!l) - AND uid = ?|, - $vote, ref($vid) ? $vid : [$vid], $uid - ) || $self->dbExec(q| - INSERT INTO votes - (vid, uid, vote) - VALUES (!l)|, - [ $vid, $uid, $vote ] - ); -} - - -# Arguments: uid, vid -# vid can be an arrayref -sub dbVoteDel { - my($self, $uid, $vid) = @_; - $self->dbExec('DELETE FROM votes !W', - { 'vid IN(!l)' => [ref($vid)?$vid:[$vid]], 'uid = ?' => $uid } - ); -} - - -# %options->{ uid vid wstat what page results sort reverse } -# what: vn -# sort: title added wstat -sub dbWishListGet { - my($self, %o) = @_; - - $o{page} ||= 1; - $o{results} ||= 50; - $o{what} ||= ''; - - my %where = ( - 'wl.uid = ?' => $o{uid}, - $o{vid} ? ( 'wl.vid = ?' => $o{vid} ) : (), - defined $o{wstat} ? ( 'wl.wstat = ?' => $o{wstat} ) : (), - ); - - my $select = q|wl.vid, wl.wstat, extract('epoch' from wl.added) AS added|; - my @join; - if($o{what} =~ /vn/) { - $select .= ', v.title, v.original'; - push @join, 'JOIN vn v ON v.id = wl.vid'; - } - - no if $] >= 5.022, warnings => 'redundant'; - my $order = sprintf { - title => 'v.title %s', - added => 'wl.added %s', - wstat => 'wl.wstat %2$s, v.title ASC', - }->{ $o{sort}||'added' }, $o{reverse} ? 'DESC' : 'ASC', $o{reverse} ? 'ASC' : 'DESC'; - - my($r, $np) = $self->dbPage(\%o, q| - SELECT !s - FROM wlists wl - !s - !W - ORDER BY !s|, - $select, join(' ', @join), \%where, $order, - ); - - return wantarray ? ($r, $np) : $r; -} - - -# Updates or adds a whishlist item -# Arguments: vid, uid, wstat -sub dbWishListAdd { - my($self, $vid, $uid, $wstat) = @_; - $self->dbExec( - 'UPDATE wlists SET wstat = ? WHERE uid = ? AND vid IN(!l)', - $wstat, $uid, ref($vid) eq 'ARRAY' ? $vid : [ $vid ] - ) - || - $self->dbExec( - 'INSERT INTO wlists (uid, vid, wstat) VALUES(!l)', - [ $uid, $vid, $wstat ] - ); -} - - -# Arguments: uid, vids -sub dbWishListDel { - my($self, $uid, $vid) = @_; - $self->dbExec( - 'DELETE FROM wlists WHERE uid = ? AND vid IN(!l)', - $uid, ref($vid) eq 'ARRAY' ? $vid : [ $vid ] - ); -} - - 1; diff --git a/lib/VNDB/DB/VN.pm b/lib/VNDB/DB/VN.pm index c3ec2cc2..d099b6ff 100644 --- a/lib/VNDB/DB/VN.pm +++ b/lib/VNDB/DB/VN.pm @@ -14,8 +14,8 @@ our @EXPORT = qw|dbVNGet dbVNGetRev dbVNRevisionInsert dbVNImageId dbScreenshotA # 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 wishlist vnlist -# Note: wishlist and vnlist are ignored (no db search) unless a user is logged in +# What: extended anime staff seiyuu relations screenshots relgraph 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 { my($self, %o) = @_; @@ -65,13 +65,13 @@ sub dbVNGet { $o{staff_inc} ? ( 'v.id IN(SELECT ivs.id FROM vn_staff ivs JOIN staff_alias isa ON isa.aid = ivs.aid WHERE isa.id IN(!l))' => [ ref $o{staff_inc} ? $o{staff_inc} : [$o{staff_inc}] ] ) : (), $o{staff_exc} ? ( 'v.id NOT IN(SELECT ivs.id FROM vn_staff ivs JOIN staff_alias isa ON isa.aid = ivs.aid WHERE isa.id IN(!l))' => [ ref $o{staff_exc} ? $o{staff_exc} : [$o{staff_exc}] ] ) : (), $uid && $o{ul_notblack} ? ( - 'v.id NOT IN(SELECT vid FROM wlists WHERE uid = ? AND wstat = 3)' => $uid ) : (), + 'v.id NOT IN(SELECT vid FROM ulist_vns_labels WHERE uid = ? AND lbl = 6)' => $uid ) : (), $uid && defined $o{ul_onwish} ? ( - 'v.id !s IN(SELECT vid FROM wlists WHERE uid = ?)' => [ $o{ul_onwish} ? '' : 'NOT', $uid ] ) : (), + 'v.id !s IN(SELECT vid FROM ulist_vns_labels WHERE uid = ? AND lbl = 5)' => [ $o{ul_onwish} ? '' : 'NOT', $uid ] ) : (), $uid && defined $o{ul_voted} ? ( - 'v.id !s IN(SELECT vid FROM votes WHERE uid = ?)' => [ $o{ul_voted} ? '' : 'NOT', $uid ] ) : (), + 'v.id !s IN(SELECT vid FROM ulist_vns_labels WHERE uid = ? AND lbl = 7)' => [ $o{ul_voted} ? '' : 'NOT', $uid ] ) : (), $uid && defined $o{ul_onlist} ? ( - 'v.id !s IN(SELECT vid FROM vnlists WHERE uid = ?)' => [ $o{ul_onlist} ? '' : 'NOT', $uid ] ) : (), + 'v.id !s IN(SELECT vid FROM ulist_vns WHERE uid = ?)' => [ $o{ul_onlist} ? '' : 'NOT', $uid ] ) : (), !$o{id} && !$o{inc_hidden} ? ( 'v.hidden = FALSE' => 0 ) : (), # optimize fetching random entries (only when there are no other filters present, otherwise this won't work well) @@ -97,8 +97,6 @@ sub dbVNGet { my @join = ( $o{what} =~ /relgraph/ ? 'JOIN relgraphs vg ON vg.id = v.rgraph' : (), - $uid && $o{what} =~ /wishlist/ ? - 'LEFT JOIN wlists wl ON wl.vid = v.id AND wl.uid = ' . $uid : (), $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 @@ -120,7 +118,6 @@ sub dbVNGet { '(SELECT COUNT(*)+1 FROM vn iv WHERE iv.hidden = false AND iv.c_popularity > COALESCE(v.c_popularity, 0.0)) AS p_ranking', '(SELECT COUNT(*)+1 FROM vn iv WHERE iv.hidden = false AND iv.c_rating > COALESCE(v.c_rating, 0.0)) AS r_ranking', ) : (), - $uid && $o{what} =~ /wishlist/ ? 'wl.wstat' : (), $uid && $o{what} =~ /vnlist/ ? (qw|vnlist.userlist_all vnlist.userlist_obtained|) : (), # TODO: optimize this, as it will be very slow when the selected tags match a lot of VNs (>1000) $tag_ids ? @@ -258,6 +255,14 @@ sub _enrich { } } + VNWeb::DB::enrich_flatten(vnlist_labels => id => vid => sub { VNWeb::DB::sql(' + SELECT uvl.vid, ul.label + FROM ulist_vns_labels uvl + JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl + WHERE uvl.uid =', \$self->authInfo->{id}, 'AND uvl.vid IN', $_[0], ' + ORDER BY CASE WHEN ul.id < 10 THEN ul.id ELSE 10 END, ul.label' + )}, $r) if $what =~ /vnlist/ && $self->authInfo->{id}; + return wantarray ? ($r, $np) : $r; } diff --git a/lib/VNDB/Handler/ULists.pm b/lib/VNDB/Handler/ULists.pm index e42a41c0..03c079b1 100644 --- a/lib/VNDB/Handler/ULists.pm +++ b/lib/VNDB/Handler/ULists.pm @@ -3,83 +3,17 @@ package VNDB::Handler::ULists; use strict; use warnings; -use TUWF ':html', ':xml'; +use TUWF ':xml'; use VNDB::Func; use VNDB::Types; TUWF::register( - qr{v([1-9]\d*)/vote}, \&vnvote, - qr{v([1-9]\d*)/wish}, \&vnwish, - qr{v([1-9]\d*)/list}, \&vnlist_e, qr{r([1-9]\d*)/list}, \&rlist_e, qr{xml/rlist.xml}, \&rlist_e, - qr{([uv])([1-9]\d*)/votes}, \&votelist, - qr{u([1-9]\d*)/wish}, \&wishlist, - qr{u([1-9]\d*)/list}, \&vnlist, ); -sub vnvote { - my($self, $id) = @_; - - my $uid = $self->authInfo->{id}; - return $self->htmlDenied() if !$uid; - - return if !$self->authCheckCode; - my $f = $self->formValidate( - { get => 'v', regex => qr/^(-1|([1-9]|10)(\.[0-9])?)$/ }, - { get => 'ref', required => 0, default => "/v$id" } - ); - return $self->resNotFound if $f->{_err} || ($f->{v} != -1 && ($f->{v} > 10 || $f->{v} < 1)); - - $self->dbVoteDel($uid, $id) if $f->{v} == -1; - $self->dbVoteAdd($id, $uid, $f->{v}*10) if $f->{v} > 0; - - $self->resRedirect($f->{ref}, 'temp'); -} - - -sub vnwish { - my($self, $id) = @_; - - my $uid = $self->authInfo->{id}; - return $self->htmlDenied() if !$uid; - - return if !$self->authCheckCode; - my $f = $self->formValidate( - { get => 's', enum => [ -1, keys %WISHLIST_STATUS ] }, - { get => 'ref', required => 0, default => "/v$id" } - ); - return $self->resNotFound if $f->{_err}; - - $self->dbWishListDel($uid, $id) if $f->{s} == -1; - $self->dbWishListAdd($id, $uid, $f->{s}) if $f->{s} != -1; - - $self->resRedirect($f->{ref}, 'temp'); -} - - -sub vnlist_e { - my($self, $id) = @_; - - my $uid = $self->authInfo->{id}; - return $self->htmlDenied() if !$uid; - - return if !$self->authCheckCode; - my $f = $self->formValidate( - { get => 'e', enum => [ -1, keys %VNLIST_STATUS ] }, - { get => 'ref', required => 0, default => "/v$id" } - ); - return $self->resNotFound if $f->{_err}; - - $self->dbVNListDel($uid, $id) if $f->{e} == -1; - $self->dbVNListAdd($uid, $id, $f->{e}) if $f->{e} != -1; - - $self->resRedirect($f->{ref}, 'temp'); -} - - sub rlist_e { my($self, $id) = @_; @@ -113,419 +47,5 @@ sub rlist_e { } } - -sub votelist { - my($self, $type, $id) = @_; - - my $obj = $type eq 'v' ? $self->dbVNGet(id => $id)->[0] : $self->dbUserGet(uid => $id, what => 'hide_list')->[0]; - return $self->resNotFound if !$obj->{id}; - - my $own = $type eq 'u' && $self->authInfo->{id} && $self->authInfo->{id} == $id; - return $self->resNotFound if $type eq 'u' && !$own && !(!$obj->{hide_list} || $self->authCan('usermod')); - - my $f = $self->formValidate( - { get => 'p', required => 0, default => 1, template => 'page' }, - { get => 'o', required => 0, default => 'd', enum => ['a', 'd'] }, - { get => 's', required => 0, default => 'date', enum => [qw|date title vote|] }, - { get => 'c', required => 0, default => 'all', enum => [ 'all', 'a'..'z', 0 ] }, - ); - return $self->resNotFound if $f->{_err}; - - if($own && $self->reqMethod eq 'POST') { - return if !$self->authCheckCode; - my $frm = $self->formValidate( - { post => 'vid', required => 1, multi => 1, template => 'id' }, - { post => 'batchvotes', required => 1, regex => qr/^(-1|([1-9]|10)(\.[0-9])?)$/ }, - ); - my @vid = grep $_ && $_ > 0, @{$frm->{vid}}; - if(!$frm->{_err} && @vid && $frm->{batchvotes} > -2) { - $self->dbVoteDel($id, \@vid) if $frm->{batchvotes} == -1; - $self->dbVoteAdd(\@vid, $id, $frm->{batchvotes}*10) if $frm->{batchvotes} > 0; - } - } - - my($list, $np) = $self->dbVoteGet( - $type.'id' => $id, - what => $type eq 'v' ? 'user hide_list' : 'vn', - hide_ign => $type eq 'v', - sort => $f->{s} eq 'title' && $type eq 'v' ? 'username' : $f->{s}, - reverse => $f->{o} eq 'd', - results => 50, - page => $f->{p}, - $type eq 'u' && $f->{c} ne 'all' ? (vn_char => $f->{c}) : (), - ); - - my $title = $type eq 'v' ? "Votes for $obj->{title}" : 'Votes by '.VNWeb::HTML::user_displayname($obj); - $self->htmlHeader(noindex => 1, type => $type, dbobj => $obj, title => $title); - $self->htmlMainTabs($type => $obj, 'votes'); - div class => 'mainbox'; - h1 $title; - if($type eq 'u') { - p class => 'browseopts'; - for ('all', 'a'..'z', 0) { - a href => "/$type$id/votes?c=$_", $_ eq $f->{c} ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#'; - } - end; - } - p 'No votes to list. :-(' if !@$list; - end; - - if($own) { - my $code = $self->authGetCode("/u$id/votes"); - form action => "/u$id/votes?formcode=$code;c=$f->{c};s=$f->{s};p=$f->{p}", method => 'post'; - } - - @$list && $self->htmlBrowse( - class => 'votelist', - items => $list, - options => $f, - nextpage => $np, - pageurl => "/$type$id/votes?c=$f->{c};o=$f->{o};s=$f->{s}", - sorturl => "/$type$id/votes?c=$f->{c}", - header => [ - [ 'Cast', 'date' ], - [ 'Vote', 'vote' ], - [ $type eq 'v' ? 'User' : 'Visual novel', 'title' ], - ], - row => sub { - my($s, $n, $l) = @_; - Tr; - td class => 'tc1'; - input type => 'checkbox', name => 'vid', value => $l->{vid} if $own; - txt ' '.fmtdate $l->{date}; - end; - td class => 'tc2', fmtvote $l->{vote}; - td class => 'tc3'; - if($type eq 'u') { - a href => "/v$l->{vid}", title => $l->{original}||$l->{title}, shorten $l->{title}, 100; - } elsif($l->{hide_list}) { - b class => 'grayedout', 'hidden'; - } else { - VNWeb::HTML::user_($l); - } - end; - end; - }, - $own ? (footer => sub { - Tr; - td colspan => 3, class => 'tc1'; - input type => 'checkbox', class => 'checkall', name => 'vid', value => 0; - txt ' '; - Select name => 'batchvotes', id => 'batchvotes'; - option value => -2, '-- with selected --'; - optgroup label => 'Change vote'; - option value => $_, sprintf '%d (%s)', $_, fmtrating $_ for (reverse 1..10); - option value => -3, 'Other'; - end; - option value => -1, 'revoke'; - end; - end; - end 'tr'; - }) : (), - ); - end if $own; - $self->htmlFooter; -} - - -sub wishlist { - my($self, $uid) = @_; - - my $own = $self->authInfo->{id} && $self->authInfo->{id} == $uid; - my $u = $self->dbUserGet(uid => $uid, what => 'hide_list')->[0]; - return $self->resNotFound if !$u || !$own && !(!$u->{hide_list} || $self->authCan('usermod')); - - my $f = $self->formValidate( - { get => 'p', required => 0, default => 1, template => 'page' }, - { get => 'o', required => 0, default => 'd', enum => [ 'a', 'd' ] }, - { get => 's', required => 0, default => 'wstat', enum => [qw|title added wstat|] }, - { get => 'f', required => 0, default => -1, enum => [ -1, keys %WISHLIST_STATUS ] }, - ); - return $self->resNotFound if $f->{_err}; - - if($own && $self->reqMethod eq 'POST') { - return if !$self->authCheckCode; - my $frm = $self->formValidate( - { post => 'sel', required => 0, default => 0, multi => 1, template => 'id' }, - { post => 'batchedit', required => 1, enum => [ -1, keys %WISHLIST_STATUS ] }, - ); - $frm->{sel} = [ grep $_, @{$frm->{sel}} ]; # weed out "select all" checkbox - if(!$frm->{_err} && @{$frm->{sel}} && $frm->{sel}[0]) { - $self->dbWishListDel($uid, $frm->{sel}) if $frm->{batchedit} == -1; - $self->dbWishListAdd($frm->{sel}, $uid, $frm->{batchedit}) if $frm->{batchedit} >= 0; - } - } - - my($list, $np) = $self->dbWishListGet( - uid => $uid, - sort => $f->{s}, reverse => $f->{o} eq 'd', - $f->{f} != -1 ? (wstat => $f->{f}) : (), - what => 'vn', - results => 50, - page => $f->{p}, - ); - - my $title = $own ? 'My wishlist' : VNWeb::HTML::user_displayname($u)."'s wishlist"; - $self->htmlHeader(title => $title, noindex => 1, type => 'u', dbobj => $u); - $self->htmlMainTabs('u', $u, 'wish'); - div class => 'mainbox'; - h1 $title; - if(!@$list && $f->{f} == -1) { - p 'Wishlist empty...'; - end; - return $self->htmlFooter; - } - p class => 'browseopts'; - a $f->{f} == $_ ? (class => 'optselected') : (), href => "/u$uid/wish?f=$_", - $_ == -1 ? 'All priorities' : $WISHLIST_STATUS{$_} - for (-1, keys %WISHLIST_STATUS); - end; - end 'div'; - - if($own) { - my $code = $self->authGetCode("/u$uid/wish"); - form action => "/u$uid/wish?formcode=$code;f=$f->{f};o=$f->{o};s=$f->{s};p=$f->{p}", method => 'post'; - } - - $self->htmlBrowse( - class => 'wishlist', - items => $list, - nextpage => $np, - options => $f, - pageurl => "/u$uid/wish?f=$f->{f};o=$f->{o};s=$f->{s}", - sorturl => "/u$uid/wish?f=$f->{f}", - header => [ - [ 'Title' => 'title' ], - [ 'Priority' => 'wstat' ], - [ 'Added' => 'added' ], - ], - row => sub { - my($s, $n, $i) = @_; - Tr; - td class => 'tc1'; - input type => 'checkbox', name => 'sel', value => $i->{vid} - if $own; - a href => "/v$i->{vid}", title => $i->{original}||$i->{title}, ' '.shorten $i->{title}, 70; - end; - td class => 'tc2', $WISHLIST_STATUS{$i->{wstat}}; - td class => 'tc3', fmtdate $i->{added}, 'compact'; - end; - }, - $own ? (footer => sub { - Tr; - td colspan => 3; - input type => 'checkbox', class => 'checkall', name => 'sel', value => 0; - txt ' '; - Select name => 'batchedit', id => 'batchedit'; - option '-- with selected --'; - optgroup label => 'Change priority'; - option value => $_, $WISHLIST_STATUS{$_} - for (keys %WISHLIST_STATUS); - end; - option value => -1, 'remove from wishlist'; - end; - end; - end; - }) : (), - ); - end 'form' if $own; - $self->htmlFooter; -} - - -sub vnlist { - my($self, $uid) = @_; - - my $own = $self->authInfo->{id} && $self->authInfo->{id} == $uid; - my $u = $self->dbUserGet(uid => $uid, what => 'hide_list')->[0]; - return $self->resNotFound if !$u || !$own && !(!$u->{hide_list} || $self->authCan('usermod')); - - my $f = $self->formValidate( - { get => 'p', required => 0, default => 1, template => 'page' }, - { get => 'o', required => 0, default => 'a', enum => [ 'a', 'd' ] }, - { get => 's', required => 0, default => 'title', enum => [ 'title', 'vote' ] }, - { get => 'c', required => 0, default => 'all', enum => [ 'all', 'a'..'z', 0 ] }, - { get => 'v', required => 0, default => 0, enum => [ -1..1 ] }, - { get => 't', required => 0, default => -1, enum => [ -1, keys %VNLIST_STATUS ] }, - ); - return $self->resNotFound if $f->{_err}; - - if($own && $self->reqMethod eq 'POST') { - return if !$self->authCheckCode; - my $frm = $self->formValidate( - { post => 'vid', required => 0, default => 0, multi => 1, template => 'id' }, - { post => 'rid', required => 0, default => 0, multi => 1, template => 'id' }, - { post => 'not', required => 0, default => '', maxlength => 2000 }, - { post => 'vns', required => 1, enum => [ -2, -1, keys %VNLIST_STATUS, 999 ] }, - { post => 'rel', required => 1, enum => [ -2, -1, keys %RLIST_STATUS ] }, - ); - my @vid = grep $_ > 0, @{$frm->{vid}}; - my @rid = grep $_ > 0, @{$frm->{rid}}; - if(!$frm->{_err} && @vid && $frm->{vns} > -2) { - $self->dbVNListDel($uid, \@vid) if $frm->{vns} == -1; - $self->dbVNListAdd($uid, \@vid, $frm->{vns}) if $frm->{vns} >= 0 && $frm->{vns} < 999; - $self->dbVNListAdd($uid, \@vid, undef, $frm->{not}) if $frm->{vns} == 999; - } - if(!$frm->{_err} && @rid && $frm->{rel} > -2) { - $self->dbRListDel($uid, \@rid) if $frm->{rel} == -1; - $self->dbRListAdd($uid, \@rid, $frm->{rel}) if $frm->{rel} >= 0; - } - } - - my($list, $np) = $self->dbVNListList( - uid => $uid, - results => 50, - page => $f->{p}, - sort => $f->{s}, reverse => $f->{o} eq 'd', - voted => $f->{v} == 0 ? undef : $f->{v} < 0 ? 0 : $f->{v}, - $f->{c} ne 'all' ? (char => $f->{c}) : (), - $f->{t} >= 0 ? (status => $f->{t}) : (), - ); - - my $title = $own ? 'My visual novel list' : VNWeb::HTML::user_displayname($u)."'s visual novel list"; - $self->htmlHeader(title => $title, noindex => 1, type => 'u', dbobj => $u); - $self->htmlMainTabs('u', $u, 'list'); - - # url generator - my $url = sub { - my($n, $v) = @_; - $n ||= ''; - local $_ = "/u$uid/list"; - $_ .= '?c='.($n eq 'c' ? $v : $f->{c}); - $_ .= ';v='.($n eq 'v' ? $v : $f->{v}); - $_ .= ';t='.($n eq 't' ? $v : $f->{t}); - if($n eq 'page') { - $_ .= ';o='.($n eq 'o' ? $v : $f->{o}); - $_ .= ';s='.($n eq 's' ? $v : $f->{s}); - } - return $_; - }; - - div class => 'mainbox'; - h1 $title; - p class => 'browseopts'; - for ('all', 'a'..'z', 0) { - a href => $url->(c => $_), $_ eq $f->{c} ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#'; - } - end; - p class => 'browseopts'; - a href => $url->(v => 0), 0 == $f->{v} ? (class => 'optselected') : (), 'All'; - a href => $url->(v => 1), 1 == $f->{v} ? (class => 'optselected') : (), 'Only voted'; - a href => $url->(v => -1), -1 == $f->{v} ? (class => 'optselected') : (), 'Hide voted'; - end; - p class => 'browseopts'; - a href => $url->(t => -1), -1 == $f->{t} ? (class => 'optselected') : (), 'All'; - a href => $url->(t => $_), $_ == $f->{t} ? (class => 'optselected') : (), $VNLIST_STATUS{$_} for keys %VNLIST_STATUS; - end; - end 'div'; - - _vnlist_browse($self, $own, $list, $np, $f, $url, $uid); - $self->htmlFooter; -} - -sub _vnlist_browse { - my($self, $own, $list, $np, $f, $url, $uid) = @_; - - if($own) { - form action => $url->(), method => 'post'; - input type => 'hidden', class => 'hidden', name => 'not', id => 'not', value => ''; - input type => 'hidden', class => 'hidden', name => 'formcode', id => 'formcode', value => $self->authGetCode("/u$uid/list"); - } - - $self->htmlBrowse( - class => 'rlist', - items => $list, - nextpage => $np, - options => $f, - sorturl => $url->(), - pageurl => $url->('page'), - header => [ - [ '' ], - sub { td class => 'tc2', id => 'expandall'; lit '▸'; end; }, - [ 'Title' => 'title' ], - [ '' ], [ '' ], - [ 'Status' ], - [ 'Releases*' ], - [ 'Vote' => 'vote' ], - ], - row => sub { - my($s, $n, $i) = @_; - Tr class => 'nostripe'.($n%2 ? ' odd' : ''); - td class => 'tc1'; input type => 'checkbox', name => 'vid', value => $i->{vid} if $own; end; - if(@{$i->{rels}}) { - td class => 'tc2 collapse_but', id => "vid$i->{vid}"; lit '▸'; end; - } else { - td class => 'tc2', ''; - } - td class => 'tc3_5', colspan => 3; - a href => "/v$i->{vid}", title => $i->{original}||$i->{title}, shorten $i->{title}, 70; - b class => 'grayedout', $i->{notes} if $i->{notes}; - end; - td class => 'tc6', $i->{status} ? $VNLIST_STATUS{$i->{status}} : ''; - td class => 'tc7'; - my $obtained = grep $_->{status}==2, @{$i->{rels}}; - my $total = scalar @{$i->{rels}}; - my $txt = sprintf '%d/%d', $obtained, $total; - $txt = qq|<b class="done">$txt</b>| if $total && $obtained == $total; - $txt = qq|<b class="todo">$txt</b>| if $obtained < $total; - lit $txt; - end; - td class => 'tc8', fmtvote $i->{vote}; - end 'tr'; - - for (@{$i->{rels}}) { - Tr class => "nostripe collapse relhid collapse_vid$i->{vid}".($n%2 ? ' odd':''); - td class => 'tc1', ''; - td class => 'tc2'; - input type => 'checkbox', name => 'rid', value => $_->{rid} if $own; - end; - td class => 'tc3'; - lit fmtdatestr $_->{released}; - end; - td class => 'tc4'; - cssicon "lang $_", $LANGUAGE{$_} for @{$_->{languages}}; - cssicon "rt$_->{type}", $_->{type}; - end; - td class => 'tc5'; - a href => "/r$_->{rid}", title => $_->{original}||$_->{title}, shorten $_->{title}, 50; - end; - td class => 'tc6', $_->{status} ? $RLIST_STATUS{$_->{status}} : ''; - td class => 'tc7_8', colspan => 2, ''; - end 'tr'; - } - }, - - $own ? (footer => sub { - Tr; - td class => 'tc1'; input type => 'checkbox', name => 'vid', value => 0, class => 'checkall'; end; - td class => 'tc2'; input type => 'checkbox', name => 'rid', value => 0, class => 'checkall'; end; - td class => 'tc3_6', colspan => 4; - Select id => 'vns', name => 'vns'; - option value => -2, '-- with selected VNs --'; - optgroup label => 'Change status'; - option value => $_, $VNLIST_STATUS{$_} - for (keys %VNLIST_STATUS); - end; - option value => 999, 'Set note'; - option value => -1, 'remove from list'; - end; - Select id => 'rel', name => 'rel'; - option value => -2, '-- with selected releases --'; - optgroup label => 'Change status'; - option value => $_, $RLIST_STATUS{$_} - for (keys %RLIST_STATUS); - end; - option value => -1, 'remove from list'; - end; - input type => 'submit', value => 'Update'; - end; - td class => 'tc7_8', colspan => 2, '* Obtained/total'; - end 'tr'; - }) : (), - ); - - end 'form' if $own; -} - 1; diff --git a/lib/VNDB/Handler/VNBrowse.pm b/lib/VNDB/Handler/VNBrowse.pm index b3ec9dc6..64cc57d4 100644 --- a/lib/VNDB/Handler/VNBrowse.pm +++ b/lib/VNDB/Handler/VNBrowse.pm @@ -26,7 +26,6 @@ sub list { { get => 'rfil', required => 0, default => '' }, { get => 'cfil', required => 0, default => '' }, { get => 'vnlist', required => 0, default => 2, enum => [ '0', '1' ] }, # 2: use pref - { get => 'wish', required => 0, default => 2, enum => [ '0', '1' ] }, # 2: use pref ); return $self->resNotFound if $f->{_err}; $f->{q} ||= $f->{sq}; @@ -45,7 +44,6 @@ sub list { }; $f->{vnlist} = $read_write_pref->('vnlist', 'vn_list_own'); - $f->{wish} = $read_write_pref->('wish', 'vn_list_wish'); return $self->resRedirect('/'.$1.$2.(!$3 ? '' : $1 eq 'd' ? '#'.$3 : '.'.$3), 'temp') if $f->{q} && $f->{q} =~ /^([gvrptudcis])([0-9]+)(?:\.([0-9]+))?$/; @@ -64,9 +62,7 @@ sub list { %compat, tagspoil => $self->authPref('spoilers')||0, }, { - what => ' rating' . - ($f->{vnlist} ? ' vnlist' : ''). - ($f->{wish} ? ' wishlist' : ''), + what => ' rating'.($f->{vnlist} ? ' vnlist' : ''), $char ne 'all' ? ( char => $char ) : (), $f->{q} ? ( search => $f->{q} ) : (), keys %$rfil ? ( release => $rfil ) : (), @@ -103,7 +99,6 @@ sub list { if($uid) { p class => 'browseopts'; a href => $url->($char, 'vnlist'), $f->{vnlist} ? (class => 'optselected') : (), 'User VN list'; - a href => $url->($char, 'wish' ), $f->{wish} ? (class => 'optselected') : (), 'Wishlist'; end 'p'; } diff --git a/lib/VNDB/Handler/VNPage.pm b/lib/VNDB/Handler/VNPage.pm index 87c9244c..3556476c 100644 --- a/lib/VNDB/Handler/VNPage.pm +++ b/lib/VNDB/Handler/VNPage.pm @@ -531,7 +531,7 @@ sub page { _screenshots($self, $v, $r) if @{$v->{screenshots}}; } - $self->htmlFooter; + $self->htmlFooter(v2rwjs => $self->authInfo->{id}); } @@ -715,45 +715,28 @@ sub _useroptions { # Voting option is hidden if nothing has been released yet my $minreleased = min grep $_, map $_->{released}, @$r; - my $canvote = $minreleased && $minreleased < strftime '%Y%m%d', gmtime; - my $vote = $self->dbVoteGet(uid => $self->authInfo->{id}, vid => $v->{id})->[0]; - my $list = $self->dbVNListGet(uid => $self->authInfo->{id}, vid => $v->{id})->[0]; - my $wish = $self->dbWishListGet(uid => $self->authInfo->{id}, vid => $v->{id})->[0]; + my $labels = tuwf->dbAlli( + 'SELECT l.id, l.label, l.private, uvl.vid IS NOT NULL as assigned + FROM ulist_labels l + LEFT JOIN ulist_vns_labels uvl ON uvl.uid = l.uid AND uvl.lbl = l.id AND uvl.vid =', \$v->{id}, ' + WHERE l.uid =', \$self->authInfo->{id}, ' + ORDER BY CASE WHEN l.id < 10 THEN l.id ELSE 10 END, l.label' + ); + my $lst = tuwf->dbRowi('SELECT vid, vote FROM ulist_vns WHERE uid =', \$self->authInfo->{id}, 'AND vid =', \$v->{id}); Tr; td 'User options'; td; - if($vote || ($canvote && !$wish)) { - Select id => 'votesel', name => $self->authGetCode("/v$v->{id}/vote"); - option value => -3, $vote ? 'your vote: '.fmtvote($vote->{vote}) : 'not voted yet'; - optgroup label => $vote ? 'Change vote' : 'Vote'; - option value => $_, "$_ (".fmtrating($_).')' for (reverse 1..10); - option value => -2, 'Other'; - end; - option value => -1, 'revoke' if $vote; - end; - br; - } - - Select id => 'listsel', name => $self->authGetCode("/v$v->{id}/list"); - option $list ? "VN list: $VNLIST_STATUS{$list->{status}}" : 'not on your VN list'; - optgroup label => $list ? 'Change status' : 'Add to VN list'; - option value => $_, $VNLIST_STATUS{$_} for (keys %VNLIST_STATUS); - end; - option value => -1, 'remove from VN list' if $list; - end; - br; - - if(!$vote || $wish) { - Select id => 'wishsel', name => $self->authGetCode("/v$v->{id}/wish"); - option $wish ? "wishlist: $WISHLIST_STATUS{$wish->{wstat}}" : 'not on your wishlist'; - optgroup label => $wish ? 'Change status' : 'Add to wishlist'; - option value => $_, $WISHLIST_STATUS{$_} for (keys %WISHLIST_STATUS); - end; - option value => -1, 'remove from wishlist' if $wish; - end; - } + VNWeb::HTML::elm_('UList.VNPage', undef, { + uid => 1*$self->authInfo->{id}, + vid => 1*$v->{id}, + onlist => $lst->{vid}?\1:\0, + canvote => $minreleased && $minreleased < strftime('%Y%m%d', gmtime) ? \1 : \0, + vote => fmtvote($lst->{vote}).'', + labels => [ map +{ id => 1*$_->{id}, label => $_->{label}, private => $_->{private}?\1:\0 }, @$labels ], + selected => [ map $_->{id}, grep $_->{assigned}, @$labels ], + }); end; end 'tr'; } diff --git a/lib/VNDB/Types.pm b/lib/VNDB/Types.pm index 8e5b26cf..3341343d 100644 --- a/lib/VNDB/Types.pm +++ b/lib/VNDB/Types.pm @@ -267,14 +267,6 @@ hash RELEASE_TYPE => -hash WISHLIST_STATUS => - 0 => 'High', - 1 => 'Medium', - 2 => 'Low', - 3 => 'Blacklist'; - - - # 0 = hardcoded "unknown", 2 = hardcoded 'OK' hash RLIST_STATUS => 0 => 'Unknown', @@ -285,15 +277,6 @@ hash RLIST_STATUS => -hash VNLIST_STATUS => - 0 => 'Unknown', - 1 => 'Playing', - 2 => 'Finished', - 3 => 'Stalled', - 4 => 'Dropped'; - - - # SQL: ENUM board_type hash BOARD_TYPE => an => { txt => 'Announcements', post_perm => 'boardmod', index_rows => 5, dbitem => 0 }, diff --git a/lib/VNDB/Util/BrowseHTML.pm b/lib/VNDB/Util/BrowseHTML.pm index 7846d5c0..1a7e3878 100644 --- a/lib/VNDB/Util/BrowseHTML.pm +++ b/lib/VNDB/Util/BrowseHTML.pm @@ -160,9 +160,10 @@ sub htmlBrowseVN { if($f->{vnlist}) { td class => 'tc7'; lit sprintf '<b class="%s">%d/%d</b>', $l->{userlist_obtained} == $l->{userlist_all} ? 'done' : 'todo', $l->{userlist_obtained}, $l->{userlist_all} if $l->{userlist_all}; + abbr title => join(', ', $l->{vnlist_labels}->@*), scalar $l->{vnlist_labels}->@* if $l->{vnlist_labels} && $l->{vnlist_labels}->@*; + abbr title => 'No labels', ' ' if $l->{vnlist_labels} && !$l->{vnlist_labels}->@*; end 'td'; } - td class => 'tc8', defined($l->{wstat}) ? $WISHLIST_STATUS{$l->{wstat}} : '' if $f->{wish}; td class => 'tc2'; $_ ne 'oth' && cssicon $_, $PLATFORM{$_} for (sort @{$l->{c_platforms}}); diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm index 9472f53d..7a3d554c 100644 --- a/lib/VNDB/Util/CommonHTML.pm +++ b/lib/VNDB/Util/CommonHTML.pm @@ -215,6 +215,7 @@ sub htmlItemMessage { # generates two tables, one with a vote graph, other with recent votes +# Only supports $type eq 'v' now. sub htmlVoteStats { my($self, $type, $obj, $stats) = @_; @@ -244,12 +245,17 @@ sub htmlVoteStats { } end 'table'; - my $recent = $self->dbVoteGet( - $type.'id' => $obj->{id}, - results => 8, - what => $type eq 'v' ? 'user hide_list' : 'vn', - hide_ign => $type eq 'v', + my $recent = $self->dbAlli(' + SELECT uv.vote,', VNWeb::DB::sql_totime('uv.vote_date '), 'as date, ', VNWeb::DB::sql_user(), ' + , NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND NOT ul.private) AS hide_list + FROM ulist_vns uv + JOIN users u ON u.id = uv.uid + WHERE uv.vid =', \$obj->{id}, 'AND uv.vote IS NOT NULL + AND NOT EXISTS(SELECT 1 FROM users u WHERE u.id = uv.uid AND u.ign_votes) + ORDER BY uv.vote_date DESC + LIMIT', \8 ); + if(@$recent) { table class => 'recentvotes stripe'; thead; Tr; @@ -265,9 +271,7 @@ sub htmlVoteStats { for (@$recent) { Tr; td; - if($type eq 'u') { - a href => "/v$_->{vid}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40; - } elsif($_->{hide_list}) { + if($_->{hide_list}) { b class => 'grayedout', 'hidden'; } else { VNWeb::HTML::user_($_); diff --git a/lib/VNDB/Util/LayoutHTML.pm b/lib/VNDB/Util/LayoutHTML.pm index 1b6ce1de..6bafbeda 100644 --- a/lib/VNDB/Util/LayoutHTML.pm +++ b/lib/VNDB/Util/LayoutHTML.pm @@ -11,6 +11,7 @@ our @EXPORT = qw|htmlHeader htmlFooter|; sub htmlHeader { # %options->{ title, noindex, search, feeds, metadata } my($self, %o) = @_; + %VNWeb::HTML::pagevars = (); $o{og} = $o{metadata} ? +{ map +(s/og://r, $o{metadata}{$_}), keys $o{metadata}->%* } : undef; $o{index} = !$o{noindex}; @@ -34,6 +35,7 @@ sub htmlFooter { # %options => { pref_code => 1 } noscript id => 'pref_code', title => $self->authGetCode('/xml/prefs.xml'), '' if $o{pref_code} && $self->authInfo->{id}; script type => 'text/javascript', src => $self->{url_static}.'/f/vndb.js?'.$self->{version}, ''; + VNWeb::HTML::v2rwjs_() if $o{v2rwjs}; end 'body'; end 'html'; } diff --git a/lib/VNWeb/Auth.pm b/lib/VNWeb/Auth.pm index 56367397..35587c8d 100644 --- a/lib/VNWeb/Auth.pm +++ b/lib/VNWeb/Auth.pm @@ -273,7 +273,7 @@ sub csrfcheck { # TODO: Measure global usage of the pref() and prefSet() calls to see if this cache is actually necessary. my @pref_columns = qw/ - email_confirmed skin customcss filter_vn filter_release show_nsfw hide_list notify_dbedit notify_announce + email_confirmed skin customcss filter_vn filter_release show_nsfw notify_dbedit notify_announce vn_list_own vn_list_wish tags_all tags_cont tags_ero tags_tech spoilers traits_sexual nodistract_can nodistract_noads nodistract_nofancy /; diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm index 0492fc7d..1d6731c2 100644 --- a/lib/VNWeb/HTML.pm +++ b/lib/VNWeb/HTML.pm @@ -36,7 +36,7 @@ our @EXPORT = qw/ # Encoded as JSON and appended to the end of the page, to be read by pagevars.js. -my %pagevars; +our %pagevars; # Ugly hack to move rendering down below the float object. @@ -226,9 +226,9 @@ sub _menu_ { h2_ sub { user_ auth->user, 'user_', 1 }; div_ sub { a_ href => "$uid/edit", 'My Profile'; txt_ '⭐' if $support_opt && !auth->pref('nodistract_nofancy'); br_; - a_ href => "$uid/list", 'My Visual Novel List'; br_; - a_ href => "$uid/votes",'My Votes'; br_; - a_ href => "$uid/wish", 'My Wishlist'; br_; + a_ href => "$uid/ulist?vnlist=1", 'My Visual Novel List'; br_; + a_ href => "$uid/ulist?votes=1",'My Votes'; br_; + a_ href => "$uid/ulist?wishlist=1", 'My Wishlist'; br_; a_ href => "$uid/notifies", $nc ? (class => 'notifyget') : (), 'My Notifications'.($nc?" ($nc)":''); br_; a_ href => "$uid/hist", 'My Recent Changes'; br_; a_ href => '/g/links?u='.auth->uid, 'My Tags'; br_; @@ -344,13 +344,10 @@ sub _maintabs_ { t tagmod => "/$id/tagmod", 'modify tags' if $t eq 'v' && auth->permTag && !$o->{entry_hidden}; do { - t list => "/$id/list", 'list'; - t votes => "/$id/votes", 'votes'; - t wish => "/$id/wish", 'wishlist'; - } if $t eq 'u' && ( - auth->permUsermod || (auth && auth->uid == $o->{id}) - || !($o->{hide_list} // tuwf->dbVali('SELECT hide_list FROM users WHERE id =', \$o->{id})) - ); + t list => "/$id/ulist?vnlist=1", 'list'; + t votes => "/$id/ulist?votes=1", 'votes'; + t wish => "/$id/ulist?wishlist=1", 'wishlist'; + } if $t eq 'u'; t posts => "/$id/posts", 'posts' if $t eq 'u'; @@ -409,6 +406,15 @@ sub _hidden_msg_ { } +sub v2rwjs_ { # Also used by VNDB::Util::LayoutHTML. + script_ type => 'application/json', id => 'pagevars', sub { + # Escaping rules for a JSON <script> context are kinda weird, but more efficient than regular xml_escape(). + lit_(JSON::XS->new->canonical->encode(\%pagevars) =~ s{</}{<\\/}rg =~ s/<!--/<\\u0021--/rg); + } if keys %pagevars; + script_ type => 'application/javascript', src => config->{url_static}.'/f/v2rw.js?'.config->{version}, ''; +} + + # Options: # title => $title # index => 1/0, default 0 @@ -438,11 +444,7 @@ sub framework_ { $cont->() unless $o{hiddenmsg} && _hidden_msg_ \%o; div_ id => 'footer', \&_footer_; }; - script_ type => 'application/json', id => 'pagevars', sub { - # Escaping rules for a JSON <script> context are kinda weird, but more efficient than regular xml_escape(). - lit_(JSON::XS->new->canonical->encode(\%pagevars) =~ s{</}{<\\/}rg =~ s/<!--/<\\u0021--/rg); - } if keys %pagevars; - script_ type => 'application/javascript', src => config->{url_static}.'/f/v2rw.js?'.config->{version}, ''; + v2rwjs_; } } } diff --git a/lib/VNWeb/User/Edit.pm b/lib/VNWeb/User/Edit.pm index e34ef0ba..82e08729 100644 --- a/lib/VNWeb/User/Edit.pm +++ b/lib/VNWeb/User/Edit.pm @@ -8,7 +8,6 @@ my $FORM = form_compile in => { email => { email => 1 }, perm => { uint => 1, func => sub { ($_[0] & ~auth->allPerms) == 0 } }, ign_votes => { anybool => 1 }, - hide_list => { anybool => 1 }, show_nsfw => { anybool => 1 }, traits_sexual => { anybool => 1 }, tags_all => { anybool => 1 }, @@ -51,7 +50,7 @@ sub _getmail { TUWF::get qr{/$RE{uid}/edit}, sub { my $u = tuwf->dbRowi(q{ - SELECT id, username, perm, ign_votes, hide_list, show_nsfw, traits_sexual + SELECT id, username, perm, ign_votes, show_nsfw, traits_sexual , tags_all, tags_cont, tags_ero, tags_tech, spoilers, skin, customcss , nodistract_can, nodistract_noads, nodistract_nofancy, support_can, support_enabled, uniname_can, uniname, pubskin_can, pubskin_enabled FROM users WHERE id =}, \tuwf->capture('id') @@ -140,7 +139,7 @@ json_api qr{/u/edit\.json}, $FORM, sub { $data->{skin} = '' if $data->{skin} eq config->{skin_default}; $data->{uniname} = '' if $data->{uniname} eq $data->{username}; tuwf->dbExeci('UPDATE users SET', { %{$data}{qw/ - hide_list show_nsfw traits_sexual tags_all tags_cont tags_ero tags_tech spoilers skin customcss + show_nsfw traits_sexual tags_all tags_cont tags_ero tags_tech spoilers skin customcss nodistract_noads nodistract_nofancy support_enabled uniname pubskin_enabled /} }, 'WHERE id =', \$data->{id} diff --git a/lib/VNWeb/User/List.pm b/lib/VNWeb/User/List.pm index c3694ddc..72da203d 100644 --- a/lib/VNWeb/User/List.pm +++ b/lib/VNWeb/User/List.pm @@ -14,28 +14,33 @@ sub listing_ { thead_ sub { tr_ sub { td_ class => 'tc1', sub { txt_ 'Username'; sortable_ 'username', $opt, \&url }; td_ class => 'tc2', sub { txt_ 'Registered'; sortable_ 'registered', $opt, \&url }; - td_ class => 'tc3', sub { txt_ 'Votes'; sortable_ 'votes', $opt, \&url }; - td_ class => 'tc4', sub { txt_ 'Edits'; sortable_ 'changes', $opt, \&url }; - td_ class => 'tc5', sub { txt_ 'Tags'; sortable_ 'tags', $opt, \&url }; + td_ class => 'tc3', sub { txt_ 'VNs'; sortable_ 'vns', $opt, \&url }; + td_ class => 'tc4', sub { txt_ 'Votes'; sortable_ 'votes', $opt, \&url }; + td_ class => 'tc5', sub { txt_ 'Wishlist'; sortable_ 'wish', $opt, \&url }; + td_ class => 'tc6', sub { txt_ 'Edits'; sortable_ 'changes', $opt, \&url }; + td_ class => 'tc7', sub { txt_ 'Tags'; sortable_ 'tags', $opt, \&url }; } }; tr_ sub { my $l = $_; td_ class => 'tc1', sub { user_ $l }; td_ class => 'tc2', fmtdate $l->{registered}; - td_ mkclass(tc3 => 1, linethrough => $l->{hide_list} && auth->permUsermod), sub { - if($l->{hide_list} && !auth->permUsermod) { - txt_ '-'; - } elsif(!$l->{c_votes}) { - txt_ '0'; - } else { - a_ href => "/u$l->{user_id}/votes", $l->{c_votes}; - } + td_ class => 'tc3', sub { + txt_ '0' if !$l->{c_vns}; + a_ href => "/u$l->{user_id}/ulist?vnlist=1", $l->{c_vns} if $l->{c_vns}; }; td_ class => 'tc4', sub { + txt_ '0' if !$l->{c_votes}; + a_ href => "/u$l->{user_id}/ulist?votes=1", $l->{c_votes} if $l->{c_votes}; + }; + td_ class => 'tc5', sub { + txt_ '0' if !$l->{c_wish}; + a_ href => "/u$l->{user_id}/ulist?wishlist=1", $l->{c_wish} if $l->{c_wish}; + }; + td_ class => 'tc6', sub { txt_ '-' if !$l->{c_changes}; a_ href => "/u$l->{user_id}/hist", $l->{c_changes} if $l->{c_changes}; }; - td_ class => 'tc5', sub { + td_ class => 'tc7', sub { txt_ '-' if !$l->{c_tags}; a_ href => "/g/links?u=$l->{user_id}", $l->{c_tags} if $l->{c_tags}; }; @@ -51,7 +56,7 @@ TUWF::get qr{/u/(?<char>[0a-z]|all)}, sub { my $opt = eval { tuwf->validate(get => p => { upage => 1 }, - s => { required => 0, default => 'registered', enum => [qw[username registered votes changes tags]] }, + s => { required => 0, default => 'registered', enum => [qw[username registered vns votes wish changes tags]] }, o => { required => 0, default => 'd', enum => [qw[a d]] }, q => { required => 0, default => '' }, )->data } || return tuwf->resNotFound; @@ -65,13 +70,15 @@ TUWF::get qr{/u/(?<char>[0a-z]|all)}, sub { ); my $list = tuwf->dbPagei({ results => 50, page => $opt->{p} }, - 'SELECT', sql_user(), ',', sql_totime('registered'), 'as registered, c_votes, c_changes, c_tags, hide_list + 'SELECT', sql_user(), ',', sql_totime('registered'), 'as registered, c_vns, c_votes, c_wish, c_changes, c_tags FROM users u WHERE', sql_and('id > 0', @where), 'ORDER BY', { username => 'username', registered => 'id', - votes => auth->permUsermod ? 'c_votes' : 'hide_list, c_votes', + vns => 'c_vns', + votes => 'c_votes', + wish => 'c_wish', changes => 'c_changes', tags => 'c_tags' }->{$opt->{s}}, $opt->{o} eq 'd' ? 'DESC' : 'ASC' diff --git a/lib/VNWeb/User/Lists.pm b/lib/VNWeb/User/Lists.pm index 4a8bb5d1..2c0548c1 100644 --- a/lib/VNWeb/User/Lists.pm +++ b/lib/VNWeb/User/Lists.pm @@ -3,6 +3,18 @@ package VNWeb::User::Lists; use VNWeb::Prelude; +# Do we have "ownership" access to this users' list (i.e. can we edit and see private stuff)? +sub own { + auth->permUsermod || (auth && auth->uid == shift) +} + + +# Should be called after any change to the ulist_* tables. +# (Normally I'd do this with triggers, but that seemed like a more complex and less efficient solution in this case) +sub updcache { + tuwf->dbExeci(SELECT => sql_func update_users_ulist_stats => \shift); +} + my $LABELS = form_compile any => { uid => { id => 1 }, @@ -19,7 +31,7 @@ elm_form 'UListManageLabels', undef, $LABELS; json_api qr{/u/ulist/labels\.json}, $LABELS, sub { my($uid, $labels) = ($_[0]{uid}, $_[0]{labels}); - return elm_Unauth if !auth || auth->uid != $uid; + return elm_Unauth if !own $uid; # Insert new labels my @new = grep $_->{id} < 0 && !$_->{delete}, @$labels; @@ -63,6 +75,7 @@ json_api qr{/u/ulist/labels\.json}, $LABELS, sub { # (This will also delete all relevant vn<->label rows from ulist_vns_labels) tuwf->dbExeci('DELETE FROM ulist_labels WHERE uid =', \$uid, 'AND id IN', [ map $_->{id}, @delete ]) if @delete; + updcache $uid; elm_Success }; @@ -79,7 +92,7 @@ elm_form 'UListVoteEdit', undef, $VNVOTE; json_api qr{/u/ulist/setvote\.json}, $VNVOTE, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( 'UPDATE ulist_vns SET vote =', \$data->{vote}, @@ -87,6 +100,8 @@ json_api qr{/u/ulist/setvote\.json}, $VNVOTE, sub { ', lastmod = NOW() WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid} ); + + updcache $data->{uid}; elm_Success }; @@ -109,7 +124,7 @@ elm_form 'UListLabelEdit', $VNLABELS_OUT, $VNLABELS_IN; json_api qr{/u/ulist/setlabel\.json}, $VNLABELS_IN, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; die "Attempt to set vote label" if $data->{label} == 7; tuwf->dbExeci( @@ -122,6 +137,7 @@ json_api qr{/u/ulist/setlabel\.json}, $VNLABELS_IN, sub { ) if $data->{applied}; tuwf->dbExeci('UPDATE ulist_vns SET lastmod = NOW() WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid}); + updcache $data->{uid}; elm_Success }; @@ -139,11 +155,12 @@ elm_form 'UListDateEdit', undef, $VNDATE; json_api qr{/u/ulist/setdate\.json}, $VNDATE, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( 'UPDATE ulist_vns SET lastmod = NOW(), ', $data->{start} ? 'started' : 'finished', '=', \($data->{date}||undef), 'WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid} ); + updcache $data->{uid}; elm_Success }; @@ -181,11 +198,12 @@ elm_form 'UListVNNotes', undef, $VNNOTES; json_api qr{/u/ulist/setnote\.json}, $VNNOTES, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; tuwf->dbExeci( 'UPDATE ulist_vns SET lastmod = NOW(), notes = ', \$data->{notes}, 'WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid} ); + # Doesn't need `updcache()` elm_Success }; @@ -201,13 +219,33 @@ elm_form 'UListDel', undef, $VNDEL; json_api qr{/u/ulist/del\.json}, $VNDEL, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; tuwf->dbExeci('DELETE FROM ulist_vns WHERE uid =', \$data->{uid}, 'AND vid =', \$data->{vid}); + updcache $data->{uid}; + elm_Success +}; + + + + +my $VNADD = form_compile any => { + uid => { id => 1 }, + vid => { id => 1 }, +}; + +elm_form 'UListAdd', undef, $VNADD; + +json_api qr{/u/ulist/add\.json}, $VNDEL, sub { + my($data) = @_; + return elm_Unauth if !own $data->{uid}; + tuwf->dbExeci('INSERT INTO ulist_vns', $data, 'ON CONFLICT (uid, vid) DO NOTHING'); + updcache $data->{uid}; elm_Success }; + my $RSTATUS = form_compile any => { uid => { id => 1 }, rid => { id => 1 }, @@ -219,50 +257,51 @@ elm_form 'UListRStatus', undef, $RSTATUS; # Adds the release when not in the list. json_api qr{/u/ulist/rstatus\.json}, $RSTATUS, sub { my($data) = @_; - return elm_Unauth if !auth || auth->uid != $data->{uid}; + return elm_Unauth if !own $data->{uid}; if($data->{status} == -1) { tuwf->dbExeci('DELETE FROM rlists WHERE uid =', \$data->{uid}, 'AND rid =', \$data->{rid}) } else { tuwf->dbExeci('INSERT INTO rlists', $data, 'ON CONFLICT (uid, rid) DO UPDATE SET status =', \$data->{status}) } + # Doesn't need `updcache()` elm_Success }; -sub filters_ { - my($uid, $own, $labels) = @_; - - my @filtlabels = ( - @$labels, - $own ? { - id => -1, label => 'No label', count => tuwf->dbVali( - 'SELECT count(*) - FROM ulist_vns uv - WHERE NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND uvl.lbl <>', \7, ') - AND uid =', \$uid - ) - } : (), - ); +sub opt { + my($filtlabels) = @_; - my $opt = eval { tuwf->validate(get => - p => { upage => 1 }, - l => { type => 'array', scalar => 1, required => 0, default => [], values => { int => 1 } }, - s => { required => 0, default => 'title', enum => [qw[ title label vote voted added modified started finished rel rating ]] }, - o => { required => 0, default => 'a', enum => ['a', 'd'] }, - c => { type => 'array', scalar => 1, required => 0, default => [], values => { enum => [qw[ vote voted added modified started finished rel rating ]] } }, - q => { required => 0 }, - )->data } || { p => 1, l => [], s => 'title', o => 'a', c => [] }; + my $opt = + # Presets + tuwf->reqGet('vnlist') ? { p => 1, l => [1,2,3,4,7,-1,0], s => 'title', o => 'a', c => [qw/vote added started finished/] } : + tuwf->reqGet('votes') ? { p => 1, l => [7], s => 'voted', o => 'd', c => [qw/vote voted/] } : + tuwf->reqGet('wishlist') ? { p => 1, l => [5], s => 'title', o => 'a', c => [qw/added/] } : + # Full options + eval { tuwf->validate(get => + p => { upage => 1 }, + l => { type => 'array', scalar => 1, required => 0, default => [], values => { int => 1 } }, + s => { required => 0, default => 'title', enum => [qw[ title label vote voted added modified started finished rel rating ]] }, + o => { required => 0, default => 'a', enum => ['a', 'd'] }, + c => { type => 'array', scalar => 1, required => 0, default => [], values => { enum => [qw[ vote voted added modified started finished rel rating ]] } }, + q => { required => 0 }, + )->data } || { p => 1, l => [], s => 'title', o => 'a', c => [] }; # $labels only includes labels we are allowed to see, getting rid of any labels in 'l' that aren't in $labels ensures we only filter on visible labels - my %accessible_labels = map +($_->{id}, 1), @filtlabels; + my %accessible_labels = map +($_->{id}, 1), @$filtlabels; my %opt_l = map +($_, 1), grep $accessible_labels{$_}, $opt->{l}->@*; %opt_l = %accessible_labels if !keys %opt_l; $opt->{l} = keys %opt_l == keys %accessible_labels ? [] : [ sort keys %opt_l ]; + ($opt, \%opt_l) +} + + +sub filters_ { + my($own, $filtlabels, $opt, $opt_labels) = @_; my sub lblfilt_ { - input_ type => 'checkbox', name => 'l', value => $_->{id}, id => "form_l$_->{id}", tabindex => 10, $opt_l{$_->{id}} ? (checked => 'checked') : (); + input_ type => 'checkbox', name => 'l', value => $_->{id}, id => "form_l$_->{id}", tabindex => 10, $opt_labels->{$_->{id}} ? (checked => 'checked') : (); label_ for => "form_l$_->{id}", "$_->{label} "; txt_ " ($_->{count})"; } @@ -275,14 +314,14 @@ sub filters_ { input_ type => 'text', class => 'text', name => 'q', value => $opt->{q}||'', style => 'width: 500px', placeholder => 'Search', tabindex => 10; br_; span_ class => 'linkradio', sub { - join_ sub { em_ ' / ' }, \&lblfilt_, grep $_->{id} < 10, @filtlabels; + join_ sub { em_ ' / ' }, \&lblfilt_, grep $_->{id} < 10, @$filtlabels; em_ ' | '; input_ type => 'checkbox', name => 'l', class => 'checkall', value => 0, id => 'form_l_all', tabindex => 10, $opt->{l}->@* == 0 ? (checked => 'checked') : (); label_ for => 'form_l_all', 'Select all'; - debug_ $labels; + debug_ $filtlabels; }; - my @cust = grep $_->{id} >= 10, @$labels; + my @cust = grep $_->{id} >= 10, @$filtlabels; if(@cust) { br_; span_ class => 'linkradio', sub { @@ -294,7 +333,6 @@ sub filters_ { input_ type => 'button', class => 'submit', tabindex => 10, id => 'managelabels', value => 'Manage labels' if $own; }; }; - $opt; } @@ -432,7 +470,7 @@ sub listing_ { # TODO: Thumbnail view? paginate_ \&url, $opt->{p}, [ $count, 50 ], 't', sub { - elm_ ColSelect => undef, [ + elm_ ColSelect => undef, [ url(), [ [ vote => 'Vote' ], [ voted => 'Vote date' ], [ added => 'Added' ], @@ -441,7 +479,7 @@ sub listing_ { [ finished => 'Finish date' ], [ rel => 'Release date' ], [ rating => 'Rating' ], - ]; + ] ]; }; div_ class => 'mainbox browse ulist', sub { table_ sub { @@ -473,10 +511,9 @@ TUWF::get qr{/$RE{uid}/ulist}, sub { my $u = tuwf->dbRowi('SELECT id,', sql_user(), 'FROM users u WHERE id =', \tuwf->capture('id')); return tuwf->resNotFound if !$u->{id}; - my $own = auth && $u->{id} == auth->uid; - - return tuwf->resNotFound if !$own; # TEMPORARY while in beta. + my $own = own $u->{id}; + # Visible and selectable labels my $labels = tuwf->dbAlli( 'SELECT l.id, l.label, l.private, count(vl.vid) as count, null as delete FROM ulist_labels l LEFT JOIN ulist_vns_labels vl ON vl.uid = l.uid AND vl.lbl = l.id @@ -485,38 +522,35 @@ TUWF::get qr{/$RE{uid}/ulist}, sub { ORDER BY CASE WHEN l.id < 10 THEN l.id ELSE 10 END, l.label' ); + # All visible labels that can be filtered on, including "virtual" labels like 'No label' + my $filtlabels = [ + @$labels, + $own ? { + id => -1, label => 'No label', count => tuwf->dbVali( + 'SELECT count(*) + FROM ulist_vns uv + WHERE NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND uvl.lbl <>', \7, ') + AND uid =', \$u->{id} + ) + } : (), + ]; + + my($opt, $opt_labels) = opt $filtlabels; + + # This page has 3 user tabs: list, wish and votes; Select the appropriate active tab based on label filters. + my $num_core_labels = grep $_ < 10, keys %$opt_labels; + my $tab = $num_core_labels == 1 && $opt_labels->{7} ? 'votes' + : $num_core_labels == 1 && $opt_labels->{5} ? 'wish' : 'list'; + my $title = $own ? 'My list' : user_displayname($u)."'s list"; - framework_ title => $title, type => 'u', dbobj => $u, tab => 'list', + framework_ title => $title, type => 'u', dbobj => $u, tab => $tab, $own ? ( pagevars => { uid => $u->{id}*1, labels => $LABELS->analyze->{keys}{labels}->coerce_for_json($labels), voteprivate => (map \($_->{private}?1:0), grep $_->{id} == 7, @$labels), } ) : (), sub { - div_ class => 'mainbox', sub { - p_ class => 'center', sub { b_ class => 'standout', style => 'font-size: 30px', '!BETA BETA BETA BETA!'; }; - div_ class => 'warning', sub { - p_ 'This is a prototype for the new lists feature. It should eventually replace your visual novel list, votes and wishlist. Feel free to play around, but keep the following in mind:'; - ul_ sub { - li_ "Changes made on this page will be lost when the feature goes live, and possibly a few times before that as well. The old visual novel list, votes and wishlist are still your primary lists."; - li_ "Exception to the above rule: The releases are synchronized with your visual novel list, so adding/removing/changing release status here will also affect your regular visual novel list and the other way around."; - li_ "You can not share your list or browse other people's list while this is in beta."; - li_ sub { txt_ "More info and feedback go to "; a_ href => '/t13136', 't13136' }; - }; - }; - p_ class => 'center', sub { b_ class => 'standout', style => 'font-size: 30px', '!BETA BETA BETA BETA!'; }; - p_ class => 'center', sub { - txt_ 'Menu links: '; - a_ href => '?l=1&l=2&l=3&l=4&l=7&l=-1&l=0&c=vote&c=added&c=started&c=finished', 'My Visual Novel list'; - txt_ ' - '; - a_ href => '?l=7&c=vote&c=voted&s=voted&o=d', 'My Votes'; - txt_ ' - '; - a_ href => '?l=5&c=added', 'My Wishlist'; - }; - }; - - my $empty = !grep $_->{count}, @$labels; - my $opt; + my $empty = !grep $_->{count}, @$filtlabels; div_ class => 'mainbox', sub { h1_ $title; if($empty) { @@ -524,7 +558,7 @@ TUWF::get qr{/$RE{uid}/ulist}, sub { ? 'Your list is empty! You can add visual novels to your list from the visual novel pages.' : user_displayname($u).' does not have any visible visual novels in their list.'; } else { - $opt = filters_ $u->{id}, $own, $labels; + filters_ $own, $filtlabels, $opt, $opt_labels; elm_ 'UList.ManageLabels' if $own; } }; @@ -532,4 +566,12 @@ TUWF::get qr{/$RE{uid}/ulist}, sub { }; }; + + +# Redirects for old URLs +TUWF::get qr{/$RE{uid}/votes}, sub { tuwf->resRedirect("/u".tuwf->capture('id').'/ulist?votes=1', 'perm') }; +TUWF::get qr{/$RE{uid}/list}, sub { tuwf->resRedirect("/u".tuwf->capture('id').'/ulist?vnlist=1', 'perm') }; +TUWF::get qr{/$RE{uid}/wish}, sub { tuwf->resRedirect("/u".tuwf->capture('id').'/ulist?wishlist=1', 'perm') }; + + 1; diff --git a/lib/VNWeb/User/Page.pm b/lib/VNWeb/User/Page.pm index 654e3d90..5ba088e6 100644 --- a/lib/VNWeb/User/Page.pm +++ b/lib/VNWeb/User/Page.pm @@ -5,7 +5,7 @@ use VNWeb::Misc::History; sub _info_table_ { - my($u, $vis) = @_; + my($u, $own) = @_; my sub sup { b_ ' ⭐supporter⭐' if $u->{user_support_can} && $u->{user_support_enabled}; @@ -39,22 +39,30 @@ sub _info_table_ { }; }; tr_ sub { + my $num = sum map $_->{votes}, $u->{votes}->@*; + my $sum = sum map $_->{total}, $u->{votes}->@*; td_ 'Votes'; - td_ !$vis ? 'hidden' : !$u->{c_votes} ? '-' : sub { - my $sum = sum map $_->{total}, $u->{votes}->@*; - txt_ sprintf '%d vote%s, %.2f average. ', $u->{c_votes}, $u->{c_votes} == 1 ? '' : 's', $sum/$u->{c_votes}/10; - a_ href => "/u$u->{id}/votes", 'Browse votes »'; + td_ !$num ? '-' : sub { + txt_ sprintf '%d vote%s, %.2f average. ', $num, $num == 1 ? '' : 's', $sum/$num/10; + a_ href => "/u$u->{id}/ulist?votes=1", 'Browse votes »'; } }; tr_ sub { - my $vns = tuwf->dbVali('SELECT COUNT(*) FROM vnlists WHERE uid =', \$u->{id})||0; - my $rel = tuwf->dbVali('SELECT COUNT(*) FROM rlists WHERE uid =', \$u->{id})||0; + my $vns = tuwf->dbVali( + 'SELECT COUNT(DISTINCT uvl.vid) FROM ulist_vns_labels uvl', + $own ? () : ('JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl AND NOT ul.private'), + 'WHERE uvl.lbl NOT IN(', \5, ',', \6, ') AND uvl.uid =', \$u->{id} + )||0; + my $privrel = $own ? '1=1' : 'EXISTS( + SELECT 1 FROM releases_vn rv JOIN ulist_vns_labels uvl ON uvl.vid = rv.vid JOIN ulist_labels ul ON ul.id = uvl.lbl AND ul.uid = uvl.uid WHERE rv.id = r.rid AND uvl.uid = r.uid AND NOT ul.private + )'; + my $rel = tuwf->dbVali('SELECT COUNT(*) FROM rlists r WHERE', $privrel, 'AND r.uid =', \$u->{id})||0; td_ 'List stats'; - td_ !$vis ? 'hidden' : !$vns && !$rel ? '-' : sub { + td_ !$vns && !$rel ? '-' : sub { txt_ sprintf '%d release%s of %d visual novel%s. ', $rel, $rel == 1 ? '' : 's', $vns, $vns == 1 ? '' : 's'; - a_ href => "/u$u->{id}/list", 'Browse list »'; + a_ href => "/u$u->{id}/ulist?vnlist=1", 'Browse list »'; }; }; tr_ sub { @@ -82,14 +90,15 @@ sub _info_table_ { sub _votestats_ { - my($u) = @_; + my($u, $own) = @_; my $sum = sum map $_->{total}, $u->{votes}->@*; my $max = max map $_->{votes}, $u->{votes}->@*; + my $num = sum map $_->{votes}, $u->{votes}->@*; table_ class => 'votegraph', sub { thead_ sub { tr_ sub { td_ colspan => 2, 'Vote stats' } }; - tfoot_ sub { tr_ sub { td_ colspan => 2, sprintf '%d vote%s total, average %.2f', $u->{c_votes}, $u->{c_votes} == 1 ? '' : 's', $sum/$u->{c_votes}/10 } }; + tfoot_ sub { tr_ sub { td_ colspan => 2, sprintf '%d vote%s total, average %.2f', $num, $num == 1 ? '' : 's', $sum/$num/10 } }; tr_ sub { my $num = $_; my $votes = [grep $num == $_->{idx}, $u->{votes}->@*]->[0]{votes} || 0; @@ -101,15 +110,21 @@ sub _votestats_ { } for (reverse 1..10); }; - my $recent = tuwf->dbAlli(q{ - SELECT vn.id, vn.title, vn.original, v.vote,}, sql_totime('v.date'), q{AS date - FROM votes v JOIN vn ON vn.id = v.vid WHERE v.uid =}, \$u->{id}, 'ORDER BY v.date DESC LIMIT', \8 + my $recent = tuwf->dbAlli(' + SELECT vn.id, vn.title, vn.original, uv.vote,', sql_totime('uv.vote_date'), 'AS date + FROM ulist_vns uv', + $own ? () : ( + 'JOIN ulist_labels ul ON ul.uid = uv.uid AND ul.id =', \7, 'AND NOT ul.private' + ), ' + JOIN vn ON vn.id = uv.vid + WHERE uv.vote IS NOT NULL AND uv.uid =', \$u->{id}, ' + ORDER BY uv.vote_date DESC LIMIT', \8 ); table_ class => 'recentvotes stripe', sub { thead_ sub { tr_ sub { td_ colspan => 3, sub { txt_ 'Recent votes'; - b_ sub { txt_ ' ('; a_ href => "/u$u->{id}/votes", 'show all'; txt_ ')' }; + b_ sub { txt_ ' ('; a_ href => "/u$u->{id}/ulist?votes=1", 'show all'; txt_ ')' }; } } }; tr_ sub { my $v = $_; @@ -125,7 +140,7 @@ sub _votestats_ { TUWF::get qr{/$RE{uid}}, sub { my $u = tuwf->dbRowi(q{ - SELECT id, hide_list, c_changes, c_votes, c_tags + SELECT id, c_changes, c_votes, c_tags ,}, sql_totime('registered'), q{ AS registered ,}, sql_user(), q{ FROM users u @@ -133,27 +148,30 @@ TUWF::get qr{/$RE{uid}}, sub { ); return tuwf->resNotFound if !$u->{id}; - my $vis = !$u->{hide_list} || (auth && auth->uid == $u->{id}) || auth->permUsermod; + my $own = (auth && auth->uid == $u->{id}) || auth->permUsermod; - $u->{votes} = $vis && $u->{c_votes} && tuwf->dbAlli(q{ - SELECT (vote::numeric/10)::int AS idx, COUNT(vote) as votes, SUM(vote) AS total - FROM votes - WHERE uid =}, \$u->{id}, q{ - GROUP BY (vote::numeric/10)::int - }); + $u->{votes} = tuwf->dbAlli(' + SELECT (uv.vote::numeric/10)::int AS idx, COUNT(uv.vote) as votes, SUM(uv.vote) AS total + FROM ulist_vns uv', + $own ? () : ( + 'JOIN ulist_labels ul ON ul.uid = uv.uid AND ul.id =', \7, 'AND NOT ul.private' + ), ' + WHERE uv.vote IS NOT NULL AND uv.uid =', \$u->{id}, ' + GROUP BY (uv.vote::numeric/10)::int + '); my $title = user_displayname($u)."'s profile"; framework_ title => $title, type => 'u', dbobj => $u, sub { div_ class => 'mainbox userpage', sub { h1_ $title; - table_ class => 'stripe', sub { _info_table_ $u, $vis }; + table_ class => 'stripe', sub { _info_table_ $u, $own }; }; div_ class => 'mainbox', sub { h1_ 'Vote statistics'; - div_ class => 'votestats', sub { _votestats_ $u }; - } if $vis && $u->{c_votes}; + div_ class => 'votestats', sub { _votestats_ $u, $own }; + } if grep $_->{votes} > 0, $u->{votes}->@*; if($u->{c_changes}) { h1_ class => 'boxtitle', sub { a_ href => "/u$u->{id}/hist", 'Recent changes' }; diff --git a/lib/VNWeb/VN/Votes.pm b/lib/VNWeb/VN/Votes.pm new file mode 100644 index 00000000..1d4fe774 --- /dev/null +++ b/lib/VNWeb/VN/Votes.pm @@ -0,0 +1,69 @@ +package VNWeb::VN::Votes; + +use VNWeb::Prelude; + + +sub listing_ { + my($opt, $count, $lst) = @_; + + my sub url { '?'.query_encode %$opt, @_ } + paginate_ \&url, $opt->{p}, [ $count, 50 ], 't'; + div_ class => 'mainbox browse votelist', sub { + table_ class => 'stripe', sub { + thead_ sub { tr_ sub { + td_ class => 'tc1', sub { txt_ 'Date'; sortable_ 'date', $opt, \&url; debug_ $lst }; + td_ class => 'tc2', sub { txt_ 'Vote'; sortable_ 'vote', $opt, \&url; }; + td_ class => 'tc3', sub { txt_ 'User'; sortable_ 'title', $opt, \&url; }; + } }; + tr_ sub { + td_ class => 'tc1', fmtdate $_->{date}; + td_ class => 'tc2', fmtvote $_->{vote}; + td_ class => 'tc3', sub { + b_ class => 'grayedout', 'hidden' if $_->{hide_list}; + user_ $_ if !$_->{hide_list}; + }; + } for @$lst; + }; + }; + paginate_ \&url, $opt->{p}, [ $count, 50 ], 'b'; +} + + +TUWF::get qr{/$RE{vid}/votes}, sub { + my $id = tuwf->capture('id'); + my $v = tuwf->dbRowi('SELECT id, title, hidden AS entry_hidden, locked AS entry_locked FROM vn WHERE id =', \$id); + return tuwf->resNotFound if !$v->{id} || $v->{hidden}; + + my $opt = eval { tuwf->validate(get => + p => { page => 1 }, + o => { required => 0, default => 'd', enum => ['a','d'] }, + s => { required => 0, default => 'date', enum => ['date', 'title', 'vote' ] } + )->data } || { p => 1, o => 'd', s => 'date' }; + + my $fromwhere = sql + 'FROM ulist_vns uv + JOIN users u ON u.id = uv.uid + WHERE uv.vid =', \$v->{id}, 'AND uv.vote IS NOT NULL + AND NOT EXISTS(SELECT 1 FROM users u WHERE u.id = uv.uid AND u.ign_votes)'; + + my $count = tuwf->dbVali('SELECT COUNT(*)', $fromwhere); + + my $lst = tuwf->dbPagei({results => 50, page => $opt->{p}}, + 'SELECT uv.vote,', sql_totime('uv.vote_date'), 'as date, ', sql_user(), ' + , NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND NOT ul.private) AS hide_list + ', $fromwhere, 'ORDER BY', sprintf + { date => 'uv.vote_date %s', vote => 'uv.vote %s', title => '(CASE WHEN hide_list THEN NULL ELSE u.username END) %s, uv.vote_date' }->{$opt->{s}}, + { a => 'ASC', d => 'DESC' }->{$opt->{o}} + ); + + framework_ title => "Votes for $v->{title}", type => 'v', dbobj => $v, sub { + div_ class => 'mainbox', sub { + h1_ "Votes for $v->{title}"; + p_ 'No votes to list. :(' if !@$lst; + }; + listing_ $opt, $count, $lst if @$lst; + }; +}; + + +1; |