diff options
Diffstat (limited to 'lib/Multi/API.pm')
-rw-r--r-- | lib/Multi/API.pm | 670 |
1 files changed, 394 insertions, 276 deletions
diff --git a/lib/Multi/API.pm b/lib/Multi/API.pm index d7c59378..8b9dfdbb 100644 --- a/lib/Multi/API.pm +++ b/lib/Multi/API.pm @@ -5,7 +5,7 @@ package Multi::API; -use strict; +use v5.26; use warnings; use Multi::Core; use Socket 'SO_KEEPALIVE', 'SOL_SOCKET', 'IPPROTO_TCP'; @@ -15,11 +15,12 @@ use POE::Filter::VNDBAPI 'encode_filters'; use Encode 'encode_utf8', 'decode_utf8'; use Crypt::URandom 'urandom'; use Crypt::ScryptKDF 'scrypt_raw';; -use VNDBUtil 'normalize_query', 'norm_ip'; +use VNDB::Func 'imgurl', 'imgsize', 'norm_ip', 'resolution', 'is_insecurepass'; use VNDB::Types; use VNDB::Config; use JSON::XS; -use PWLookup; +use List::Util 'min', 'max'; +use VNDB::ExtLinks 'sql_extlinks'; # Linux-specific, not exported by the Socket module. sub TCP_KEEPIDLE () { 4 } @@ -146,7 +147,8 @@ sub cres { writelog $c, '[%2d/%4.0fms %5.0f] %s', $c->{sqlq}, $c->{sqlt}*1000, length($msg), @arg ? sprintf $log, @arg : $log; - cmd_read($c); + if($c->{disconnect}) { $c->{h}->push_shutdown() } + else { cmd_read($c); } } @@ -229,6 +231,16 @@ sub cmd_handle { return login($c, @arg) if $cmd eq 'login'; return cerr $c, needlogin => 'Not logged in.' if !$c->{client}; + # logout + if($cmd eq 'logout') { + return cerr $c, parse => 'Too many arguments to logout command' if @arg > 0; + return cerr $c, needlogin => 'No session token associated with this connection' if !$c->{sessiontoken}; + return pg_cmd 'SELECT user_logout($1, decode($2, \'hex\'))', [ $c->{uid}, $c->{sessiontoken} ], sub { + $c->{disconnect} = 1; + cres $c, ['ok'], 'Logged out, session invalidated'; + } + } + # dbstats if($cmd eq 'dbstats') { return cerr $c, parse => 'Too many arguments to dbstats command' if @arg > 0; @@ -260,42 +272,64 @@ sub login { !exists $arg->{$_} && return cerr $c, missing => "Required field '$_' is missing", field => $_ for(qw|protocol client clientver|); - for(qw|protocol client clientver username password|) { + for(qw|protocol client clientver username password sessiontoken|) { exists $arg->{$_} && !defined $arg->{$_} && return cerr $c, badarg => "Field '$_' cannot be null", field => $_; exists $arg->{$_} && ref $arg->{$_} && return cerr $c, badarg => "Field '$_' must be a scalar", field => $_; } return cerr $c, badarg => 'Unknown protocol version', field => 'protocol' if $arg->{protocol} ne '1'; - return cerr $c, badarg => 'The fields "username" and "password" must either both be present or both be missing.', field => 'username' - if exists $arg->{username} && !exists $arg->{password} || exists $arg->{password} && !exists $arg->{username}; return cerr $c, badarg => 'Invalid client name', field => 'client' if $arg->{client} !~ /^[a-zA-Z0-9 _-]{3,50}$/; return cerr $c, badarg => 'Invalid client version', field => 'clientver' if $arg->{clientver} !~ /^[a-zA-Z0-9_.\/-]{1,25}$/; + return cerr $c, badarg => '"createsession" can only be used when logging in with a password.' if !exists $arg->{password} && exists $arg->{createsession}; + return cerr $c, badarg => 'Missing "username" field.', field => 'username' if !exists $arg->{username} && (exists $arg->{password} || exists $arg->{sessiontoken}); + if(!exists $arg->{username}) { $c->{client} = $arg->{client}; $c->{clientver} = $arg->{clientver}; cres $c, ['ok'], 'Login using client "%s" ver. %s', $c->{client}, $c->{clientver}; - return; - } else { - $arg->{username} = lc $arg->{username}; + + } elsif(exists $arg->{password}) { return cerr $c, auth => "Password too weak, please log in on the site and change your password" - if config->{password_db} && PWLookup::lookup(config->{password_db}, $arg->{password}); - } + if is_insecurepass($arg->{password}); + login_auth($c, $arg); + + } elsif(exists $arg->{sessiontoken}) { + return cerr $c, badarg => 'Invalid session token', field => 'sessiontoken' if $arg->{sessiontoken} !~ /^[a-fA-F0-9]{40}$/; + cpg $c, + 'SELECT u.id, u.username FROM users u JOIN users_shadow us ON us.id = u.id + WHERE lower(u.username) = lower($1) AND us.delete_at IS NULL AND user_validate_session(u.id, decode($2, \'hex\'), \'api\') IS DISTINCT FROM NULL', + [ $arg->{username}, $arg->{sessiontoken} ], sub { + if($_[0]->nRows == 1) { + $c->{uid} = $_[0]->value(0,0); + $c->{username} = $_[0]->value(0,1); + $c->{client} = $arg->{client}; + $c->{clientver} = $arg->{clientver}; + $c->{sessiontoken} = $arg->{sessiontoken}; + cres $c, ['ok'], 'Successful login with session by %s (%s) using client "%s" ver. %s', $c->{username}, $c->{uid}, $c->{client}, $c->{clientver}; + } else { + cerr $c, auth => "Wrong session token for user '$arg->{username}'"; + } + }; - login_auth($c, $arg); + } else { + return cerr $c, badarg => 'Missing "password" or "sessiontoken" field.'; + } } sub login_auth { my($c, $arg) = @_; - # check login throttle + # check login throttle (also used when logging in with a session... oh well) cpg $c, 'SELECT extract(\'epoch\' from timeout) FROM login_throttle WHERE ip = $1', [ norm_ip($c->{ip}) ], sub { my $tm = $_[0]->nRows ? $_[0]->value(0,0) : AE::time; return cerr $c, auth => "Too many failed login attempts" if $tm-AE::time() > config->{login_throttle}[1]; # Fetch user info - cpg $c, 'SELECT id, encode(user_getscryptargs(id), \'hex\') FROM users WHERE username = $1', [ $arg->{username} ], sub { + cpg $c, ' + SELECT u.id, u.username, encode(user_getscryptargs(u.id), \'hex\') FROM users u JOIN users_shadow us ON us.id = u.id + WHERE us.delete_at IS NULL AND lower(u.username) = lower($1)', [ $arg->{username} ], sub { login_verify($c, $arg, $tm, $_[0]); }; }; @@ -307,26 +341,32 @@ sub login_verify { return cerr $c, auth => "No user with the name '$arg->{username}'" if $res->nRows == 0; my $uid = $res->value(0,0); - my $sargs = $res->value(0,1); + my $username = $res->value(0,1); + my $sargs = $res->value(0,2); return cerr $c, auth => "Account disabled" if !$sargs || length($sargs) != 14*2; - my $token = urandom(20); + my $token = unpack 'H*', urandom(20); my($N, $r, $p, $salt) = unpack 'NCCa8', pack 'H*', $sargs; my $passwd = pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw(encode_utf8($arg->{password}), config->{scrypt_salt} . $salt, $N, $r, $p, 32); - cpg $c, 'SELECT user_login($1, decode($2, \'hex\'), decode($3, \'hex\'))', [ $uid, unpack('H*', $passwd), unpack('H*', $token) ], sub { + cpg $c, 'SELECT user_login($1, \'api\', decode($2, \'hex\'), decode($3, \'hex\'))', [ $uid, unpack('H*', $passwd), $token ], sub { if($_[0]->nRows == 1 && ($_[0]->value(0,0)||'') =~ /t/) { $c->{uid} = $uid; - $c->{username} = $arg->{username}; + $c->{username} = $username; $c->{client} = $arg->{client}; $c->{clientver} = $arg->{clientver}; - pg_cmd 'SELECT user_logout($1, decode($2, \'hex\'))', [ $uid, unpack('H*', $token) ]; - cres $c, ['ok'], 'Successful login by %s (%s) using client "%s" ver. %s', $arg->{username}, $c->{uid}, $c->{client}, $c->{clientver}; + if($arg->{createsession}) { + $c->{sessiontoken} = $token; + cres $c, ['session', $token], 'Successful login with password+session by %s (%s) using client "%s" ver. %s', $username, $c->{uid}, $c->{client}, $c->{clientver}; + } else { + pg_cmd 'SELECT user_logout($1, decode($2, \'hex\'))', [ $uid, $token ]; + cres $c, ['ok'], 'Successful login with password by %s (%s) using client "%s" ver. %s', $username, $c->{uid}, $c->{client}, $c->{clientver}; + } } else { my @a = ( $tm + config->{login_throttle}[0], norm_ip($c->{ip}) ); pg_cmd 'UPDATE login_throttle SET timeout = to_timestamp($1) WHERE ip = $2', \@a; pg_cmd 'INSERT INTO login_throttle (ip, timeout) SELECT $2, to_timestamp($1) WHERE NOT EXISTS(SELECT 1 FROM login_throttle WHERE ip = $2)', \@a; - cerr $c, auth => "Wrong password for user '$arg->{username}'"; + cerr $c, auth => "Wrong password for user '$username'"; } }; } @@ -337,8 +377,7 @@ sub dbstats { cpg $c, 'SELECT section, count FROM stats_cache', undef, sub { my $res = shift; - cres $c, [ dbstats => { map { - $_->{section} =~ s/^threads_//; + cres $c, [ dbstats => { users => 0, threads => 0, posts => 0, map { ($_->{section}, 1*$_->{count}) } $res->rowsAsHashes } ], 'dbstats'; }; @@ -363,6 +402,8 @@ sub parsedate { sub formatwd { $_[0] ? "Q$_[0]" : undef } +sub idnum { defined $_[0] ? 1*($_[0] =~ s/^[a-z]+//r) : undef } + sub splitarray { (my $s = shift) =~ s/^{(.*)}$/$1/; @@ -370,6 +411,23 @@ sub splitarray { } +# Returns an image flagging structure or undef if $image is false. +# Assumes $obj has c_votecount, c_sexual_avg and c_violence_avg. +# Those fields are removed from $obj. +sub image_flagging { + my($image, $obj) = @_; + my $flag = { + votecount => delete $obj->{c_votecount}, + sexual_avg => delete $obj->{c_sexual_avg}, + violence_avg => delete $obj->{c_violence_avg}, + }; + $flag->{votecount} *= 1 if defined $flag->{votecount}; + $flag->{sexual_avg} /= 100 if defined $flag->{sexual_avg}; + $flag->{violence_avg} /= 100 if defined $flag->{violence_avg}; + $image ? $flag : undef; +} + + # sql => str: Main sql query, three printf args: select, where part, order by and limit clauses # sqluser => str: Alternative to 'sql' if the user is logged in. One additional printf arg: user id. # If sql is undef and sqluser isn't, the command is only available to logged in users. @@ -391,63 +449,82 @@ sub splitarray { # } # filters => filters args for get_filters() (TODO: Document) my %GET_VN = ( - sql => 'SELECT %s FROM vn v WHERE NOT v.hidden AND (%s) %s', + sql => 'SELECT %s FROM vnt v LEFT JOIN images i ON i.id = v.image WHERE NOT v.hidden AND (%s) %s', select => 'v.id', proc => sub { - $_[0]{id} *= 1 + $_[0]{id} = idnum $_[0]{id}; }, sortdef => 'id', sorts => { id => 'v.id %s', - title => 'v.title %s', - released => 'v.c_released %s', - popularity => 'v.c_popularity %s NULLS LAST', - rating => 'v.c_rating %s NULLS LAST', - votecount => 'v.c_votecount %s', + title => 'v.sorttitle %s, v.id', + released => 'v.c_released %s, v.id', + popularity => '-v.c_pop_rank %s NULLS LAST, v.id', + rating => '-v.c_rat_rank %s NULLS LAST, v.id', + votecount => 'v.c_votecount %s, v.id', }, flags => { basic => { - select => 'v.title, v.original, v.c_released, v.c_languages, v.c_olang, v.c_platforms', + select => 'v.title[2], v.title[4] AS original, v.c_released, v.c_languages, v.olang, v.c_platforms', proc => sub { $_[0]{original} ||= undef; $_[0]{platforms} = splitarray delete $_[0]{c_platforms}; $_[0]{languages} = splitarray delete $_[0]{c_languages}; - $_[0]{orig_lang} = splitarray delete $_[0]{c_olang}; + $_[0]{orig_lang} = [ delete $_[0]{olang} ]; $_[0]{released} = formatdate delete $_[0]{c_released}; }, }, details => { - select => 'v.image, v.img_nsfw, v.alias AS aliases, v.length, v.desc AS description, v.l_wp, v.l_encubed, v.l_renai, l_wikidata', + select => 'v.image, i.c_sexual_avg, i.c_violence_avg, i.c_votecount, i.width AS image_width, i.height AS image_height, v.alias AS aliases, + v.length, v.c_length AS length_minutes, v.c_lengthnum AS length_votes, v.description, v.l_wp, v.l_encubed, v.l_renai, l_wikidata', proc => sub { $_[0]{aliases} ||= undef; $_[0]{length} *= 1; $_[0]{length} ||= undef; + $_[0]{length_votes}*= 1; + $_[0]{length_minutes}*=1 if defined $_[0]{length_minutes}; $_[0]{description} ||= undef; - $_[0]{image_nsfw} = delete($_[0]{img_nsfw}) =~ /t/ ? TRUE : FALSE; $_[0]{links} = { wikipedia => delete($_[0]{l_wp}) ||undef, encubed => delete($_[0]{l_encubed})||undef, renai => delete($_[0]{l_renai}) ||undef, wikidata => formatwd(delete $_[0]{l_wikidata}), }; - $_[0]{image} = $_[0]{image} ? sprintf '%s/cv/%02d/%d.jpg', config->{url_static}, $_[0]{image}%100, $_[0]{image} : undef; + $_[0]{image} = $_[0]{image} ? imgurl $_[0]{image} : undef; + $_[0]{image_nsfw} = !$_[0]{image} ? FALSE : !$_[0]{c_votecount} || $_[0]{c_sexual_avg} > 40 || $_[0]{c_violence_avg} > 40 ? TRUE : FALSE; + $_[0]{image_flagging} = image_flagging $_[0]{image}, $_[0]; + $_[0]{image_width} *= 1 if defined $_[0]{image_width}; + $_[0]{image_height} *= 1 if defined $_[0]{image_height}; }, }, stats => { - select => 'v.c_popularity, v.c_rating, v.c_votecount', + select => 'v.c_rating, v.c_votecount as votecount', proc => sub { - $_[0]{popularity} = 1 * sprintf '%.2f', 100*(delete $_[0]{c_popularity} or 0); - $_[0]{rating} = 1 * sprintf '%.2f', 0.1*(delete $_[0]{c_rating} or 0); - $_[0]{votecount} = 1 * delete $_[0]{c_votecount}; + $_[0]{popularity} = 1 * sprintf '%.2f', min(100, ($_[0]{votecount} or 0)/150); + $_[0]{rating} = 1 * sprintf '%.2f', (delete $_[0]{c_rating} or 0)/100; + $_[0]{votecount} *= 1; }, }, + titles => { + fetch => [[ 'id', 'SELECT id, lang, title, latin, official FROM vn_titles WHERE id IN(%s)', + sub { my($r, $n) = @_; + for my $i (@$r) { + $i->{titles} = [ grep $i->{id} eq $_->{id}, @$n ]; + } + for (@$n) { + delete $_->{id}; + $_->{official} = $_->{official} =~ /t/ ? TRUE : FALSE, + } + } + ]], + }, anime => { fetch => [[ 'id', 'SELECT va.id AS vid, a.id, a.year, a.ann_id, a.nfo_id, a.type, a.title_romaji, a.title_kanji FROM anime a JOIN vn_anime va ON va.aid = a.id WHERE va.id IN(%s)', sub { my($r, $n) = @_; # link for my $i (@$r) { - $i->{anime} = [ grep $i->{id} == $_->{vid}, @$n ]; + $i->{anime} = [ grep $i->{id} eq $_->{vid}, @$n ]; } # cleanup for (@$n) { @@ -460,14 +537,14 @@ my %GET_VN = ( ]], }, relations => { - fetch => [[ 'id', 'SELECT vr.id AS vid, v.id, vr.relation, v.title, v.original, vr.official FROM vn_relations vr - JOIN vn v ON v.id = vr.vid WHERE vr.id IN(%s)', + fetch => [[ 'id', 'SELECT vr.id AS vid, v.id, vr.relation, v.title[2], v.title[4] AS original, vr.official FROM vn_relations vr + JOIN vnt v ON v.id = vr.vid WHERE vr.id IN(%s)', sub { my($r, $n) = @_; for my $i (@$r) { - $i->{relations} = [ grep $i->{id} == $_->{vid}, @$n ]; + $i->{relations} = [ grep $i->{id} eq $_->{vid}, @$n ]; } for (@$n) { - $_->{id} *= 1; + $_->{id} = idnum $_->{id}; $_->{original} ||= undef; $_->{official} = $_->{official} =~ /t/ ? TRUE : FALSE, delete $_->{vid}; @@ -483,42 +560,45 @@ my %GET_VN = ( sub { my($r, $n) = @_; for my $i (@$r) { $i->{tags} = [ map - [ $_->{id}*1, 1*sprintf('%.2f', $_->{score}), 1*sprintf('%.0f', $_->{spoiler}) ], - grep $i->{id} == $_->{vid}, @$n ]; + [ idnum($_->{id}), 1*sprintf('%.2f', $_->{score}), 1*sprintf('%.0f', $_->{spoiler}) ], + grep $i->{id} eq $_->{vid}, @$n ]; } }, ]], }, screens => { - fetch => [[ 'id', 'SELECT vs.id AS vid, vs.scr AS image, vs.rid, vs.nsfw, s.width, s.height - FROM vn_screenshots vs JOIN screenshots s ON s.id = vs.scr WHERE vs.id IN(%s)', + fetch => [[ 'id', 'SELECT vs.id AS vid, vs.scr, vs.rid, s.width, s.height, s.c_sexual_avg, s.c_violence_avg, s.c_votecount + FROM vn_screenshots vs JOIN images s ON s.id = vs.scr WHERE vs.id IN(%s)', sub { my($r, $n) = @_; for my $i (@$r) { - $i->{screens} = [ grep $i->{id} == $_->{vid}, @$n ]; + $i->{screens} = [ grep $i->{id} eq $_->{vid}, @$n ]; } for (@$n) { - $_->{image} = sprintf '%s/sf/%02d/%d.jpg', config->{url_static}, $_->{image}%100, $_->{image}; - $_->{rid} *= 1; - $_->{nsfw} = $_->{nsfw} =~ /t/ ? TRUE : FALSE; + $_->{id} = $_->{scr}; + $_->{thumbnail} = imgurl($_->{scr}, 't'); + $_->{image} = imgurl delete $_->{scr}; + $_->{rid} = idnum $_->{rid}; + $_->{nsfw} = !$_->{c_votecount} || $_->{c_sexual_avg} > 40 || $_->{c_violence_avg} > 40 ? TRUE : FALSE; $_->{width} *= 1; $_->{height} *= 1; + ($_->{thumbnail_width}, $_->{thumbnail_height}) = imgsize $_->{width}, $_->{height}, config->{scr_size}->@*; + $_->{flagging} = image_flagging(1, $_); delete $_->{vid}; } }, ]] }, staff => { - fetch => [[ 'id', 'SELECT vs.id, vs.aid, vs.role, vs.note, sa.id AS sid, sa.name, sa.original - FROM vn_staff vs JOIN staff_alias sa ON sa.aid = vs.aid JOIN staff s ON s.id = sa.id - WHERE vs.id IN(%s) AND NOT s.hidden', + fetch => [[ 'id', 'SELECT vs.id, vs.aid, vs.role, vs.note, s.id AS sid, s.title[2] AS name, s.title[4] AS original + FROM vn_staff vs JOIN staff_aliast s ON s.aid = vs.aid WHERE vs.id IN(%s) AND NOT s.hidden', sub { my($r, $n) = @_; for my $i (@$r) { - $i->{staff} = [ grep $i->{id} == $_->{id}, @$n ]; + $i->{staff} = [ grep $i->{id} eq $_->{id}, @$n ]; } for (@$n) { $_->{aid} *= 1; - $_->{sid} *= 1; - $_->{original} ||= undef; + $_->{sid} = idnum $_->{sid}; + $_->{original} = undef if $_->{original} eq $_->{name}; $_->{note} ||= undef; delete $_->{id}; } @@ -528,21 +608,21 @@ my %GET_VN = ( }, filters => { id => [ - [ 'int' => 'v.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 'v.id :op:(:value:)', {'=' => 'IN', '!= ' => 'NOT IN'}, range => [1,1e6], join => ',' ], + [ 'int' => 'v.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, process => \'v' ], + [ inta => 'v.id :op:(:value:)', {'=' => 'IN', '!= ' => 'NOT IN'}, process => \'v', join => ',' ], ], title => [ - [ str => 'v.title :op: :value:', {qw|= = != <>|} ], - [ str => 'v.title ILIKE :value:', {'~',1}, process => \'like' ], + [ str => 'v.sorttitle :op: :value:', {qw|= = != <>|} ], + [ str => 'v.sorttitle ILIKE :value:', {'~',1}, process => \'like' ], ], original => [ - [ undef, "v.original :op: ''", {qw|= = != <>|} ], - [ str => 'v.original :op: :value:', {qw|= = != <>|} ], - [ str => 'v.original ILIKE :value:', {'~',1}, process => \'like' ] + [ undef, "v.title[4] :op: ''", {qw|= = != <>|} ], + [ str => 'v.title[4] :op: :value:', {qw|= = != <>|} ], + [ str => 'v.title[4] ILIKE :value:', {'~',1}, process => \'like' ] ], firstchar => [ - [ undef, '(:op: ((ASCII(v.title) < 97 OR ASCII(v.title) > 122) AND (ASCII(v.title) < 65 OR ASCII(v.title) > 90)))', {'=', '', '!=', 'NOT'} ], - [ str => 'LOWER(SUBSTR(v.title, 1, 1)) :op: :value:' => {qw|= = != <>|}, process => sub { shift =~ /^([a-z])$/ ? $1 : \'Invalid character' } ], + [ undef, ':op: match_firstchar(v.sorttitle, \'0\')', {'=', '', '!=', 'NOT'} ], + [ str => ':op: match_firstchar(v.sorttitle, :value:)', {'=', '', '!=', 'NOT'}, process => sub { shift =~ /^([a-z])$/ ? $1 : \'Invalid character' } ], ], released => [ [ undef, 'v.c_released :op: 0', {qw|= = != <>|} ], @@ -559,59 +639,64 @@ my %GET_VN = ( [ stra => ':op: (v.c_languages && ARRAY[:value:]::language[])', {'=' => '', '!=' => 'NOT'}, join => ',', process => \'lang' ], ], orig_lang => [ - [ str => ':op: (v.c_olang && ARRAY[:value:]::language[])', {'=' => '', '!=' => 'NOT'}, process => \'lang' ], - [ stra => ':op: (v.c_olang && ARRAY[:value:]::language[])', {'=' => '', '!=' => 'NOT'}, join => ',', process => \'lang' ], + [ str => 'v.olang :op: :value:', {qw|= = != <>|}, process => \'lang' ], + [ stra => 'v.olang :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'lang' ], ], search => [ - [ str => '(:value:)', {'~',1}, split => \&normalize_query, - join => ' AND ', serialize => 'v.c_search LIKE :value:', process => \'like' ], + [ str => 'EXISTS(SELECT 1 FROM search_cache sc WHERE sc.id = v.id AND sc.label LIKE ALL (search_query(:value:)))', {'~',1} ], ], tags => [ - [ int => 'v.id :op:(SELECT vid FROM tags_vn_inherit WHERE tag = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6] ], - [ inta => 'v.id :op:(SELECT vid FROM tags_vn_inherit WHERE tag IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', range => [1,1e6] ], + [ int => 'v.id :op:(SELECT vid FROM tags_vn_inherit WHERE tag = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'g' ], + [ inta => 'v.id :op:(SELECT vid FROM tags_vn_inherit WHERE tag IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'g' ], ], }, ); my %GET_RELEASE = ( - sql => 'SELECT %s FROM releases r WHERE NOT hidden AND (%s) %s', + sql => 'SELECT %s FROM releasest r WHERE NOT hidden AND (%s) %s', select => 'r.id', sortdef => 'id', sorts => { id => 'r.id %s', - title => 'r.title %s', - released => 'r.released %s', + title => 'r.sorttitle %s, r.id', + released => 'r.released %s, r.id', }, proc => sub { - $_[0]{id} *= 1 + $_[0]{id} = idnum $_[0]{id}; }, flags => { basic => { - select => 'r.title, r.original, r.released, r.type, r.patch, r.freeware, r.doujin', + select => 'r.title[2], r.title[4] AS original, r.released, r.patch, r.freeware, r.doujin, r.official', proc => sub { $_[0]{original} ||= undef; $_[0]{released} = formatdate($_[0]{released}); $_[0]{patch} = $_[0]{patch} =~ /^t/ ? TRUE : FALSE; $_[0]{freeware} = $_[0]{freeware} =~ /^t/ ? TRUE : FALSE; $_[0]{doujin} = $_[0]{doujin} =~ /^t/ ? TRUE : FALSE; + $_[0]{official} = $_[0]{official} =~ /^t/ ? TRUE : FALSE; }, - fetch => [[ 'id', 'SELECT id, lang FROM releases_lang WHERE id IN(%s)', + fetch => [[ 'id', 'SELECT id, lang FROM releases_titles WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{languages} = [ map $i->{id} == $_->{id} ? $_->{lang} : (), @$r ]; + $i->{languages} = [ map $i->{id} eq $_->{id} ? $_->{lang} : (), @$r ]; } }, + ], ['id', 'SELECT id, MAX(rtype) AS type FROM releases_vn WHERE id IN(%s) GROUP BY id', + sub { my($n, $r) = @_; + my %t = map +($_->{id},$_->{type}), @$r; + $_->{type} = $t{$_->{id}} for @$n; + }, ]], }, details => { - select => 'r.website, r.notes, r.minage, r.gtin, r.catalog, r.resolution, r.voiced, r.ani_story, r.ani_ero', + select => 'r.website, r.notes, r.minage, r.gtin, r.catalog, r.reso_x, r.reso_y, r.voiced, r.ani_story, r.ani_ero', proc => sub { $_[0]{website} ||= undef; $_[0]{notes} ||= undef; - $_[0]{minage} = $_[0]{minage} < 0 ? undef : $_[0]{minage}*1; + $_[0]{minage} *= 1 if defined $_[0]{minage}; $_[0]{gtin} ||= undef; $_[0]{catalog} ||= undef; - $_[0]{resolution} = $_[0]{resolution} eq 'unknown' ? undef : $RESOLUTION{ $_[0]{resolution} }{txt}; + $_[0]{resolution} = resolution $_[0]; $_[0]{voiced} = $_[0]{voiced} ? $_[0]{voiced}*1 : undef; $_[0]{animation} = [ $_[0]{ani_story} ? $_[0]{ani_story}*1 : undef, @@ -619,18 +704,20 @@ my %GET_RELEASE = ( ]; delete($_[0]{ani_story}); delete($_[0]{ani_ero}); + delete($_[0]{reso_x}); + delete($_[0]{reso_y}); }, fetch => [ [ 'id', 'SELECT id, platform FROM releases_platforms WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{platforms} = [ map $i->{id} == $_->{id} ? $_->{platform} : (), @$r ]; + $i->{platforms} = [ map $i->{id} eq $_->{id} ? $_->{platform} : (), @$r ]; } } ], [ 'id', 'SELECT id, medium, qty FROM releases_media WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{media} = [ grep $i->{id} == $_->{id}, @$r ]; + $i->{media} = [ grep $i->{id} eq $_->{id}, @$r ]; } for (@$r) { delete $_->{id}; @@ -639,15 +726,30 @@ my %GET_RELEASE = ( } ], ] }, + lang => { + fetch => [[ 'id', 'SELECT rt.id, rt.lang, rt.title, rt.latin, rt.mtl, rt.lang = r.olang AS main + FROM releases_titles rt JOIN releases r ON r.id = rt.id WHERE rt.id IN(%s)', + sub { my($r, $n) = @_; + for my $i (@$r) { + $i->{lang} = [ grep $i->{id} eq $_->{id}, @$n ]; + } + for (@$n) { + delete $_->{id}; + $_->{mtl} = $_->{mtl} =~ /t/ ? TRUE : FALSE, + $_->{main} = $_->{main} =~ /t/ ? TRUE : FALSE, + } + } + ]], + }, vn => { - fetch => [[ 'id', 'SELECT rv.id AS rid, v.id, v.title, v.original FROM releases_vn rv JOIN vn v ON v.id = rv.vid + fetch => [[ 'id', 'SELECT rv.id AS rid, rv.rtype, v.id, v.title[2], v.title[4] AS original FROM releases_vn rv JOIN vnt v ON v.id = rv.vid WHERE NOT v.hidden AND rv.id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{vn} = [ grep $i->{id} == $_->{rid}, @$r ]; + $i->{vn} = [ grep $i->{id} eq $_->{rid}, @$r ]; } for (@$r) { - $_->{id}*=1; + $_->{id} = idnum $_->{id}; $_->{original} ||= undef; delete $_->{rid}; } @@ -655,43 +757,58 @@ my %GET_RELEASE = ( ]], }, producers => { - fetch => [[ 'id', 'SELECT rp.id AS rid, rp.developer, rp.publisher, p.id, p.type, p.name, p.original FROM releases_producers rp - JOIN producers p ON p.id = rp.pid WHERE NOT p.hidden AND rp.id IN(%s)', + fetch => [[ 'id', 'SELECT rp.id AS rid, rp.developer, rp.publisher, p.id, p.type, p.title[2] AS name, p.title[4] AS original FROM releases_producers rp + JOIN producerst p ON p.id = rp.pid WHERE NOT p.hidden AND rp.id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{producers} = [ grep $i->{id} == $_->{rid}, @$r ]; + $i->{producers} = [ grep $i->{id} eq $_->{rid}, @$r ]; } for (@$r) { - $_->{id}*=1; - $_->{original} ||= undef; + $_->{id} = idnum $_->{id}; + $_->{original} = undef if $_->{original} eq $_->{name}; $_->{developer} = $_->{developer} =~ /^t/ ? TRUE : FALSE; $_->{publisher} = $_->{publisher} =~ /^t/ ? TRUE : FALSE; delete $_->{rid}; } } ]], - } + }, + links => { + select => sql_extlinks('r'), + proc => sub { + my($e) = @_; + $e->{links} = []; + for my $l (keys $VNDB::ExtLinks::LINKS{r}->%*) { + my $i = $VNDB::ExtLinks::LINKS{r}{$l}; + my $v = $e->{$l}; + push $e->{links}->@*, + map +{ label => $i->{label}, url => sprintf($i->{fmt}, $_) }, + !$v || $v eq '{}' ? () : $v =~ /^{(.+)}$/ ? split /,/, $1 : ($v); + delete $e->{$l}; + } + }, + }, }, filters => { id => [ - [ 'int' => 'r.id :op: :value:', {qw|= = != <> > > >= >= < < <= <=|}, range => [1,1e6] ], - [ inta => 'r.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', range => [1,1e6] ], + [ 'int' => 'r.id :op: :value:', {qw|= = != <> > > >= >= < < <= <=|}, process => \'r' ], + [ inta => 'r.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'r' ], ], vn => [ - [ 'int' => 'r.id :op:(SELECT rv.id FROM releases_vn rv WHERE rv.vid = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6] ], - [ inta => 'r.id :op:(SELECT rv.id FROM releases_vn rv WHERE rv.vid IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', range => [1,1e6] ], + [ 'int' => 'r.id :op:(SELECT rv.id FROM releases_vn rv WHERE rv.vid = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'v' ], + [ inta => 'r.id :op:(SELECT rv.id FROM releases_vn rv WHERE rv.vid IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'v' ], ], producer => [ - [ 'int' => 'r.id IN(SELECT rp.id FROM releases_producers rp WHERE rp.pid = :value:)', {'=',1}, range => [1,1e6] ], + [ 'int' => 'r.id IN(SELECT rp.id FROM releases_producers rp WHERE rp.pid = :value:)', {'=',1}, process => \'p' ], ], title => [ - [ str => 'r.title :op: :value:', {qw|= = != <>|} ], - [ str => 'r.title ILIKE :value:', {'~',1}, process => \'like' ], + [ str => 'r.sorttitle :op: :value:', {qw|= = != <>|} ], + [ str => 'r.sorttitle ILIKE :value:', {'~',1}, process => \'like' ], ], original => [ - [ undef, "r.original :op: ''", {qw|= = != <>|} ], - [ str => 'r.original :op: :value:', {qw|= = != <>|} ], - [ str => 'r.original ILIKE :value:', {'~',1}, process => \'like' ] + [ undef, "r.title[4] :op: ''", {qw|= = != <>|} ], + [ str => 'r.title[4] :op: :value:', {qw|= = != <>|} ], + [ str => 'r.title[4] ILIKE :value:', {'~',1}, process => \'like' ] ], released => [ [ undef, 'r.released :op: 0', {qw|= = != <>|} ], @@ -701,7 +818,7 @@ my %GET_RELEASE = ( freeware => [ [ bool => 'r.freeware = :value:', {'=',1} ] ], doujin => [ [ bool => 'r.doujin = :value:', {'=',1} ] ], type => [ - [ str => 'r.type :op: :value:', {qw|= = != <>|}, + [ str => 'r.id :op:(SELECT rv.id FROM releases_vn rv WHERE rv.rtype = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => sub { !$RELEASE_TYPE{$_[0]} ? \'No such release type' : $_[0] } ], ], gtin => [ @@ -711,8 +828,8 @@ my %GET_RELEASE = ( [ str => 'r.catalog :op: :value:', {qw|= = != <>|} ], ], languages => [ - [ str => 'r.id :op:(SELECT rl.id FROM releases_lang rl WHERE rl.lang = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'lang' ], - [ stra => 'r.id :op:(SELECT rl.id FROM releases_lang rl WHERE rl.lang IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'lang' ], + [ str => 'r.id :op:(SELECT rl.id FROM releases_titles rl WHERE rl.lang = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'lang' ], + [ stra => 'r.id :op:(SELECT rl.id FROM releases_titles rl WHERE rl.lang IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'lang' ], ], platforms => [ [ str => 'r.id :op:(SELECT rp.id FROM releases_platforms rp WHERE rp.platform = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'plat' ], @@ -722,25 +839,25 @@ my %GET_RELEASE = ( ); my %GET_PRODUCER = ( - sql => 'SELECT %s FROM producers p WHERE NOT p.hidden AND (%s) %s', + sql => 'SELECT %s FROM producerst p WHERE NOT p.hidden AND (%s) %s', select => 'p.id', proc => sub { - $_[0]{id} *= 1 + $_[0]{id} = idnum $_[0]{id} }, sortdef => 'id', sorts => { id => 'p.id %s', - name => 'p.name %s', + name => 'p.name %s, p.id', }, flags => { basic => { - select => 'p.type, p.name, p.original, p.lang AS language', + select => 'p.type, p.title[2] AS name, p.title[4] AS original, p.lang AS language', proc => sub { - $_[0]{original} ||= undef; + $_[0]{original} = undef if $_[0]{name} eq $_[0]{original}; }, }, details => { - select => 'p.website, p.l_wp, p.l_wikidata, p.desc AS description, p.alias AS aliases', + select => 'p.website, p.l_wp, p.l_wikidata, p.description, p.alias AS aliases', proc => sub { $_[0]{description} ||= undef; $_[0]{aliases} ||= undef; @@ -752,15 +869,15 @@ my %GET_PRODUCER = ( }, }, relations => { - fetch => [[ 'id', 'SELECT pl.id AS pid, p.id, pl.relation, p.name, p.original FROM producers_relations pl - JOIN producers p ON p.id = pl.pid WHERE pl.id IN(%s)', + fetch => [[ 'id', 'SELECT pl.id AS pid, p.id, pl.relation, p.title[2] AS name, p.title[4] AS original FROM producers_relations pl + JOIN producerst p ON p.id = pl.pid WHERE pl.id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{relations} = [ grep $i->{id} == $_->{pid}, @$r ]; + $i->{relations} = [ grep $i->{id} eq $_->{pid}, @$r ]; } for (@$r) { - $_->{id}*=1; - $_->{original} ||= undef; + $_->{id} = idnum $_->{id}; + $_->{original} = undef if $_->{name} eq $_->{original}; delete $_->{pid}; } }, @@ -769,17 +886,17 @@ my %GET_PRODUCER = ( }, filters => { id => [ - [ 'int' => 'p.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 'p.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', range => [1,1e6] ], + [ 'int' => 'p.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, process => \'p' ], + [ inta => 'p.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'p' ], ], name => [ - [ str => 'p.name :op: :value:', {qw|= = != <>|} ], - [ str => 'p.name ILIKE :value:', {'~',1}, process => \'like' ], + [ str => 'p.title[2] :op: :value:', {qw|= = != <>|} ], + [ str => 'p.title[2] ILIKE :value:', {'~',1}, process => \'like' ], ], original => [ - [ undef, "p.original :op: ''", {qw|= = != <>|} ], - [ str => 'p.original :op: :value:', {qw|= = != <>|} ], - [ str => 'p.original ILIKE :value:', {'~',1}, process => \'like' ] + [ undef, "p.title[4] :op: ''", {qw|= = != <>|} ], + [ str => 'p.title[4] :op: :value:', {qw|= = != <>|} ], + [ str => 'p.title[4] ILIKE :value:', {'~',1}, process => \'like' ] ], type => [ [ str => 'p.type :op: :value:', {qw|= = != <>|}, @@ -790,51 +907,56 @@ my %GET_PRODUCER = ( [ stra => 'p.lang :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'lang' ], ], search => [ - [ str => '(p.name ILIKE :value: OR p.original ILIKE :value: OR p.alias ILIKE :value:)', {'~',1}, process => \'like' ], + [ str => 'EXISTS(SELECT 1 FROM search_cache sc WHERE sc.id = p.id AND sc.label LIKE ALL (search_query(:value:)))', {'~',1} ], ], }, ); my %GET_CHARACTER = ( - sql => 'SELECT %s FROM chars c WHERE NOT c.hidden AND (%s) %s', + sql => 'SELECT %s FROM charst c LEFT JOIN images i ON i.id = c.image WHERE NOT c.hidden AND (%s) %s', select => 'c.id', proc => sub { - $_[0]{id} *= 1 + $_[0]{id} = idnum $_[0]{id}; }, sortdef => 'id', sorts => { id => 'c.id %s', - name => 'c.name %s', + name => 'c.name %s, c.id', }, flags => { basic => { - select => 'c.name, c.original, c.gender, c.bloodt, c.b_day, c.b_month', + select => 'c.title[2] AS name, c.title[4] AS original, c.gender, c.spoil_gender, c.bloodt, c.b_day, c.b_month', proc => sub { - $_[0]{original} ||= undef; + $_[0]{original} = undef if $_[0]{original} eq $_[0]{name}; $_[0]{gender} = undef if $_[0]{gender} eq 'unknown'; $_[0]{bloodt} = undef if $_[0]{bloodt} eq 'unknown'; $_[0]{birthday} = [ delete($_[0]{b_day})*1||undef, delete($_[0]{b_month})*1||undef ]; }, }, details => { - select => 'c.alias AS aliases, c.image, c."desc" AS description', + select => 'c.alias AS aliases, c.image, i.c_sexual_avg, i.c_violence_avg, i.c_votecount, i.width AS image_width, i.height AS image_height, c.description, c.age', proc => sub { $_[0]{aliases} ||= undef; - $_[0]{image} = $_[0]{image} ? sprintf '%s/ch/%02d/%d.jpg', config->{url_static}, $_[0]{image}%100, $_[0]{image} : undef; $_[0]{description} ||= undef; + $_[0]{image} = $_[0]{image} ? imgurl $_[0]{image} : undef; + $_[0]{image_flagging} = image_flagging $_[0]{image}, $_[0]; + $_[0]{image_width} *=1 if defined $_[0]{image_width}; + $_[0]{image_height} *=1 if defined $_[0]{image_height}; + $_[0]{age}*=1 if defined $_[0]{age}; }, }, meas => { - select => 'c.s_bust AS bust, c.s_waist AS waist, c.s_hip AS hip, c.height, c.weight', + select => 'c.s_bust AS bust, c.s_waist AS waist, c.s_hip AS hip, c.height, c.weight, c.cup_size', proc => sub { $_[0]{$_} = $_[0]{$_} ? $_[0]{$_}*1 : undef for(qw|bust waist hip height weight|); + $_[0]{cup_size} ||= undef; }, }, traits => { fetch => [[ 'id', 'SELECT id, tid, spoil FROM chars_traits WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{traits} = [ map [ $_->{tid}*1, $_->{spoil}*1 ], grep $i->{id} == $_->{id}, @$r ]; + $i->{traits} = [ map [ idnum($_->{tid}), $_->{spoil}*1 ], grep $i->{id} eq $_->{id}, @$r ]; } }, ]], @@ -843,7 +965,7 @@ my %GET_CHARACTER = ( fetch => [[ 'id', 'SELECT id, vid, rid, spoil, role FROM chars_vns WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{vns} = [ map [ $_->{vid}*1, ($_->{rid}||0)*1, $_->{spoil}*1, $_->{role} ], grep $i->{id} == $_->{id}, @$r ]; + $i->{vns} = [ map [ idnum($_->{vid}), idnum($_->{rid}||0), $_->{spoil}*1, $_->{role} ], grep $i->{id} eq $_->{id}, @$r ]; } }, ]], @@ -854,12 +976,12 @@ my %GET_CHARACTER = ( WHERE vs.cid IN(%s) AND NOT v.hidden AND NOT s.hidden', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{voiced} = [ grep $i->{id} == $_->{cid}, @$r ]; + $i->{voiced} = [ grep $i->{id} eq $_->{cid}, @$r ]; } for (@$r) { - $_->{id}*=1; + $_->{id} = idnum $_->{id}; $_->{aid}*=1; - $_->{vid}*=1; + $_->{vid} = idnum $_->{vid}; $_->{note} ||= undef; delete $_->{cid}; } @@ -867,15 +989,15 @@ my %GET_CHARACTER = ( ]] }, instances => { - fetch => [[ 'id', 'SELECT c2.id AS cid, c.id, c.name, c.original, c2.main_spoil AS spoiler FROM chars c2 JOIN chars c ON c.id = c2.main OR c.main = c2.main WHERE c2.id IN(%s) - UNION SELECT c.main AS cid, c.id, c.name, c.original, c.main_spoil AS spoiler FROM chars c WHERE c.main IN(%1$s)', + fetch => [[ 'id', 'SELECT c2.id AS cid, c.id, c.title[2] AS name, c.title[4] AS original, c2.main_spoil AS spoiler FROM chars c2 JOIN charst c ON c.id = c2.main OR c.main = c2.main WHERE c2.id IN(%s) + UNION SELECT c.main AS cid, c.id, c.title[2] AS name, c.title[4] AS original, c.main_spoil AS spoiler FROM charst c WHERE c.main IN(%1$s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{instances} = [ grep $i->{id} == $_->{cid} && $_->{id} != $i->{id}, @$r ]; + $i->{instances} = [ grep $i->{id} eq $_->{cid} && $_->{id} ne $i->{id}, @$r ]; } for (@$r) { - $_->{id}*=1; - $_->{original} ||= undef; + $_->{id} = idnum $_->{id}; + $_->{original} = undef if $_->{original} eq $_->{name}; $_->{spoiler}*=1; delete $_->{cid}; } @@ -885,38 +1007,38 @@ my %GET_CHARACTER = ( }, filters => { id => [ - [ 'int' => 'c.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 'c.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6], join => ',' ], + [ 'int' => 'c.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, process => \'c' ], + [ inta => 'c.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'c', join => ',' ], ], name => [ - [ str => 'c.name :op: :value:', {qw|= = != <>|} ], - [ str => 'c.name ILIKE :value:', {'~',1}, process => \'like' ], + [ str => 'c.title[2] :op: :value:', {qw|= = != <>|} ], + [ str => 'c.title[2] ILIKE :value:', {'~',1}, process => \'like' ], ], original => [ - [ undef, "c.original :op: ''", {qw|= = != <>|} ], - [ str => 'c.original :op: :value:', {qw|= = != <>|} ], - [ str => 'c.original ILIKE :value:', {'~',1}, process => \'like' ] + [ undef, "c.title[4] :op: ''", {qw|= = != <>|} ], + [ str => 'c.title[4] :op: :value:', {qw|= = != <>|} ], + [ str => 'c.title[4] ILIKE :value:', {'~',1}, process => \'like' ] ], search => [ - [ str => '(c.name ILIKE :value: OR c.original ILIKE :value: OR c.alias ILIKE :value:)', {'~',1}, process => \'like' ], + [ str => 'EXISTS(SELECT 1 FROM search_cache sc WHERE sc.id = c.id AND sc.label LIKE ALL (search_query(:value:)))', {'~',1} ], ], vn => [ - [ 'int' => 'c.id IN(SELECT cv.id FROM chars_vns cv WHERE cv.vid = :value:)', {'=',1}, range => [1,1e6] ], - [ inta => 'c.id IN(SELECT cv.id FROM chars_vns cv WHERE cv.vid IN(:value:))', {'=',1}, range => [1,1e6], join => ',' ], + [ 'int' => 'c.id IN(SELECT cv.id FROM chars_vns cv WHERE cv.vid = :value:)', {'=',1}, process => \'v' ], + [ inta => 'c.id IN(SELECT cv.id FROM chars_vns cv WHERE cv.vid IN(:value:))', {'=',1}, process => \'v', join => ',' ], ], traits => [ - [ int => 'c.id :op:(SELECT tc.cid FROM traits_chars tc WHERE tc.tid = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6] ], - [ inta => 'c.id :op:(SELECT tc.cid FROM traits_chars tc WHERE tc.tid IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', range => [1,1e6] ], + [ int => 'c.id :op:(SELECT tc.cid FROM traits_chars tc WHERE tc.tid = :value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'i' ], + [ inta => 'c.id :op:(SELECT tc.cid FROM traits_chars tc WHERE tc.tid IN(:value:))', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'i' ], ], }, ); my %GET_STAFF = ( - sql => 'SELECT %s FROM staff s JOIN staff_alias sa ON sa.aid = s.aid WHERE NOT s.hidden AND (%s) %s', + sql => 'SELECT %s FROM staff_aliast s WHERE s.aid = s.main AND NOT s.hidden AND (%s) %s', select => 's.id', proc => sub { - $_[0]{id} *= 1 + $_[0]{id} = idnum $_[0]{id}; }, sortdef => 'id', sorts => { @@ -924,14 +1046,14 @@ my %GET_STAFF = ( }, flags => { basic => { - select => 'sa.name, sa.original, s.gender, s.lang AS language', + select => 's.title[2] AS name, s.title[4] AS original, s.gender, s.lang AS language', proc => sub { - $_[0]{original} ||= undef; + $_[0]{original} = undef if $_[0]{original} eq $_[0]{name}; $_[0]{gender} = undef if $_[0]{gender} eq 'unknown'; }, }, details => { - select => 's."desc" AS description, s.l_wp, s.l_site, s.l_twitter, s.l_anidb, s.l_wikidata, s.l_pixiv', + select => 's.description, s.l_wp, s.l_site, s.l_twitter, s.l_anidb, s.l_wikidata, s.l_pixiv', proc => sub { $_[0]{description} ||= undef; $_[0]{links} = { @@ -949,10 +1071,10 @@ my %GET_STAFF = ( proc => sub { $_[0]{main_alias} = delete($_[0]{aid})*1; }, - fetch => [[ 'id', 'SELECT id, aid, name, original FROM staff_alias WHERE id IN(%s)', + fetch => [[ 'id', 'SELECT id, aid, title[2] AS name, title[4] AS original FROM staff_aliast WHERE id IN(%s)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{aliases} = [ map [ $_->{aid}*1, $_->{name}, $_->{original}||undef ], grep $i->{id} == $_->{id}, @$r ]; + $i->{aliases} = [ map [ $_->{aid}*1, $_->{name}, $_->{original} eq $_->{name} ? undef : $_->{original} ], grep $i->{id} eq $_->{id}, @$r ]; } }, ]], @@ -963,10 +1085,10 @@ my %GET_STAFF = ( WHERE sa.id IN(%s) AND NOT v.hidden', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{vns} = [ grep $i->{id} == $_->{sid}, @$r ]; + $i->{vns} = [ grep $i->{id} eq $_->{sid}, @$r ]; } for (@$r) { - $_->{id}*=1; + $_->{id} = idnum $_->{id}; $_->{aid}*=1; $_->{note} ||= undef; delete $_->{sid}; @@ -980,12 +1102,12 @@ my %GET_STAFF = ( WHERE sa.id IN(%s) AND NOT v.hidden', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{voiced} = [ grep $i->{id} == $_->{sid}, @$r ]; + $i->{voiced} = [ grep $i->{id} eq $_->{sid}, @$r ]; } for (@$r) { - $_->{id}*=1; + $_->{id} = idnum $_->{id}; $_->{aid}*=1; - $_->{cid}*=1; + $_->{cid} = idnum $_->{cid}; $_->{note} ||= undef; delete $_->{sid}; } @@ -995,36 +1117,54 @@ my %GET_STAFF = ( }, filters => { id => [ - [ 'int' => 's.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 's.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6], join => ',' ], + [ 'int' => 's.id :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, process => \'s' ], + [ inta => 's.id :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'s' ], ], aid => [ [ 'int' => 's.id IN(SELECT sa.id FROM staff_alias sa WHERE sa.aid = :value:)', {'=',1}, range => [1,1e6] ], [ inta => 's.id IN(SELECT sa.id FROM staff_alias sa WHERE sa.aid IN(:value:))', {'=',1}, range => [1,1e6], join => ',' ], ], search => [ - [ str => 's.id IN(SELECT sa.id FROM staff_alias sa WHERE sa.name ILIKE :value: OR sa.original ILIKE :value:)', {'~',1}, process => \'like' ], + [ str => 'EXISTS(SELECT 1 FROM search_cache sc WHERE sc.id = s.id AND sc.label LIKE ALL (search_query(:value:)))', {'~',1} ], ], }, ); +my %GET_QUOTE = ( + sql => "SELECT %s FROM quotes q JOIN vnt v ON v.id = q.vid WHERE q.rand IS NOT NULL AND NOT v.hidden AND (%s) %s", + select => "v.id, v.title[2], q.quote", + proc => sub { + $_[0]{id} = idnum $_[0]{id}; + }, + sortdef => 'random', + sorts => { id => 'q.vid %s', random => 'RANDOM() %s' }, + flags => { basic => {} }, + filters => { + id => [ + [ 'int' => 'q.vid :op: :value:', {qw|= = != <> > > >= >= < < <= <=|}, process => \'v' ], + [ inta => 'q.vid :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, join => ',', process => \'v' ], + ] + }, +); + + # All user ID filters consider uid=0 to be the logged in user. Needs a special processing function to handle that. -sub subst_user_id { my($id, $c) = @_; !$id && !$c->{uid} ? \'Not logged in.' : $id || $c->{uid} } +sub subst_user_id { my($id, $c) = @_; $id && $id =~ /^[1-9][0-9]{0,6}$/ ? "u$id" : ($c->{uid} || \'Not logged in.') } my %GET_USER = ( sql => "SELECT %s FROM users u WHERE (%s) %s", select => "id, username", proc => sub { - $_[0]{id}*=1; + $_[0]{id} = idnum $_[0]{id}; }, sortdef => 'id', sorts => { id => 'id %s' }, flags => { basic => {} }, filters => { id => [ - [ 'int' => 'u.id :op: :value:', {qw|= =|}, range => [0,1e6], process => \&subst_user_id ], - [ inta => 'u.id IN(:value:)', {'=',1}, range => [0,1e6], join => ',', process => \&subst_user_id ], + [ 'int' => 'u.id :op: :value:', {qw|= =|}, process => \&subst_user_id ], + [ inta => 'u.id IN(:value:)', {'=',1}, join => ',', process => \&subst_user_id ], ], username => [ [ str => 'u.username :op: :value:', {qw|= = != <>|} ], @@ -1036,25 +1176,23 @@ my %GET_USER = ( # the uid filter for votelist/vnlist/wishlist -my $UID_FILTER = [ 'int' => 'uv.uid :op: :value:', {qw|= =|}, range => [0,1e6], process => \&subst_user_id ]; +my $UID_FILTER = [ 'int' => 'uv.uid :op: :value:', {qw|= =|}, process => \&subst_user_id ]; # Similarly, a filter for 'vid' my $VN_FILTER = [ - [ 'int' => 'uv.vid :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, range => [1,1e6] ], - [ inta => 'uv.vid :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, range => [1,1e6], join => ',' ], + [ 'int' => 'uv.vid :op: :value:', {qw|= = != <> > > < < <= <= >= >=|}, process => \'v' ], + [ inta => 'uv.vid :op:(:value:)', {'=' => 'IN', '!=' => 'NOT IN'}, process => \'v', 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 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", + sql => "SELECT %s FROM ulist_vns uv WHERE vote IS NOT NULL AND (%s ) AND NOT c_private %s", + sqluser => "SELECT %1\$s FROM ulist_vns uv WHERE vote IS NOT NULL AND (%2\$s) AND (uid = %4\$s OR NOT c_private) %3\$s", + select => "uid AS uid, vid as vn, vote, extract('epoch' from vote_date) AS added", proc => sub { - $_[0]{uid}*=1; - $_[0]{vn}*=1; + $_[0]{uid} = idnum $_[0]{uid}; + $_[0]{vn} = idnum $_[0]{vn}; $_[0]{vote}*=1; $_[0]{added} = int $_[0]{added}; }, @@ -1064,44 +1202,40 @@ 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 $SQL_VNLIST = "FROM ulist_vns uv WHERE (labels IN('{}','{7}') OR labels && ARRAY[1,2,3,4]::smallint[])"; my %GET_VNLIST = ( islist => 1, - 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", + sql => "SELECT %s $SQL_VNLIST AND (%s) AND NOT c_private %s", + sqluser => "SELECT %1\$s $SQL_VNLIST AND (%2\$s) AND (uid = %4\$s OR NOT c_private) %3\$s", + select => "uid AS uid, vid as vn, labels, extract('epoch' from added) AS added, notes", proc => sub { - $_[0]{uid}*=1; - $_[0]{vn}*=1; - $_[0]{status} = defined $_[0]{status} ? $_[0]{status}*1 : 0; + $_[0]{uid} = idnum $_[0]{uid}; + $_[0]{vn} = idnum $_[0]{vn}; + my @labels = delete($_[0]{labels}) =~ /^{(.+)}$/ ? split /,/, $1 : (); + $_[0]{status} = 1*(max(grep $_ <= 4, @labels) || 0); $_[0]{added} = int $_[0]{added}; $_[0]{notes} ||= undef; }, sortdef => 'vn', - sorts => { vn => 'uv.vid %s' }, + sorts => { vn => '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 $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", + sql => "SELECT %s FROM ulist_vns uv WHERE labels && ARRAY[5,6]::smallint[] AND (%s) AND NOT c_private %s", + sqluser => "SELECT %1\$s FROM ulist_vns uv WHERE labels && ARRAY[5,6]::smallint[] AND (%2\$s) AND (uid = %4\$s OR NOT c_private) %3\$s", + select => "uid AS uid, vid AS vn, CASE WHEN labels && ARRAY[6]::smallint[] THEN 3 ELSE 1 END AS priority, extract('epoch' from added) AS added", proc => sub { - $_[0]{uid}*=1; - $_[0]{vn}*=1; - $_[0]{priority} = {'Wishlist-High' => 0, 'Wishlist-Medium' => 1, 'Wishlist-Low' => 2, 'Blacklist' => 3}->{$_[0]{priority}}//1; + $_[0]{uid} = idnum $_[0]{uid}; + $_[0]{vn} = idnum $_[0]{vn}; + $_[0]{priority} *= 1; $_[0]{added} = int $_[0]{added}; }, sortdef => 'vn', - sorts => { vn => 'uv.vid %s' }, + sorts => { vn => 'vid %s' }, flags => { basic => {} }, filters => { uid => [ $UID_FILTER ], vn => $VN_FILTER } ); @@ -1109,11 +1243,11 @@ my %GET_WISHLIST = ( my %GET_ULIST_LABELS = ( islist => 1, sql => 'SELECT %s FROM ulist_labels uv WHERE (%s) AND NOT uv.private %s', - sqluser => 'SELECT %1$s FROM ulist_labels uv WHERE (%2$s) AND (uv.uid = %4$d OR NOT uv.private) %3$s', - select => 'uid, id, label, private', + sqluser => 'SELECT %1$s FROM ulist_labels uv WHERE (%2$s) AND (uv.uid = %4$s OR NOT uv.private) %3$s', + select => 'uid AS uid, id, label, private', proc => sub { - $_[0]{uid}*=1; - $_[0]{id}*=1; + $_[0]{uid} = idnum $_[0]{uid}; + $_[0]{id} = idnum $_[0]{id}; $_[0]{private} = $_[0]{private} =~ /^t/ ? TRUE : FALSE; }, sortdef => 'id', @@ -1122,15 +1256,14 @@ my %GET_ULIST_LABELS = ( filters => { uid => [ $UID_FILTER ] }, ); -my $ULIST_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_ULIST = ( islist => 1, - sql => "SELECT %s FROM ulist_vns uv WHERE (%s) AND ($ULIST_PUBLIC) %s", - sqluser => "SELECT %1\$s FROM ulist_vns uv WHERE (%2\$s) AND (uv.uid = %4\$d OR $ULIST_PUBLIC) %3\$s", - select => "uid, vid as vn, extract('epoch' from added) AS added, extract('epoch' from lastmod) AS lastmod, extract('epoch' from vote_date) AS voted, vote, started, finished, notes", + sql => "SELECT %s FROM ulist_vns uv WHERE (%s ) AND NOT c_private %s", + sqluser => "SELECT %1\$s FROM ulist_vns uv WHERE (%2\$s) AND (uid = %4\$s OR NOT uv.c_private) %3\$s", + select => "uid AS uid, vid as vn, extract('epoch' from added) AS added, extract('epoch' from lastmod) AS lastmod, extract('epoch' from vote_date) AS voted, vote, started, finished, notes", proc => sub { - $_[0]{uid}*=1; - $_[0]{vn}*=1; + $_[0]{uid} = idnum $_[0]{uid}; + $_[0]{vn} = idnum $_[0]{vn}; $_[0]{added} = int $_[0]{added}; $_[0]{lastmod} = int $_[0]{lastmod}; $_[0]{voted} = int $_[0]{voted} if $_[0]{voted}; @@ -1149,15 +1282,17 @@ my %GET_ULIST = ( flags => { basic => {}, labels => { - fetch => [[ ['uid','vn'], 'SELECT uvl.uid, uvl.vid, ul.id, ul.label - FROM ulist_vns_labels uvl JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl - WHERE (uvl.uid,uvl.vid) IN(%s) AND (NOT ul.private OR uvl.uid = %s)', + fetch => [[ ['uid','vn'], 'SELECT uv.uid, uv.vid, ul.id, ul.label + FROM ulist_vns uv + JOIN unnest(uv.labels) l(id) ON true + JOIN ulist_labels ul ON ul.uid = uv.uid AND ul.id = l.id + WHERE (uv.uid,uv.vid) IN(%s) AND (NOT ul.private OR uv.uid = %s OR ul.id = 7)', sub { my($n, $r) = @_; for my $i (@$n) { - $i->{labels} = [ grep $i->{uid} == $_->{uid} && $i->{vn} == $_->{vid}, @$r ]; + $i->{labels} = [ grep $i->{uid} eq $_->{uid} && $i->{vn} eq $_->{vid}, @$r ]; } for (@$r) { - $_->{id}*=1; + $_->{id} = idnum $_->{id}; delete $_->{uid}; delete $_->{vid}; } @@ -1169,8 +1304,7 @@ my %GET_ULIST = ( uid => [ $UID_FILTER ], vn => $VN_FILTER, label => [ - [ 'int' => '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 uvl.lbl = :value: AND NOT ul.private)', {'=',1}, range => [1,1e6] ], + [ 'int' => '(:value: = 7 OR EXISTS(SELECT 1 FROM ulist_labels ul WHERE ul.uid = uv.uid AND ul.id = :value: AND NOT ul.private)) AND labels && ARRAY[:value:]::smallint[]', {'=',1}, range => [1,32000] ], ], }, ); @@ -1182,6 +1316,7 @@ my %GET = ( producer => \%GET_PRODUCER, character => \%GET_CHARACTER, staff => \%GET_STAFF, + quote => \%GET_QUOTE, user => \%GET_USER, votelist => \%GET_VOTELIST, vnlist => \%GET_VNLIST, @@ -1285,6 +1420,9 @@ sub get_filters { return cerr $c, filter => 'Invalid language code', %e if !$LANGUAGE{$v}; } elsif(${$o{process}} eq 'plat') { return cerr $c, filter => 'Invalid platform code', %e if !$PLATFORM{$v}; + } elsif(length ${$o{process}} == 1) { + return cerr $c, filter => 'Invalid identifier', %e if $v !~ /^[1-9][0-9]{0,6}$/; + $v = ${$o{process}}.$v; } } @@ -1344,7 +1482,7 @@ sub get_mainsql { $sql = $type->{sqluser} if $c->{uid} && $type->{sqluser}; no if $] >= 5.022, warnings => 'redundant'; - cpg $c, sprintf($sql, $select, $where, $last, $c->{uid}), \@placeholders, sub { + cpg $c, sprintf($sql, $select, $where, $last, $c->{uid} ? "'$c->{uid}'" : 'NULL'), \@placeholders, sub { my @res = $_[0]->rowsAsHashes; $get->{more} = pop(@res)&&1 if @res > $get->{opt}{results}; $get->{list} = \@res; @@ -1369,7 +1507,7 @@ sub get_fetch { my @ids = map { my $d=$_; ref $field ? @{$d}{@$field} : ($d->{$field}) } @{$get->{list}}; my $ids = join ',', map { ref $field ? '('.join(',', map '$'.$ref++, @$field).')' : '$'.$ref++ } 1..@{$get->{list}}; no warnings 'redundant'; - cpg $c, sprintf($need{$n}[1], $ids, $c->{uid}||'NULL'), \@ids, sub { + cpg $c, sprintf($need{$n}[1], $ids, $c->{uid} ? "'$c->{uid}'" : 'NULL'), \@ids, sub { $get->{fetched}{$n} = [ $need{$n}[2], [$_[0]->rowsAsHashes] ]; delete $need{$n}; get_final($c, $type, $get) if !keys %need; @@ -1438,14 +1576,16 @@ 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 + cpg $obj->{c}, 'SELECT update_users_ulist_private($1, $2)', [ $c->{uid}, 'v'.$obj->{id} ], sub { + setpg $obj, 'SELECT update_users_ulist_stats($1)', [ $c->{uid} ]; + }; } sub set_votelist { my($c, $obj) = @_; - return cpg $c, 'UPDATE ulist_vns SET vote = NULL, vote_date = NULL WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { + return cpg $c, 'UPDATE ulist_vns SET vote = NULL, vote_date = NULL WHERE uid = $1 AND vid = $2', [ $c->{uid}, 'v'.$obj->{id} ], sub { set_ulist_ret $c, $obj } if !$obj->{opt}; @@ -1454,7 +1594,7 @@ sub set_votelist { return cerr $c, badarg => 'Invalid vote', field => 'vote' if ref($vv) || !defined($vv) || $vv !~ /^\d+$/ || $vv < 10 || $vv > 100; 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; } + [ $c->{uid}, 'v'.$obj->{id}, $vv ], sub { set_ulist_ret $c, $obj; } } @@ -1462,7 +1602,7 @@ sub set_vnlist { my($c, $obj) = @_; # 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 { + return cpg $c, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', [ $c->{uid}, 'v'.$obj->{id} ], sub { set_ulist_ret $c, $obj; } if !$obj->{opt}; @@ -1474,33 +1614,24 @@ sub set_vnlist { $vs ||= 0; $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; - } - } + my $l = 'array_remove(array_remove(array_remove(array_remove(ulist_vns.labels, 1), 2), 3), 4)'; + cpg $c, q{ + INSERT INTO ulist_vns (uid, vid, notes, labels) + VALUES ($1, $2, $3, CASE WHEN $4 = 0 THEN '{}' ELSE ARRAY[$4]::smallint[] END) + ON CONFLICT (uid, vid) DO UPDATE SET lastmod = NOW()} + .($en ? ', notes = $3' : '') + .($es ? ', labels = CASE WHEN $4 = 0 THEN '.$l.' ELSE array_set('.$l.', $4) END' : ''), + [ $c->{uid}, 'v'.$obj->{id}, $vn, $vs ], sub { set_ulist_ret $c, $obj; }; } sub set_wishlist { my($c, $obj) = @_; - - 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')))"; + my $l = 'array_remove(array_remove(ulist_vns.labels,5),6)'; # 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 { + return cpg $c, "UPDATE ulist_vns SET labels = $l, lastmod = NOW() WHERE uid = \$1 AND vid = \$2", + [ $c->{uid}, 'v'.$obj->{id} ], sub { set_ulist_ret $c, $obj; } if !$obj->{opt}; @@ -1508,33 +1639,25 @@ sub set_wishlist { 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]$/; - # 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; - } - } - } - } + my $label = $vp == 3 ? 6 : 5; # Other statuses are not supported anymore. + cpg $c, + 'INSERT INTO ulist_vns (uid, vid, labels) VALUES ($1, $2, ARRAY[$3]::smallint[]) + ON CONFLICT (uid,vid) DO UPDATE SET lastmod = NOW(), labels = array_set('.$l.', $3)', + [ $c->{uid}, 'v'.$obj->{id}, $label ], + sub { set_ulist_ret $c, $obj }; } + sub set_ulist { my($c, $obj) = @_; - return cpg $c, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { + return cpg $c, 'DELETE FROM ulist_vns WHERE uid = $1 AND vid = $2', [ $c->{uid}, 'v'.$obj->{id} ], sub { set_ulist_ret $c, $obj; } if !$obj->{opt}; my $opt = $obj->{opt}; my @set; - my @bind = ($c->{uid}, $obj->{id}); + my @bind = ($c->{uid}, 'v'.$obj->{id}); if(exists $opt->{vote}) { return cerr $c, badarg => 'Invalid vote', field => 'vote' if defined($opt->{vote}) && (ref $opt->{vote} || $opt->{vote} !~ /^[0-9]+$/ || $opt->{vote} < 10 || $opt->{vote} > 100); @@ -1564,20 +1687,15 @@ sub set_ulist { return cerr $c, badarg => "Labels field expects an array", field => 'labels' if ref $opt->{labels} ne 'ARRAY'; return cerr $c, badarg => "Invalid label: '$_'", field => 'labels' for grep !defined($_) || ref($_) || !/^[0-9]+$/, $opt->{labels}->@*; my %l = map +($_,1), grep $_ != 7, $opt->{labels}->@*; - # XXX: This is ugly. Errors (especially: unknown labels) are ignored and - # the entire set operation ought to run in a single transaction. - pg_cmd 'SELECT lbl FROM ulist_vns_labels WHERE uid = $1 AND vid = $2', [ $c->{uid}, $obj->{id} ], sub { - return if pg_expect $_[0]; - my %ids = map +($_->{lbl}, 1), $_[0]->rowsAsHashes; - pg_cmd 'INSERT INTO ulist_vns_labels (uid, vid, lbl) VALUES ($1,$2,$3)', [ $c->{uid}, $obj->{id}, $_ ] for grep !$ids{$_}, keys %l; - pg_cmd 'DELETE FROM ulist_vns_labels WHERE uid = $1 AND vid = $2 AND lbl = $3', [ $c->{uid}, $obj->{id}, $_ ] for grep !$l{$_}, keys %ids; - }; + # XXX: Labels aren't validated here, so we might actually be writing garbage into the DB. Rest of the code doesn't mind that too much, though. + push @bind, '{'.join(',',sort { $a <=> $b } keys %l).'}'; + push @set, 'labels = $'.@bind; } - push @set, 'lastmod = NOW()' if @set || $opt->{labels}; + push @set, 'lastmod = NOW()' if @set; 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 { + cpg $c, 'INSERT INTO ulist_vns (uid, vid) VALUES ($1, $2) ON CONFLICT (uid, vid) DO NOTHING', [ $c->{uid}, 'v'.$obj->{id} ], sub { cpg $c, 'UPDATE ulist_vns SET '.join(',', @set).' WHERE uid = $1 AND vid = $2', \@bind, sub { set_ulist_ret $c, $obj; } |