summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-12-30 15:20:00 +0100
committerYorhel <git@yorhel.nl>2019-12-30 15:20:00 +0100
commitd1bb5b82255c764edecc659c78d5b9f4e36555e8 (patch)
tree53058ac9a25d0e82968da77e28f46d1137204e6b /lib
parent13287329e70cbaf155c85e3054f2496411e21b21 (diff)
parentddb0d385eeb112de6e544adefbbac1cb0b8a957a (diff)
Merge branch 'ulist'
Diffstat (limited to 'lib')
-rw-r--r--lib/Multi/API.pm119
-rw-r--r--lib/Multi/Maintenance.pm41
-rw-r--r--lib/VN3/BBCode.pm300
-rw-r--r--lib/VN3/Char/Edit.pm168
-rw-r--r--lib/VN3/Char/JS.pm55
-rw-r--r--lib/VN3/Char/Page.pm330
-rw-r--r--lib/VN3/DB.pm287
-rw-r--r--lib/VN3/Docs/Edit.pm54
-rw-r--r--lib/VN3/Docs/JS.pm15
-rw-r--r--lib/VN3/Docs/Lib.pm86
-rw-r--r--lib/VN3/Docs/Page.pm23
-rw-r--r--lib/VN3/ElmGen.pm197
-rw-r--r--lib/VN3/HTML.pm375
-rw-r--r--lib/VN3/Misc/Homepage.pm31
-rw-r--r--lib/VN3/Misc/ImageUpload.pm70
-rw-r--r--lib/VN3/Prelude.pm104
-rw-r--r--lib/VN3/Producer/Edit.pm136
-rw-r--r--lib/VN3/Producer/JS.pm47
-rw-r--r--lib/VN3/Producer/Page.pm117
-rw-r--r--lib/VN3/Release/Edit.pm130
-rw-r--r--lib/VN3/Release/JS.pm32
-rw-r--r--lib/VN3/Release/Page.pm184
-rw-r--r--lib/VN3/Staff/Edit.pm108
-rw-r--r--lib/VN3/Staff/JS.pm43
-rw-r--r--lib/VN3/Staff/Page.pm213
-rw-r--r--lib/VN3/Trait/JS.pm44
-rw-r--r--lib/VN3/Types.pm171
-rw-r--r--lib/VN3/User/Lib.pm31
-rw-r--r--lib/VN3/User/Login.pm50
-rw-r--r--lib/VN3/User/Page.pm207
-rw-r--r--lib/VN3/User/RegReset.pm137
-rw-r--r--lib/VN3/User/Settings.pm98
-rw-r--r--lib/VN3/User/VNList.pm325
-rw-r--r--lib/VN3/VN/Edit.pm187
-rw-r--r--lib/VN3/VN/JS.pm46
-rw-r--r--lib/VN3/VN/Lib.pm20
-rw-r--r--lib/VN3/VN/Page.pm631
-rw-r--r--lib/VN3/Validation.pm168
-rw-r--r--lib/VNDB/DB/ULists.pm292
-rw-r--r--lib/VNDB/DB/VN.pm23
-rw-r--r--lib/VNDB/Handler/ULists.pm482
-rw-r--r--lib/VNDB/Handler/VNBrowse.pm7
-rw-r--r--lib/VNDB/Handler/VNPage.pm53
-rw-r--r--lib/VNDB/Types.pm17
-rw-r--r--lib/VNDB/Util/BrowseHTML.pm3
-rw-r--r--lib/VNDB/Util/CommonHTML.pm20
-rw-r--r--lib/VNDB/Util/LayoutHTML.pm2
-rw-r--r--lib/VNWeb/Auth.pm2
-rw-r--r--lib/VNWeb/HTML.pm34
-rw-r--r--lib/VNWeb/User/Edit.pm5
-rw-r--r--lib/VNWeb/User/List.pm37
-rw-r--r--lib/VNWeb/User/Lists.pm174
-rw-r--r--lib/VNWeb/User/Page.pm70
-rw-r--r--lib/VNWeb/VN/Votes.pm69
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/&/&amp;/g;
- s/>/&gt;/g;
- s/</&lt;/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">&lt;hidden by spoiler settings&gt;</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 '&nbsp;&nbsp;'; 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 '&middot;'; }; };
- 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 '&#9656;'; 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 '&#9656;'; 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;