summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2017-12-28 11:47:57 +0100
committerYorhel <git@yorhel.nl>2017-12-31 13:45:02 +0100
commit771d9b9e88c6fc888248fc93efb0ada5589ff338 (patch)
tree092acaea9fdbad6c9e1a8c5493821021b8202086
parent730b7ebbd1ca5a87fa5fc4532e8405edd4d4d1d3 (diff)
Kind-of starting on a v33.0-alpha
-rw-r--r--lib/VNDB/Auth.pm181
-rw-r--r--lib/VNDB/DB/Affiliates.pm73
-rw-r--r--lib/VNDB/DB/Chars.pm188
-rw-r--r--lib/VNDB/DB/Discussions.pm351
-rw-r--r--lib/VNDB/DB/Misc.pm125
-rw-r--r--lib/VNDB/DB/Producers.pm131
-rw-r--r--lib/VNDB/DB/Releases.pm253
-rw-r--r--lib/VNDB/DB/Staff.pm196
-rw-r--r--lib/VNDB/DB/Tags.pm275
-rw-r--r--lib/VNDB/DB/Traits.pm111
-rw-r--r--lib/VNDB/DB/ULists.pm353
-rw-r--r--lib/VNDB/DB/Users.pm283
-rw-r--r--lib/VNDB/DB/VN.pm365
-rw-r--r--lib/VNDB/Func.pm342
-rw-r--r--lib/VNDB/Handler/Affiliates.pm152
-rw-r--r--lib/VNDB/Handler/Chars.pm586
-rw-r--r--lib/VNDB/Handler/Discussions.pm703
-rw-r--r--lib/VNDB/Handler/Misc.pm414
-rw-r--r--lib/VNDB/Handler/Producers.pm494
-rw-r--r--lib/VNDB/Handler/Releases.pm655
-rw-r--r--lib/VNDB/Handler/Staff.pm392
-rw-r--r--lib/VNDB/Handler/Tags.pm762
-rw-r--r--lib/VNDB/Handler/Traits.pm432
-rw-r--r--lib/VNDB/Handler/ULists.pm522
-rw-r--r--lib/VNDB/Handler/Users.pm825
-rw-r--r--lib/VNDB/Handler/VNBrowse.pm138
-rw-r--r--lib/VNDB/Handler/VNEdit.pm545
-rw-r--r--lib/VNDB/Handler/VNPage.pm982
-rw-r--r--lib/VNDB/Util/Auth.pm227
-rw-r--r--lib/VNDB/Util/BrowseHTML.pm223
-rw-r--r--lib/VNDB/Util/CommonHTML.pm477
-rw-r--r--lib/VNDB/Util/FormHTML.pm277
-rw-r--r--lib/VNDB/Util/LayoutHTML.pm204
-rw-r--r--lib/VNDB/Util/Misc.pm175
-rw-r--r--lib/VNDB/Util/ValidateTemplates.pm103
-rw-r--r--lib/VNDB/VN/Page.pm57
-rw-r--r--static/f/style.css268
-rwxr-xr-xutil/vndb.pl99
38 files changed, 528 insertions, 12411 deletions
diff --git a/lib/VNDB/Auth.pm b/lib/VNDB/Auth.pm
new file mode 100644
index 00000000..ca0e785e
--- /dev/null
+++ b/lib/VNDB/Auth.pm
@@ -0,0 +1,181 @@
+# This package provides a 'tuwf->auth' method and a useful object for dealing
+# with VNDB sessions. Usage:
+#
+# use VNDB::Auth;
+#
+# if(auth) {
+# ..user is logged in
+# }
+# ..or:
+# if(tuwf->auth) { .. }
+#
+# my $success = auth->login($user, $pass);
+# auth->logout;
+#
+# my $uid = auth->uid;
+# my $username = auth->username;
+# ..etc
+#
+# die "You're not allowed to post!" if !tuwf->auth->permBoard;
+#
+package VNDB::Auth;
+
+use strict;
+use warnings;
+use Moo;
+use TUWF;
+use SQL::Yapp dbh => sub { tuwf->dbh };
+use Exporter 'import';
+
+use Digest::SHA qw|sha1 sha1_hex|;
+use Crypt::URandom 'urandom';
+use Crypt::ScryptKDF 'scrypt_raw';
+use Encode 'encode_utf8';
+
+our @EXPORT = ('auth');
+sub auth { tuwf->{auth} }
+
+
+TUWF::hook before => sub {
+ my $cookie = tuwf->reqCookie('auth')||'';
+ my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1_hex pack 'H*', $1) : (0, '');
+
+ tuwf->{auth} = __PACKAGE__->new(%{ tuwf->conf->{auth} || {} });
+ tuwf->{auth}->_load_session($uid, $token_e);
+ 1;
+};
+
+
+TUWF::hook after => sub { tuwf->{auth} = __PACKAGE__->new };
+
+
+# log user IDs (necessary for determining performance issues, user preferences
+# have a lot of influence in this)
+TUWF::set log_format => sub {
+ my($self, $uri, $msg) = @_;
+ sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri, $self->auth ? $self->auth->uid : '-', $msg;
+};
+
+
+
+use overload bool => sub { defined shift->uid };
+
+has uid => (is => 'ro');
+has token => (is => 'ro');
+has username => (is => 'ro');
+has perm => (is => 'ro', default => 0);
+
+
+
+# The 'perm' field is a bit field, with the following bits.
+# The 'usermod' flag is hardcoded in sql/func.sql for the user_* functions.
+# Flag 8 was used for 'staffedit', but is now free for re-use.
+my %perms = qw{
+ 1 board
+ 2 boardmod
+ 4 edit
+ 16 tag
+ 32 dbmod
+ 64 tagmod
+ 128 usermod
+ 256 affiliate
+};
+
+
+# Create a read-only accessor to check if the current user is authorized to
+# perform a particular action.
+for my $perm (keys %perms) {
+ has 'perm'.ucfirst($perm),
+ is => 'ro',
+ lazy => 1,
+ builder => sub { (shift->perm() & $perms{$perm}) > 0 };
+}
+
+
+sub _randomascii {
+ return join '', map chr($_%92+33), unpack 'C*', urandom shift;
+}
+
+
+# Prepares a plaintext password for database storage
+# Arguments: pass, optionally: salt, N, r, p
+# Returns: encrypted password (as a binary string)
+sub _preparepass {
+ my($self, $pass, $salt, $N, $r, $p) = @_;
+ ($N, $r, $p) = @{$self->{scrypt_args}} if !$N;
+ $salt ||= urandom(8);
+ return pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw($pass, $self->{scrypt_salt} . $salt, $N, $r, $p, 32);
+}
+
+
+# Arguments: self, uid, encpass
+# Returns: 0 on error, 1 on success
+sub _create_session {
+ my($self, $uid, $encpass) = @_;
+
+ my $token = urandom 20;
+ my $token_db = sha1_hex $token;
+ return 0 if !sqlFetch{SELECT USER_LOGIN($uid, DECODE({unpack 'H*', $encpass}, 'hex'), DECODE($token_db, 'hex'))};
+
+ tuwf->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000);
+ $self->_load_session($uid, $token_db);
+ return 1;
+}
+
+
+sub _load_session {
+ my($self, $uid, $token_db) = @_;
+
+ my $user = {};
+ if($uid) {
+ my $loggedin = sqlExpr{USER_ISLOGGEDIN(id, DECODE($token_db, 'hex'))};
+ $user = sqlFetch{
+ SELECT id, username, perm, EXTRACT('epoch' FROM $loggedin) AS lastused
+ FROM users
+ WHERE (id = $uid)
+ AND ($loggedin IS NOT NULL)
+ LIMIT 1
+ };
+
+ # update the sessions.lastused column if lastused < now()-'6 hours'
+ sqlDo{SELECT USER_UPDATE_LASTUSED($user->{id}, DECODE($token_db, 'hex'))}
+ if $user->{id} && $user->{lastused} < time()-6*3600;
+ }
+
+ # Drop the cookie if it's not valid
+ tuwf->resCookie(auth => undef) if !$user->{id} && tuwf->reqCookie('auth');
+
+ $self->{uid} = $user->{id};
+ $self->{username} = $user->{username};
+ $self->{perm} = $user->{perm}||0;
+ $self->{token} = $token_db;
+}
+
+
+# Returns 1 on success, 0 on failure
+sub login {
+ my($self, $user, $pass) = @_;
+ return 0 if $self->uid || !$user || !$pass;
+
+ my $u = sqlFetch{SELECT id, USER_GETSCRYPTARGS(id) AS args FROM users WHERE username = $user};
+ return 0 if !$u->{id} || !$u->{args} || length($u->{args}) != 14;
+
+ my($N, $r, $p, $salt) = unpack 'NCCa8', $u->{args};
+ my $encpass = $self->_preparepass($pass, $salt, $N, $r, $p);
+ $self->_create_session($u->{id}, $encpass);
+}
+
+
+sub logout {
+ my $self = shift;
+ return if !$self->uid;
+ sqlDo{SELECT USER_LOGOUT($self->uid, DECODE($self->token, 'hex'))};
+ $self->_load_session();
+}
+
+
+# TODO: Password reset API
+# TODO: Preferences API
+# TODO: XSRF token handling
+
+1;
diff --git a/lib/VNDB/DB/Affiliates.pm b/lib/VNDB/DB/Affiliates.pm
deleted file mode 100644
index 94dfd198..00000000
--- a/lib/VNDB/DB/Affiliates.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-
-package VNDB::DB::Affiliates;
-
-use strict;
-use warnings;
-use POSIX 'strftime';
-use Exporter 'import';
-
-our @EXPORT = qw|dbAffiliateGet dbAffiliateEdit dbAffiliateDel dbAffiliateAdd|;
-
-
-# options: id rids affiliate hidden sort reverse
-# what: release
-sub dbAffiliateGet {
- my($self, %o) = @_;
- $o{sort} ||= 'id';
- $o{reverse} //= 0;
-
- my %where = (
- $o{id} ? ('id = ?' => $o{id}) : (),
- $o{rids} ? ('rid IN(!l)' => [$o{rids}]) : (),
- defined($o{affiliate}) ? ('affiliate = ?' => $o{affiliate}) : (),
- defined($o{hidden}) ? ('!s af.hidden' => $o{hidden} ? '' : 'NOT') : (),
- );
-
- my $join = $o{what} ? 'JOIN releases r ON r.id = af.rid' : '';
- my $select = $o{what} ? ', r.title' : '';
-
- my $order = sprintf {
- id => 'af.id %s',
- rel => 'r.title %s',
- prio => 'af.priority %s',
- url => 'af.url %s',
- lastfetch => 'af.lastfetch %s',
- }->{$o{sort}}, $o{reverse} ? 'DESC' : 'ASC';
-
- return $self->dbAll(qq|
- SELECT af.id, af.rid, af.hidden, af.priority, af.affiliate, af.url, af.version,
- extract('epoch' from af.lastfetch) as lastfetch, af.price, af.data$select
- FROM affiliate_links af
- $join
- !W
- ORDER BY !s|, \%where, $order);
-}
-
-
-sub dbAffiliateDel {
- my($self, $id) = @_;
- $self->dbExec('DELETE FROM affiliate_links WHERE id = ?', $id);
-}
-
-
-sub dbAffiliateEdit {
- my($self, $id, %ops) = @_;
- my %set;
- exists($ops{$_}) && ($set{"$_ = ?"} = $ops{$_}) for(qw|rid priority hidden affiliate url version price data|);
- $set{"lastfetch = TIMESTAMP WITH TIME ZONE 'epoch' + ? * INTERVAL '1 second'"} = $ops{lastfetch} || $ops{lastfetch} eq '0' ? $ops{lastfetch} : undef if exists $ops{lastfetch};
- return if !keys %set;
- $self->dbExec('UPDATE affiliate_links !H WHERE id = ?', \%set, $id);
-}
-
-
-sub dbAffiliateAdd {
- my($self, %ops) = @_;
- $self->dbExec(q|INSERT INTO affiliate_links (rid, priority, hidden, affiliate, url, version, price, data, lastfetch)
- VALUES(!l, TIMESTAMP WITH TIME ZONE 'epoch' + ? * INTERVAL '1 second')|,
- [@ops{qw| rid priority hidden affiliate url version price data|}],
- $ops{lastfetch} || $ops{lastfetch} eq '0' ? $ops{lastfetch} : undef);
-}
-
-
-1;
-
diff --git a/lib/VNDB/DB/Chars.pm b/lib/VNDB/DB/Chars.pm
deleted file mode 100644
index db9ae93b..00000000
--- a/lib/VNDB/DB/Chars.pm
+++ /dev/null
@@ -1,188 +0,0 @@
-
-package VNDB::DB::Chars;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbCharGet dbCharGetRev dbCharRevisionInsert dbCharImageId|;
-
-
-# options: id instance tagspoil trait_inc trait_exc char what results page gender bloodt
-# bust_min bust_max waist_min waist_max hip_min hip_max height_min height_max weight_min weight_max role
-# what: extended traits vns changes
-sub dbCharGet {
- my $self = shift;
- my %o = (
- page => 1,
- results => 10,
- what => '',
- tagspoil => 0,
- @_
- );
-
- $o{search} =~ s/%//g if $o{search};
-
- my %where = (
- !$o{id} ? ( 'c.hidden = FALSE' => 1 ) : (),
- $o{id} ? ( 'c.id IN(!l)' => [ ref $o{id} ? $o{id} : [$o{id}] ] ) : (),
- $o{notid} ? ( 'c.id <> ?' => $o{notid} ) : (),
- $o{instance} ? ( 'c.main = ?' => $o{instance} ) : (),
- $o{vid} ? ( 'c.id IN(SELECT id FROM chars_vns WHERE vid = ?)' => $o{vid} ) : (),
- defined $o{gender} ? ( 'c.gender IN(!l)' => [ ref $o{gender} ? $o{gender} : [$o{gender}] ]) : (),
- defined $o{bloodt} ? ( 'c.bloodt IN(!l)' => [ ref $o{bloodt} ? $o{bloodt} : [$o{bloodt}] ]) : (),
- defined $o{bust_min} ? ( 'c.s_bust >= ?' => $o{bust_min} ) : (),
- defined $o{bust_max} ? ( 'c.s_bust <= ? AND c.s_bust > 0' => $o{bust_max} ) : (),
- defined $o{waist_min} ? ( 'c.s_waist >= ?' => $o{waist_min} ) : (),
- defined $o{waist_max} ? ( 'c.s_waist <= ? AND c.s_waist > 0' => $o{waist_max} ) : (),
- defined $o{hip_min} ? ( 'c.s_hip >= ?' => $o{hip_min} ) : (),
- defined $o{hip_max} ? ( 'c.s_hip <= ? AND c.s_hip > 0' => $o{hip_max} ) : (),
- defined $o{height_min} ? ( 'c.height >= ?' => $o{height_min} ) : (),
- defined $o{height_max} ? ( 'c.height <= ? AND c.height > 0' => $o{height_max} ) : (),
- defined $o{weight_min} ? ( 'c.weight >= ?' => $o{weight_min} ) : (),
- defined $o{weight_max} ? ( 'c.weight <= ? AND c.weight > 0' => $o{weight_max} ) : (),
- $o{search} ? (
- '(c.name ILIKE ? OR c.original ILIKE ? OR c.alias ILIKE ?)', [ map '%'.$o{search}.'%', 1..3 ] ) : (),
- $o{char} ? (
- 'LOWER(SUBSTR(c.name, 1, 1)) = ?' => $o{char} ) : (),
- defined $o{char} && !$o{char} ? (
- '(ASCII(c.name) < 97 OR ASCII(c.name) > 122) AND (ASCII(c.name) < 65 OR ASCII(c.name) > 90)' => 1 ) : (),
- $o{role} ? (
- 'EXISTS(SELECT 1 FROM chars_vns cvi WHERE cvi.id = c.id AND cvi.role IN(!l))',
- [ ref $o{role} ? $o{role} : [$o{role}] ] ) : (),
- $o{trait_inc} ? (
- 'c.id IN(SELECT cid FROM traits_chars WHERE tid IN(!l) AND spoil <= ? GROUP BY cid HAVING COUNT(tid) = ?)',
- [ ref $o{trait_inc} ? $o{trait_inc} : [$o{trait_inc}], $o{tagspoil}, ref $o{trait_inc} ? $#{$o{trait_inc}}+1 : 1 ]) : (),
- $o{trait_exc} ? (
- 'c.id NOT IN(SELECT cid FROM traits_chars WHERE tid IN(!l))' => [ ref $o{trait_exc} ? $o{trait_exc} : [$o{trait_exc}] ] ) : (),
- );
-
- my @select = (qw|c.id c.name c.original c.gender|);
- push @select, qw|c.hidden c.locked c.alias c.desc c.image c.b_month c.b_day c.s_bust c.s_waist c.s_hip c.height c.weight c.bloodt c.main c.main_spoil| if $o{what} =~ /extended/;
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM chars c
- !W
- ORDER BY c.name|,
- join(', ', @select), \%where
- );
-
- return _enrich($self, $r, $np, 0, $o{what}, $o{vid});
-}
-
-
-sub dbCharGetRev {
- my $self = shift;
- my %o = (what => '', @_);
-
- $o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'c\' AND itemid = ?', $o{id})->{rev};
-
- my $select = 'c.itemid AS id, ch.name, ch.original, ch.gender';
- $select .= ', extract(\'epoch\' from c.added) as added, c.requester, c.comments, u.username, c.rev, c.ihid, c.ilock';
- $select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
- $select .= ', ch.alias, ch.desc, ch.image, ch.b_month, ch.b_day, ch.s_bust, ch.s_waist, ch.s_hip, ch.height, ch.weight, ch.bloodt, ch.main, ch.main_spoil, co.hidden, co.locked' if $o{what} =~ /extended/;
-
- my $r = $self->dbAll(q|
- SELECT !s
- FROM changes c
- JOIN chars co ON co.id = c.itemid
- JOIN chars_hist ch ON ch.chid = c.id
- JOIN users u ON u.id = c.requester
- WHERE c.type = 'c' AND c.itemid = ? AND c.rev = ?|,
- $select, $o{id}, $o{rev}
- );
-
- return _enrich($self, $r, 0, 1, $o{what});
-}
-
-
-sub _enrich {
- my($self, $r, $np, $rev, $what, $vid) = @_;
-
- if(@$r && $what =~ /vns|traits/) {
- my($col, $hist, $colname) = $rev ? ('cid', '_hist', 'chid') : ('id', '', 'id');
- my %r = map {
- $_->{traits} = [];
- $_->{vns} = [];
- ($_->{$col}, $_)
- } @$r;
-
- if($what =~ /traits/) {
- push @{$r{ delete $_->{xid} }{traits}}, $_ for (@{$self->dbAll(qq|
- SELECT ct.$colname AS xid, ct.tid, ct.spoil, t.name, t.sexual, t."group", tg.name AS groupname
- FROM chars_traits$hist ct
- JOIN traits t ON t.id = ct.tid
- JOIN traits tg ON tg.id = t."group"
- WHERE ct.$colname IN(!l)
- ORDER BY tg."order", t.name|, [ keys %r ]
- )});
- }
-
- if($what =~ /vns(?:\((\d+)\))?/) {
- push @{$r{ delete $_->{xid} }{vns}}, $_ for (@{$self->dbAll("
- SELECT cv.$colname AS xid, cv.vid, cv.rid, cv.spoil, cv.role, v.title AS vntitle, r.title AS rtitle
- FROM chars_vns$hist cv
- JOIN vn v ON cv.vid = v.id
- LEFT JOIN releases r ON cv.rid = r.id
- !W
- ORDER BY v.c_released",
- { "cv.$colname IN(!l)" => [[keys %r]], $1 ? ('cv.vid = ?', $1) : () }
- )});
- }
- }
-
- # Depends on the VN revision rather than char revision
- if(@$r && $what =~ /seiyuu/) {
- my %r = map {
- $_->{seiyuu} = [];
- ($_->{id}, $_)
- } @$r;
-
- push @{$r{ delete $_->{cid} }{seiyuu}}, $_ for (@{$self->dbAll(q|
- SELECT vs.cid, s.id AS sid, sa.name, sa.original, vs.note, v.id AS vid, v.title AS vntitle
- FROM vn_seiyuu vs
- JOIN staff_alias sa ON sa.aid = vs.aid
- JOIN staff s ON s.id = sa.id
- JOIN vn v ON v.id = vs.id
- !W
- ORDER BY v.c_released, sa.name|, {
- 's.hidden = FALSE' => 1,
- 'vs.cid IN(!l)' => [[ keys %r ]],
- $vid ? ('v.id = ?' => $vid) : (),
- }
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { columns in chars_rev + traits + vns },
-sub dbCharRevisionInsert {
- my($self, $o) = @_;
-
- my %set = map exists($o->{$_}) ? (qq|"$_" = ?|, $o->{$_}) : (),
- qw|name original alias desc image b_month b_day s_bust s_waist s_hip height weight bloodt gender main main_spoil|;
- $self->dbExec('UPDATE edit_chars !H', \%set) if keys %set;
-
- if($o->{traits}) {
- $self->dbExec('DELETE FROM edit_chars_traits');
- $self->dbExec('INSERT INTO edit_chars_traits (tid, spoil) VALUES (?,?)', $_->[0],$_->[1]) for (@{$o->{traits}});
- }
- if($o->{vns}) {
- $self->dbExec('DELETE FROM edit_chars_vns');
- $self->dbExec('INSERT INTO edit_chars_vns (vid, rid, spoil, role) VALUES(!l)', $_) for (@{$o->{vns}});
- }
-}
-
-
-# fetches an ID for a new image
-sub dbCharImageId {
- return shift->dbRow("SELECT nextval('charimg_seq') AS ni")->{ni};
-}
-
-
-1;
-
diff --git a/lib/VNDB/DB/Discussions.pm b/lib/VNDB/DB/Discussions.pm
deleted file mode 100644
index b4771adc..00000000
--- a/lib/VNDB/DB/Discussions.pm
+++ /dev/null
@@ -1,351 +0,0 @@
-
-package VNDB::DB::Discussions;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbThreadGet dbThreadEdit dbThreadAdd dbPostGet dbPostEdit dbPostAdd dbThreadCount dbPollStats dbPollVote|;
-
-
-# Options: id, type, iid, results, page, what, notusers, search, sort, reverse
-# What: boards, boardtitles, firstpost, lastpost, poll
-# Sort: id lastpost
-sub dbThreadGet {
- my($self, %o) = @_;
- $o{results} ||= 50;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my @where = (
- $o{id} ? (
- 't.id = ?' => $o{id} ) : (),
- !$o{id} ? (
- 't.hidden = FALSE' => 0 ) : (),
- $o{type} && !$o{iid} ? (
- 'EXISTS(SELECT 1 FROM threads_boards WHERE tid = t.id AND type IN(!l))' => [ ref $o{type} ? $o{type} : [ $o{type} ] ] ) : (),
- $o{type} && $o{iid} ? (
- 'tb.type = ?' => $o{type}, 'tb.iid = ?' => $o{iid} ) : (),
- $o{notusers} ? (
- 'NOT EXISTS(SELECT 1 FROM threads_boards WHERE type = \'u\' AND tid = t.id)' => 1) : (),
- );
-
- if($o{search}) {
- for (split /[ -,._]/, $o{search}) {
- s/%//g;
- push @where, 't.title ilike ?', "%$_%" if length($_) > 0;
- }
- }
-
- my @select = (
- qw|t.id t.title t.count t.locked t.hidden|, 't.poll_question IS NOT NULL AS haspoll',
- $o{what} =~ /lastpost/ ? ('tpl.uid AS luid', q|EXTRACT('epoch' from tpl.date) AS ldate|, 'ul.username AS lusername') : (),
- $o{what} =~ /poll/ ? (qw|t.poll_question t.poll_max_options t.poll_preview t.poll_recast|) : (),
- );
-
- my @join = (
- $o{what} =~ /lastpost/ ? (
- 'JOIN threads_posts tpl ON tpl.tid = t.id AND tpl.num = t.count',
- 'JOIN users ul ON ul.id = tpl.uid'
- ) : (),
- $o{type} && $o{iid} ?
- 'JOIN threads_boards tb ON tb.tid = t.id' : (),
- );
-
- my $order = sprintf {
- id => 't.id %s',
- lastpost => 'tpl.date %s',
- }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM threads t
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \@where, $order
- );
-
- if($o{what} =~ /(boards|boardtitles|poll)/ && $#$r >= 0) {
- my %r = map {
- $r->[$_]{boards} = [];
- $r->[$_]{poll_options} = [];
- ($r->[$_]{id}, $_)
- } 0..$#$r;
-
- if($o{what} =~ /boards/) {
- push(@{$r->[$r{$_->{tid}}]{boards}}, [ $_->{type}, $_->{iid} ]) for (@{$self->dbAll(q|
- SELECT tid, type, iid
- FROM threads_boards
- WHERE tid IN(!l)|,
- [ keys %r ]
- )});
- }
-
- if($o{what} =~ /poll/) {
- push(@{$r->[$r{$_->{tid}}]{poll_options}}, [ $_->{id}, $_->{option} ]) for (@{$self->dbAll(q|
- SELECT tid, id, option
- FROM threads_poll_options
- WHERE tid IN(!l)|,
- [ keys %r ]
- )});
- }
-
- if($o{what} =~ /firstpost/) {
- do { my $x = $r->[$r{$_->{tid}}]; $x->{fuid} = $_->{uid}; $x->{fdate} = $_->{date}; $x->{fusername} = $_->{username} } for (@{$self->dbAll(q|
- SELECT tpf.tid, tpf.uid, EXTRACT('epoch' from tpf.date) AS date, uf.username
- FROM threads_posts tpf
- JOIN users uf ON tpf.uid = uf.id
- WHERE tpf.num = 1 AND tpf.tid IN(!l)|,
- [ keys %r ]
- )});
- }
-
- if($o{what} =~ /boardtitles/) {
- push(@{$r->[$r{$_->{tid}}]{boards}}, $_) for (@{$self->dbAll(q|
- SELECT tb.tid, tb.type, tb.iid, COALESCE(u.username, v.title, p.name) AS title, COALESCE(u.username, v.original, p.original) AS original
- FROM threads_boards tb
- LEFT JOIN vn v ON tb.type = 'v' AND v.id = tb.iid
- LEFT JOIN producers p ON tb.type = 'p' AND p.id = tb.iid
- LEFT JOIN users u ON tb.type = 'u' AND u.id = tb.iid
- WHERE tb.tid IN(!l)|,
- [ keys %r ]
- )});
- }
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# id, %options->( title locked hidden boards poll_question poll_max_options poll_preview poll_recast poll_options }
-# The poll_{question,options,max_options} fields should not be set when there
-# are no changes to the poll info. Either all or none of these fields should be
-# set.
-sub dbThreadEdit {
- my($self, $id, %o) = @_;
-
- my %set = (
- 'title = ?' => $o{title},
- 'locked = ?' => $o{locked}?1:0,
- 'hidden = ?' => $o{hidden}?1:0,
- 'poll_preview = ?' => $o{poll_preview}?1:0,
- 'poll_recast = ?' => $o{poll_recast}?1:0,
- exists $o{poll_question} ? (
- 'poll_question = ?' => $o{poll_question}||undef,
- 'poll_max_options = ?' => $o{poll_max_options}||1,
- ) : (),
- );
-
- $self->dbExec(q|
- UPDATE threads
- !H
- WHERE id = ?|,
- \%set, $id);
-
- if($o{boards}) {
- $self->dbExec('DELETE FROM threads_boards WHERE tid = ?', $id);
- $self->dbExec(q|
- INSERT INTO threads_boards (tid, type, iid)
- VALUES (?, ?, ?)|,
- $id, $_->[0], $_->[1]||0
- ) for (@{$o{boards}});
- }
-
- if(exists $o{poll_question}) {
- $self->dbExec('DELETE FROM threads_poll_options WHERE tid = ?', $id);
- $self->dbExec(q|
- INSERT INTO threads_poll_options (tid, option)
- VALUES (?, ?)|,
- $id, $_
- ) for (@{$o{poll_options}});
- }
-}
-
-
-# %options->{ title hidden locked boards poll_stuff }
-sub dbThreadAdd {
- my($self, %o) = @_;
-
- my $id = $self->dbRow(q|
- INSERT INTO threads (title, hidden, locked, poll_question, poll_max_options, poll_preview, poll_recast)
- VALUES (?, ?, ?, ?, ?, ?, ?)
- RETURNING id|,
- $o{title}, $o{hidden}?1:0, $o{locked}?1:0, $o{poll_question}||undef, $o{poll_max_options}||1, $o{poll_preview}?1:0, $o{poll_recast}?1:0
- )->{id};
-
- $self->dbExec(q|
- INSERT INTO threads_boards (tid, type, iid)
- VALUES (?, ?, ?)|,
- $id, $_->[0], $_->[1]||0
- ) for (@{$o{boards}});
-
- $self->dbExec(q|
- INSERT INTO threads_poll_options (tid, option)
- VALUES (?, ?)|,
- $id, $_
- ) for ($o{poll_question} ? @{$o{poll_options}} : ());
-
- return $id;
-}
-
-
-# Returns thread count of a specific item board
-# Arguments: type, iid
-sub dbThreadCount {
- my($self, $type, $iid) = @_;
- return $self->dbRow(q|
- SELECT COUNT(*) AS cnt
- FROM threads_boards tb
- JOIN threads t ON t.id = tb.tid
- WHERE tb.type = ? AND tb.iid = ?
- AND t.hidden = FALSE|,
- $type, $iid)->{cnt};
-}
-
-
-# Options: tid, num, what, uid, mindate, hide, search, type, page, results, sort, reverse
-# what: user thread
-sub dbPostGet {
- my($self, %o) = @_;
- $o{results} ||= 50;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my %where = (
- $o{tid} ? (
- 'tp.tid = ?' => $o{tid} ) : (),
- $o{num} ? (
- 'tp.num = ?' => $o{num} ) : (),
- $o{uid} ? (
- 'tp.uid = ?' => $o{uid} ) : (),
- $o{mindate} ? (
- 'tp.date > to_timestamp(?)' => $o{mindate} ) : (),
- $o{hide} ? (
- 'tp.hidden = FALSE' => 1 ) : (),
- $o{hide} && $o{what} =~ /thread/ ? (
- 't.hidden = FALSE' => 1 ) : (),
- $o{search} ? (
- 'bb_tsvector(msg) @@ to_tsquery(?)' => $o{search}) : (),
- $o{type} ? (
- 'tp.tid IN(SELECT tid FROM threads_boards WHERE type IN(!l))' => [ ref $o{type} ? $o{type} : [ $o{type} ] ] ) : (),
- );
-
- my @select = (
- qw|tp.tid tp.num tp.hidden|, q|extract('epoch' from tp.date) as date|, q|extract('epoch' from tp.edited) as edited|,
- $o{search} ? () : 'tp.msg',
- $o{what} =~ /user/ ? qw|tp.uid u.username| : (),
- $o{what} =~ /thread/ ? ('t.title', 't.hidden AS thread_hidden') : (),
- );
- my @join = (
- $o{what} =~ /user/ ? 'JOIN users u ON u.id = tp.uid' : (),
- $o{what} =~ /thread/ ? 'JOIN threads t ON t.id = tp.tid' : (),
- );
-
- my $order = sprintf {
- num => 'tp.num %s',
- date => 'tp.date %s',
- }->{ $o{sort}||'num' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM threads_posts tp
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \%where, $order
- );
-
- # Get headlines in a separate query
- if($o{search} && @$r) {
- my %r = map {
- ($r->[$_]{tid}.'.'.$r->[$_]{num}, $_)
- } 0..$#$r;
- my $where = join ' or ', ('(tid = ? and num = ?)')x@$r;
- my @where = map +($_->{tid},$_->{num}), @$r;
- my $h = join ',', map "$_=$o{headline}{$_}", $o{headline} ? keys %{$o{headline}} : ();
-
- $r->[$r{$_->{tid}.'.'.$_->{num}}]{headline} = $_->{headline} for (@{$self->dbAll(qq|
- SELECT tid, num, ts_headline('english', strip_bb_tags(strip_spoilers(msg)), to_tsquery(?), ?) as headline
- FROM threads_posts
- WHERE $where|,
- $o{search}, $h, @where
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# tid, num, %options->{ num msg hidden lastmod }
-sub dbPostEdit {
- my($self, $tid, $num, %o) = @_;
-
- my %set = (
- 'msg = ?' => $o{msg},
- 'edited = to_timestamp(?)' => $o{lastmod},
- 'hidden = ?' => $o{hidden}?1:0,
- );
-
- $self->dbExec(q|
- UPDATE threads_posts
- !H
- WHERE tid = ?
- AND num = ?|,
- \%set, $tid, $num
- );
-}
-
-
-# tid, %options->{ uid msg }
-sub dbPostAdd {
- my($self, $tid, %o) = @_;
-
- my $num = $self->dbRow('SELECT num FROM threads_posts WHERE tid = ? ORDER BY num DESC LIMIT 1', $tid)->{num};
- $num = $num ? $num+1 : 1;
- $o{uid} ||= $self->authInfo->{id};
-
- $self->dbExec(q|
- INSERT INTO threads_posts (tid, num, uid, msg)
- VALUES(?, ?, ?, ?)|,
- $tid, $num, @o{qw| uid msg |}
- );
- $self->dbExec(q|
- UPDATE threads
- SET count = count+1
- WHERE id = ?|,
- $tid);
-
- return $num;
-}
-
-
-# Args: tid
-# Returns: num_users, poll_stats, user_voted_options
-sub dbPollStats {
- my($self, $tid) = @_;
- my $uid = $self->authInfo->{id};
-
- my $num_users = $self->dbRow('SELECT COUNT(DISTINCT uid) AS votes FROM threads_poll_votes WHERE tid = ?', $tid)->{votes} || 0;
-
- my $stats = !$num_users ? {} : { map +($_->{optid}, $_->{votes}), @{$self->dbAll(
- 'SELECT optid, COUNT(optid) AS votes FROM threads_poll_votes WHERE tid = ? GROUP BY optid', $tid
- )} };
-
- my $user = !$num_users || !$uid ? [] : [
- map $_->{optid}, @{$self->dbAll('SELECT optid FROM threads_poll_votes WHERE tid = ? AND uid = ?', $tid, $uid)}
- ];
-
- return $num_users, $stats, $user;
-}
-
-
-sub dbPollVote {
- my($self, $tid, $uid, @opts) = @_;
-
- $self->dbExec('DELETE FROM threads_poll_votes WHERE tid = ? AND uid = ?', $tid, $uid);
- $self->dbExec('INSERT INTO threads_poll_votes (tid, uid, optid) VALUES (?, ?, ?)',
- $tid, $uid, $_) for @opts;
-}
-
-1;
diff --git a/lib/VNDB/DB/Misc.pm b/lib/VNDB/DB/Misc.pm
deleted file mode 100644
index d6389376..00000000
--- a/lib/VNDB/DB/Misc.pm
+++ /dev/null
@@ -1,125 +0,0 @@
-
-package VNDB::DB::Misc;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|
- dbStats dbItemEdit dbRevisionGet dbRandomQuote
-|;
-
-
-# Returns: hashref, key = section, value = number of (visible) entries
-# Sections: vn, producers, releases, users, threads, posts
-sub dbStats {
- my $s = shift;
- return { map {
- $_->{section} eq 'threads_posts' ? 'posts' : $_->{section}, $_->{count}
- } @{$s->dbAll('SELECT * FROM stats_cache')}};
-}
-
-
-# Inserts a new revision into the database
-# Arguments: type [vrp], itemid, rev, %options->{ editsum uid ihid ilock + db[item]RevisionInsert }
-# rev = changes.rev of the revision this edit is based on, undef to create a new DB item
-# Returns: { itemid, chid, rev }
-sub dbItemEdit {
- my($self, $type, $itemid, $rev, %o) = @_;
-
- $self->dbExec('SELECT edit_!s_init(?, ?)', $type, $itemid, $rev);
- $self->dbExec('UPDATE edit_revision !H', {
- 'requester = ?' => $o{uid}||$self->authInfo->{id},
- 'ip = ?' => $self->reqIP,
- 'comments = ?' => $o{editsum},
- exists($o{ihid}) ? ('ihid = ?' => $o{ihid} ?1:0) : (),
- exists($o{ilock}) ? ('ilock = ?' => $o{ilock}?1:0) : (),
- });
-
- $self->dbVNRevisionInsert( \%o) if $type eq 'v';
- $self->dbProducerRevisionInsert(\%o) if $type eq 'p';
- $self->dbReleaseRevisionInsert( \%o) if $type eq 'r';
- $self->dbCharRevisionInsert( \%o) if $type eq 'c';
- $self->dbStaffRevisionInsert( \%o) if $type eq 's';
-
- return $self->dbRow('SELECT * FROM edit_!s_commit()', $type);
-}
-
-
-# Options: type, itemid, uid, auto, hidden, edit, page, results, releases
-sub dbRevisionGet {
- my($self, %o) = @_;
- $o{results} ||= 10;
- $o{page} ||= 1;
- $o{auto} ||= 0; # 0:show, -1:only, 1:hide
- $o{hidden} ||= 0;
- $o{edit} ||= 0; # 0:both, -1:new, 1:edits
- $o{releases} = 0 if !$o{type} || $o{type} ne 'v' || !$o{itemid};
-
- my %where = (
- $o{releases} ? (
- # This selects all changes of releases that are currently linked to the VN, not release revisions that are linked to the VN.
- # The latter seems more useful, but is also a lot more expensive.
- q{((c.type = 'v' AND c.itemid = ?) OR (c.type = 'r' AND c.itemid = ANY(ARRAY(SELECT rv.id FROM releases_vn rv WHERE rv.vid = ?))))} => [$o{itemid}, $o{itemid}],
- ) : (
- $o{type} ? (
- 'c.type IN(!l)' => [ ref($o{type})?$o{type}:[$o{type}] ] ) : (),
- $o{itemid} ? (
- 'c.itemid = ?' => [ $o{itemid} ] ) : (),
- ),
- $o{uid} ? (
- 'c.requester = ?' => $o{uid} ) : (),
- $o{auto} ? (
- 'c.requester !s 1' => $o{auto} < 0 ? '=' : '<>' ) : (),
- $o{hidden} ? (
- '!s EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.ihid AND'.
- ' c2.rev = (SELECT MAX(c3.rev) FROM changes c3 WHERE c3.type = c.type AND c3.itemid = c.itemid))' => $o{hidden} == 1 ? 'NOT' : '') : (),
- $o{edit} ? (
- 'c.rev !s 1' => $o{edit} < 0 ? '=' : '>' ) : (),
- );
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT c.id, c.type, c.itemid, c.requester, c.comments, c.rev, extract('epoch' from c.added) as added, u.username
- FROM changes c
- JOIN users u ON c.requester = u.id
- !W
- ORDER BY c.id DESC|, \%where
- );
-
- # I couldn't find a way to fetch the titles the main query above without slowing it down considerably, so let's just do it this way.
- if(@$r) {
- my %r = map +($_->{id}, $_), @$r;
- my $w = join ' OR ', ('(type = ? AND id = ?)') x @$r;
- my @w = map +($_->{type}, $_->{id}), @$r;
-
- $r{ $_->{id} }{ititle} = $_->{title}, $r{ $_->{id} }{ioriginal} = $_->{original} for(@{$self->dbAll("
- SELECT id, title, original FROM (
- SELECT 'v'::dbentry_type, chid, title, original FROM vn_hist
- UNION ALL SELECT 'r'::dbentry_type, chid, title, original FROM releases_hist
- UNION ALL SELECT 'p'::dbentry_type, chid, name, original FROM producers_hist
- UNION ALL SELECT 'c'::dbentry_type, chid, name, original FROM chars_hist
- UNION ALL SELECT 's'::dbentry_type, sh.chid, name, original FROM staff_hist sh JOIN staff_alias_hist sah ON sah.chid = sh.chid AND sah.aid = sh.aid
- ) x(type, id, title, original)
- WHERE $w
- ", @w
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Returns a random quote (hashref with keys = vid, quote)
-sub dbRandomQuote {
- return $_[0]->dbRow(q|
- SELECT vid, quote
- FROM quotes
- ORDER BY RANDOM()
- LIMIT 1|);
-}
-
-
-
-
-1;
-
diff --git a/lib/VNDB/DB/Producers.pm b/lib/VNDB/DB/Producers.pm
deleted file mode 100644
index a6a301e5..00000000
--- a/lib/VNDB/DB/Producers.pm
+++ /dev/null
@@ -1,131 +0,0 @@
-
-package VNDB::DB::Producers;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbProducerGet dbProducerGetRev dbProducerRevisionInsert|;
-
-
-# options: results, page, id, search, char, sort, inc_hidden
-# what: extended relations relgraph
-sub dbProducerGet {
- my $self = shift;
- my %o = (
- results => 10,
- page => 1,
- what => '',
- @_
- );
-
- $o{search} =~ s/%//g if $o{search};
-
- my %where = (
- !$o{id} && !$o{inc_hidden} ? (
- 'p.hidden = FALSE' => 1 ) : (),
- $o{id} ? (
- 'p.id IN(!l)' => [ ref $o{id} ? $o{id} : [$o{id}] ] ) : (),
- $o{search} ? (
- '(p.name ILIKE ? OR p.original ILIKE ? OR p.alias ILIKE ?)', [ map '%'.$o{search}.'%', 1..3 ] ) : (),
- $o{char} ? (
- 'LOWER(SUBSTR(p.name, 1, 1)) = ?' => $o{char} ) : (),
- defined $o{char} && !$o{char} ? (
- '(ASCII(p.name) < 97 OR ASCII(p.name) > 122) AND (ASCII(p.name) < 65 OR ASCII(p.name) > 90)' => 1 ) : (),
- );
-
- my $join = $o{what} =~ /relgraph/ ? 'JOIN relgraphs pg ON pg.id = p.rgraph' : '';
-
- my $select = 'p.id, p.type, p.name, p.original, p.lang, p.rgraph';
- $select .= ', p.desc, p.alias, p.website, p.l_wp, p.hidden, p.locked' if $o{what} =~ /extended/;
- $select .= ', pg.svg' if $o{what} =~ /relgraph/;
-
- my($order, @order) = ('p.name');
- if($o{sort} && $o{sort} eq 'search') {
- $order = 'least(substr_score(p.name, ?), substr_score(p.original, ?)), p.name';
- @order = ($o{search}) x 2;
- }
-
- my($r, $np) = $self->dbPage(\%o, qq|
- SELECT !s
- FROM producers p
- !s
- !W
- ORDER BY $order|,
- $select, $join, \%where, @order
- );
-
- return _enrich($self, $r, $np, 0, $o{what});
-}
-
-
-# options: id, rev, what
-# what: extended relations
-sub dbProducerGetRev {
- my $self = shift;
- my %o = (what => '', @_);
-
- $o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'p\' AND itemid = ?', $o{id})->{rev};
-
- my $select = 'c.itemid AS id, p.type, p.name, p.original, p.lang, po.rgraph';
- $select .= ', extract(\'epoch\' from c.added) as added, c.requester, c.comments, u.username, c.rev, c.ihid, c.ilock';
- $select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
- $select .= ', p.desc, p.alias, p.website, p.l_wp, po.hidden, po.locked' if $o{what} =~ /extended/;
-
- my $r = $self->dbAll(q|
- SELECT !s
- FROM changes c
- JOIN producers po ON po.id = c.itemid
- JOIN producers_hist p ON p.chid = c.id
- JOIN users u ON u.id = c.requester
- WHERE c.type = 'p' AND c.itemid = ? AND c.rev = ?|,
- $select, $o{id}, $o{rev}
- );
-
- return _enrich($self, $r, 0, 1, $o{what});
-}
-
-
-sub _enrich {
- my($self, $r, $np, $rev, $what) = @_;
-
- if(@$r && $what =~ /relations/) {
- my($col, $hist, $colname) = $rev ? ('cid', '_hist', 'chid') : ('id', '', 'id');
- my %r = map {
- $r->[$_]{relations} = [];
- ($r->[$_]{$col}, $_)
- } 0..$#$r;
-
- push @{$r->[$r{$_->{xid}}]{relations}}, $_ for(@{$self->dbAll(qq|
- SELECT rel.$colname AS xid, rel.pid AS id, rel.relation, p.name, p.original
- FROM producers_relations$hist rel
- JOIN producers p ON rel.pid = p.id
- WHERE rel.$colname IN(!l)|,
- [ keys %r ]
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { columns in producers_rev + relations },
-sub dbProducerRevisionInsert {
- my($self, $o) = @_;
-
- my %set = map exists($o->{$_}) ? (qq|"$_" = ?|, $o->{$_}) : (),
- qw|name original website l_wp type lang desc alias|;
- $self->dbExec('UPDATE edit_producers !H', \%set) if keys %set;
-
- if($o->{relations}) {
- $self->dbExec('DELETE FROM edit_producers_relations');
- my $q = join ',', map '(?,?)', @{$o->{relations}};
- my @q = map +($_->[1], $_->[0]), @{$o->{relations}};
- $self->dbExec("INSERT INTO edit_producers_relations (pid, relation) VALUES $q", @q) if @q;
- }
-}
-
-
-1;
-
diff --git a/lib/VNDB/DB/Releases.pm b/lib/VNDB/DB/Releases.pm
deleted file mode 100644
index c54ea1a3..00000000
--- a/lib/VNDB/DB/Releases.pm
+++ /dev/null
@@ -1,253 +0,0 @@
-
-package VNDB::DB::Releases;
-
-use strict;
-use warnings;
-use POSIX 'strftime';
-use Exporter 'import';
-use VNDB::Func 'gtintype';
-
-our @EXPORT = qw|dbReleaseFilters dbReleaseGet dbReleaseGetRev dbReleaseRevisionInsert|;
-
-
-# Release filters shared by dbReleaseGet and dbVNGet
-sub dbReleaseFilters {
- my($self, %o) = @_;
- $o{plat} = [ $o{plat} ] if $o{plat} && !ref $o{plat};
- $o{med} = [ $o{med} ] if $o{med} && !ref $o{med};
- return (
- defined $o{patch} ? ( 'r.patch = ?' => $o{patch} == 1 ? 1 : 0) : (),
- defined $o{freeware} ? ( 'r.freeware = ?' => $o{freeware} == 1 ? 1 : 0) : (),
- defined $o{type} ? ( 'r.type = ?' => $o{type} ) : (),
- defined $o{date_before} ? ( 'r.released <= ?' => $o{date_before} ) : (),
- defined $o{date_after} ? ( 'r.released >= ?' => $o{date_after} ) : (),
- defined $o{minage} ? ( 'r.minage IN(!l)' => [ ref $o{minage} ? $o{minage} : [$o{minage}] ] ) : (),
- defined $o{doujin} ? ( 'NOT r.patch AND r.doujin = ?' => $o{doujin} == 1 ? 1 : 0) : (),
- defined $o{resolution} ? ( 'NOT r.patch AND r.resolution IN(!l)' => [ ref $o{resolution} ? $o{resolution} : [$o{resolution}] ] ) : (),
- defined $o{voiced} ? ( 'NOT r.patch AND r.voiced IN(!l)' => [ ref $o{voiced} ? $o{voiced} : [$o{voiced}] ] ) : (),
- defined $o{ani_story} ? ( 'NOT r.patch AND r.ani_story IN(!l)' => [ ref $o{ani_story} ? $o{ani_story} : [$o{ani_story}] ] ) : (),
- defined $o{ani_ero} ? ( 'NOT r.patch AND r.ani_ero IN(!l)' => [ ref $o{ani_ero} ? $o{ani_ero} : [$o{ani_ero}] ] ) : (),
- defined $o{released} ? ( 'r.released !s ?' => [ $o{released} ? '<=' : '>', strftime('%Y%m%d', gmtime) ] ) : (),
- $o{lang} ? (
- 'r.id IN(SELECT irl.id FROM releases_lang irl WHERE irl.lang IN(!l))' => [ ref $o{lang} ? $o{lang} : [ $o{lang} ] ] ) : (),
- $o{olang} ? (
- 'r.id IN(SELECT irv.id FROM releases_vn irv JOIN vn v ON irv.vid = v.id WHERE v.c_olang && ARRAY[!l]::language[])' => [ ref $o{olang} ? $o{olang} : [ $o{olang} ] ] ) : (),
- $o{plat} ? ('('.join(' OR ',
- grep(/^unk$/, @{$o{plat}}) ? 'NOT EXISTS(SELECT 1 FROM releases_platforms irp WHERE irp.id = r.id)' : (),
- grep(!/^unk$/, @{$o{plat}}) ? 'r.id IN(SELECT irp.id FROM releases_platforms irp WHERE irp.platform IN(!l))' : (),
- ).')', [ [ grep !/^unk$/, @{$o{plat}} ] ]) : (),
- $o{med} ? ('('.join(' OR ',
- grep(/^unk$/, @{$o{med}}) ? 'NOT EXISTS(SELECT 1 FROM releases_media irm WHERE irm.id = r.id)' : (),
- grep(!/^unk$/, @{$o{med}}) ? 'r.id IN(SELECT irm.id FROM releases_media irm WHERE irm.medium IN(!l))' : ()
- ).')', [ [ grep(!/^unk$/, @{$o{med}}) ] ]) : (),
- );
-}
-
-
-# Options: id vid pid released page results what med sort reverse date_before date_after
-# plat lang olang type minage search resolution freeware doujin voiced ani_story ani_ero hidden_only
-# What: extended vn producers platforms media affiliates
-# Sort: title released minage
-sub dbReleaseGet {
- my($self, %o) = @_;
- $o{results} ||= 50;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my @where = (
- !$o{id} && !$o{hidden_only} ? ( 'r.hidden = FALSE' => 0 ) : (),
- $o{hidden_only} ? ('r.hidden = TRUE' => 1) : (),
- $o{id} ? ( 'r.id = ?' => $o{id} ) : (),
- $o{vid} ? ( 'rv.vid IN(!l)' => [ ref $o{vid} ? $o{vid} : [$o{vid}] ] ) : (),
- $o{pid} ? ( 'rp.pid = ?' => $o{pid} ) : (),
- $self->dbReleaseFilters(%o),
- );
-
- if($o{search}) {
- for (split /[ -,._]/, $o{search}) {
- s/%//g;
- if(/^\d+$/ && gtintype($_)) {
- push @where, 'r.gtin = ?', $_;
- } elsif(length($_) > 0) {
- $_ = "%$_%";
- push @where, '(r.title ILIKE ? OR r.original ILIKE ? OR r.catalog = ?)',
- [ $_, $_, $_ ];
- }
- }
- }
-
- my @join = (
- $o{vid} ? 'JOIN releases_vn rv ON rv.id = r.id' : (),
- $o{pid} ? 'JOIN releases_producers rp ON rp.id = r.id' : (),
- );
-
- my @select = (
- qw|r.id r.title r.original r.website r.released r.minage r.type r.patch|,
- $o{what} =~ /extended/ ? qw|r.notes r.catalog r.gtin r.resolution r.voiced r.freeware r.doujin r.ani_story r.ani_ero r.hidden r.locked| : (),
- $o{pid} ? ('rp.developer', 'rp.publisher') : (),
- );
-
- my $order = sprintf {
- title => 'r.title %s, r.released %1$s',
- type => 'r.patch %s, r.type %1$s, r.released %1$s, r.title %1$s',
- publication => 'r.doujin %s, r.freeware %1$s, r.patch %1$s, r.released %1$s, r.title %1$s',
- resolution => 'r.resolution %s, r.patch %2$s, r.released %1$s, r.title %1$s',
- voiced => 'r.voiced %s, r.patch %2$s, r.released %1$s, r.title %1$s',
- ani_ero => 'r.ani_story %s, r.ani_ero %1$s, r.patch %2$s, r.released %1$s, r.title %1$s',
- released => 'r.released %s, r.id %1$s',
- minage => 'r.minage %s, r.released %1$s, r.title %1$s',
- notes => 'r.notes %s, r.released %1$s, r.title %1$s',
- }->{ $o{sort}||'released' }, $o{reverse} ? 'DESC' : 'ASC', !$o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM releases r
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \@where, $order
- );
-
- return _enrich($self, $r, $np, 0, $o{what});
-}
-
-
-# options: id, rev, what
-# what: extended vn producers platforms media affiliates
-sub dbReleaseGetRev {
- my $self = shift;
- my %o = (what => '', @_);
-
- $o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'r\' AND itemid = ?', $o{id})->{rev};
-
- my $select = 'c.itemid AS id, r.title, r.original, r.website, r.released, r.minage, r.type, r.patch';
- $select .= ', r.notes, r.catalog, r.gtin, r.resolution, r.voiced, r.freeware, r.doujin, r.ani_story, r.ani_ero, ro.hidden, ro.locked' if $o{what} =~ /extended/;
- $select .= ', extract(\'epoch\' from c.added) as added, c.requester, c.comments, u.username, c.rev, c.ihid, c.ilock';
- $select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
-
- my $r = $self->dbAll(q|
- SELECT !s
- FROM changes c
- JOIN releases ro ON ro.id = c.itemid
- JOIN releases_hist r ON r.chid = c.id
- JOIN users u ON u.id = c.requester
- WHERE c.type = 'r' AND c.itemid = ? AND c.rev = ?|,
- $select, $o{id}, $o{rev}
- );
-
- return _enrich($self, $r, 0, 1, $o{what});
-}
-
-
-sub _enrich {
- my($self, $r, $np, $rev, $what) = @_;
-
- if(@$r) {
- my($col, $hist, $colname) = $rev ? ('cid', '_hist', 'chid') : ('id', '', 'id');
- my %r = map {
- $r->[$_]{producers} = [];
- $r->[$_]{platforms} = [];
- $r->[$_]{media} = [];
- $r->[$_]{vn} = [];
- $r->[$_]{languages} = [];
- ($r->[$_]{$col}, $_)
- } 0..$#$r;
-
- push(@{$r->[$r{$_->{xid}}]{languages}}, $_->{lang}) for (@{$self->dbAll("
- SELECT $colname AS xid, lang
- FROM releases_lang$hist
- WHERE $colname IN(!l)",
- [ keys %r ]
- )});
-
- if($what =~ /vn/) {
- push(@{$r->[$r{$_->{xid}}]{vn}}, $_) for (@{$self->dbAll("
- SELECT rv.$colname AS xid, v.id AS vid, v.title, v.original
- FROM releases_vn$hist rv
- JOIN vn v ON v.id = rv.vid
- WHERE rv.$colname IN(!l)
- ORDER BY v.title",
- [ keys %r ]
- )});
- }
-
- if($what =~ /producers/) {
- push(@{$r->[$r{$_->{xid}}]{producers}}, $_) for (@{$self->dbAll("
- SELECT rp.$colname AS xid, rp.developer, rp.publisher, p.id, p.name, p.original, p.type
- FROM releases_producers$hist rp
- JOIN producers p ON rp.pid = p.id
- WHERE rp.$colname IN(!l)
- ORDER BY p.name",
- [ keys %r ]
- )});
- }
-
- if($what =~ /platforms/) {
- push(@{$r->[$r{$_->{xid}}]{platforms}}, $_->{platform}) for (@{$self->dbAll("
- SELECT $colname AS xid, platform
- FROM releases_platforms$hist
- WHERE $colname IN(!l)",
- [ keys %r ]
- )});
- }
-
- if($what =~ /media/) {
- push(@{$r->[$r{$_->{xid}}]{media}}, $_) for (@{$self->dbAll("
- SELECT $colname AS xid, medium, qty
- FROM releases_media$hist
- WHERE $colname IN(!l)",
- [ keys %r ]
- )});
- }
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { columns in releases_rev + languages + vn + producers + media + platforms }
-sub dbReleaseRevisionInsert {
- my($self, $o) = @_;
-
- my %set = map exists($o->{$_}) ? ("$_ = ?", $o->{$_}) : (),
- qw|title original gtin catalog website released notes minage type
- patch resolution voiced freeware doujin ani_story ani_ero|;
- $self->dbExec('UPDATE edit_releases !H', \%set) if keys %set;
-
- if($o->{languages}) {
- $self->dbExec('DELETE FROM edit_releases_lang');
- my $q = join ',', map '(?)', @{$o->{languages}};
- $self->dbExec("INSERT INTO edit_releases_lang (lang) VALUES $q", @{$o->{languages}}) if @{$o->{languages}};
- }
-
- if($o->{producers}) {
- $self->dbExec('DELETE FROM edit_releases_producers');
- my $q = join ',', map '(?,?,?)', @{$o->{producers}};
- my @q = map +($_->[0], $_->[1]?1:0, $_->[2]?1:0), @{$o->{producers}};
- $self->dbExec("INSERT INTO edit_releases_producers (pid, developer, publisher) VALUES $q", @q) if @q;
- }
-
- if($o->{platforms}) {
- $self->dbExec('DELETE FROM edit_releases_platforms');
- my $q = join ',', map '(?)', @{$o->{platforms}};
- $self->dbExec("INSERT INTO edit_releases_platforms (platform) VALUES $q", @{$o->{platforms}}) if @{$o->{platforms}};
- }
-
- if($o->{vn}) {
- $self->dbExec('DELETE FROM edit_releases_vn');
- my $q = join ',', map '(?)', @{$o->{vn}};
- $self->dbExec("INSERT INTO edit_releases_vn (vid) VALUES $q", @{$o->{vn}}) if @{$o->{vn}};
- }
-
- if($o->{media}) {
- $self->dbExec('DELETE FROM edit_releases_media');
- my $q = join ',', map '(?,?)', @{$o->{media}};
- my @q = map +($_->[0], $_->[1]), @{$o->{media}};
- $self->dbExec("INSERT INTO edit_releases_media (medium, qty) VALUES $q", @q) if @q;
- }
-}
-
-
-1;
-
diff --git a/lib/VNDB/DB/Staff.pm b/lib/VNDB/DB/Staff.pm
deleted file mode 100644
index bf2ae325..00000000
--- a/lib/VNDB/DB/Staff.pm
+++ /dev/null
@@ -1,196 +0,0 @@
-
-package VNDB::DB::Staff;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbStaffGet dbStaffGetRev dbStaffRevisionInsert dbStaffAliasIds|;
-
-# options: results, page, id, aid, search, exact, truename, role, gender
-# what: extended changes roles aliases
-sub dbStaffGet {
- my $self = shift;
- my %o = (
- results => 10,
- page => 1,
- what => '',
- @_
- );
- my(@roles, $seiyuu);
- if(defined $o{role}) {
- if(ref $o{role}) {
- $seiyuu = grep /^seiyuu$/, @{$o{role}};
- @roles = grep !/^seiyuu$/, @{$o{role}};
- } else {
- $seiyuu = $o{role} eq 'seiyuu';
- @roles = $o{role} unless $seiyuu;
- }
- }
-
- $o{search} =~ s/%//g if $o{search};
-
- my %where = (
- !$o{id} ? ( 's.hidden = FALSE' => 1 ) : (),
- $o{id} ? ( ref $o{id} ? ('s.id IN(!l)' => [$o{id}]) : ('s.id = ?' => $o{id}) ) : (),
- $o{aid} ? ( ref $o{aid} ? ('sa.aid IN(!l)' => [$o{aid}]) : ('sa.aid = ?' => $o{aid}) ) : (),
- $o{id} || $o{truename} ? ( 's.aid = sa.aid' => 1 ) : (),
- defined $o{gender} ? ( 's.gender IN(!l)' => [ ref $o{gender} ? $o{gender} : [$o{gender}] ]) : (),
- defined $o{lang} ? ( 's.lang IN(!l)' => [ ref $o{lang} ? $o{lang} : [$o{lang}] ]) : (),
- defined $o{role} ? (
- '('.join(' OR ',
- @roles ? ( 'EXISTS(SELECT 1 FROM vn_staff vs JOIN vn v ON v.id = vs.id WHERE vs.aid = sa.aid AND vs.role IN(!l) AND NOT v.hidden)' ) : (),
- $seiyuu ? ( 'EXISTS(SELECT 1 FROM vn_seiyuu vsy JOIN vn v ON v.id = vsy.id WHERE vsy.aid = sa.aid AND NOT v.hidden)' ) : ()
- ).')' => ( @roles ? [ \@roles ] : 1 ),
- ) : (),
- $o{exact} ? ( '(lower(sa.name) = lower(?) OR lower(sa.original) = lower(?))' => [ ($o{exact}) x 2 ] ) : (),
- $o{search} ?
- $o{search} =~ /[\x{3000}-\x{9fff}\x{ff00}-\x{ff9f}]/ ?
- # match against 'original' column only if search string contains any
- # japanese character.
- # note: more precise regex would be /[\p{Hiragana}\p{Katakana}\p{Han}]/
- ( q|(sa.original LIKE ? OR translate(sa.original,' ','') LIKE ?)| => [ '%'.$o{search}.'%', ($o{search} =~ s/\s+//gr).'%' ] ) :
- ( '(sa.name ILIKE ? OR sa.original ILIKE ?)' => [ map '%'.$o{search}.'%', 1..2 ] ) : (),
- $o{char} ? ( 'LOWER(SUBSTR(sa.name, 1, 1)) = ?' => $o{char} ) : (),
- defined $o{char} && !$o{char} ?
- ( '(ASCII(sa.name) < 97 OR ASCII(sa.name) > 122) AND (ASCII(sa.name) < 65 OR ASCII(sa.name) > 90)' => 1 ) : (),
- );
-
- my $select = 's.id, sa.aid, sa.name, sa.original, s.gender, s.lang';
- $select .= ', s.desc, s.l_wp, s.l_site, s.l_twitter, s.l_anidb, s.hidden, s.locked' if $o{what} =~ /extended/;
-
- my($order, @order) = ('sa.name');
- if($o{sort} && $o{sort} eq 'search') {
- $order = 'least(substr_score(sa.name, ?), substr_score(sa.original, ?)), sa.name';
- @order = ($o{search}) x 2;
- }
-
- my($r, $np) = $self->dbPage(\%o, qq|
- SELECT !s
- FROM staff s
- JOIN staff_alias sa ON sa.id = s.id
- !W
- ORDER BY $order|,
- $select, \%where, @order
- );
-
- return _enrich($self, $r, $np, 0, $o{what});
-}
-
-
-sub dbStaffGetRev {
- my $self = shift;
- my %o = (what => '', @_);
-
- $o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'s\' AND itemid = ?', $o{id})->{rev};
-
- my $select = 'c.itemid AS id, sa.aid, sa.name, sa.original, s.gender, s.lang';
- $select .= ', extract(\'epoch\' from c.added) as added, c.requester, c.comments, u.username, c.rev, c.ihid, c.ilock';
- $select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
- $select .= ', s.desc, s.l_wp, s.l_site, s.l_twitter, s.l_anidb, so.hidden, so.locked' if $o{what} =~ /extended/;
-
- my $r = $self->dbAll(q|
- SELECT !s
- FROM changes c
- JOIN staff so ON so.id = c.itemid
- JOIN staff_hist s ON s.chid = c.id
- JOIN staff_alias_hist sa ON sa.chid = c.id AND s.aid = sa.aid
- JOIN users u ON u.id = c.requester
- WHERE c.type = 's' AND c.itemid = ? AND c.rev = ?|,
- $select, $o{id}, $o{rev}
- );
-
- return _enrich($self, $r, 0, 1, $o{what});
-}
-
-
-sub _enrich {
- my($self, $r, $np, $rev, $what) = @_;
-
- # Role info is linked to VN revisions, so is independent of the selected staff revision
- if(@$r && $what =~ /roles/) {
- my %r = map {
- $_->{roles} = [];
- $_->{cast} = [];
- ($_->{id}, $_);
- } @$r;
-
- push @{$r{ delete $_->{id} }{roles}}, $_ for (@{$self->dbAll(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 IN(!l) AND NOT v.hidden
- ORDER BY v.c_released ASC, v.title ASC, vs.role ASC|, [ keys %r ]
- )});
- push @{$r{ delete $_->{id} }{cast}}, $_ for (@{$self->dbAll(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 IN(!l) AND NOT v.hidden
- ORDER BY v.c_released ASC, v.title ASC|, [ keys %r ]
- )});
- }
-
- if(@$r && $what =~ /aliases/) {
- my ($col, $hist, $colname) = $rev ? ('cid', '_hist', 'chid') : ('id', '', 'id');
- my %r = map {
- $_->{aliases} = [];
- ($_->{$col}, $_);
- } @$r;
-
- push @{$r{ delete $_->{xid} }{aliases}}, $_ for (@{$self->dbAll("
- SELECT s.$colname AS xid, sa.aid, sa.name, sa.original
- FROM staff_alias$hist sa
- JOIN staff$hist s ON s.$colname = sa.$colname
- WHERE s.$colname IN(!l) AND s.aid <> sa.aid
- ORDER BY sa.name ASC", [ keys %r ]
- )});
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { columns in staff_rev and staff_alias},
-sub dbStaffRevisionInsert {
- my($self, $o) = @_;
-
- $self->dbExec('DELETE FROM edit_staff_alias');
- if($o->{aid}) {
- $self->dbExec(q|
- INSERT INTO edit_staff_alias (aid, name, original) VALUES (?, ?, ?)|,
- $o->{aid}, $o->{name}, $o->{original});
- } else {
- $o->{aid} = $self->dbRow(q|
- INSERT INTO edit_staff_alias (name, original) VALUES (?, ?) RETURNING aid|,
- $o->{name}, $o->{original})->{aid};
- }
-
- my %staff = map exists($o->{$_}) ? (qq|"$_" = ?|, $o->{$_}) : (),
- qw|aid gender lang desc l_wp l_site l_twitter l_anidb|;
- $self->dbExec('UPDATE edit_staff !H', \%staff) if %staff;
- for my $a (@{$o->{aliases}}) {
- if($a->{aid}) {
- $self->dbExec('INSERT INTO edit_staff_alias (aid, name, original) VALUES (!l)', [ @{$a}{qw|aid name orig|} ]);
- } else {
- $self->dbExec('INSERT INTO edit_staff_alias (name, original) VALUES (?, ?)', $a->{name}, $a->{orig});
- }
- }
-}
-
-
-# returns alias IDs that are and were related to the given staff ID
-sub dbStaffAliasIds {
- my($self, $sid) = @_;
- return $self->dbAll(q|
- SELECT DISTINCT sa.aid
- FROM changes c
- JOIN staff_alias_hist sa ON sa.chid = c.id
- WHERE c.type = 's' AND c.itemid = ?|, $sid);
-}
-
-1;
diff --git a/lib/VNDB/DB/Tags.pm b/lib/VNDB/DB/Tags.pm
deleted file mode 100644
index 8c27e55f..00000000
--- a/lib/VNDB/DB/Tags.pm
+++ /dev/null
@@ -1,275 +0,0 @@
-
-package VNDB::DB::Tags;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbTagGet dbTTTree dbTagEdit dbTagAdd dbTagMerge dbTagLinks dbTagLinkEdit dbTagStats|;
-
-
-# %options->{ id noid name search state meta page results what sort reverse }
-# what: parents childs(n) aliases addedby
-# sort: id name added items search
-sub dbTagGet {
- my $self = shift;
- my %o = (
- page => 1,
- results => 10,
- what => '',
- @_
- );
-
- $o{search} =~ s/%//g if $o{search};
-
- my %where = (
- $o{id} ? (
- 't.id IN(!l)' => [ ref $o{id} ? $o{id} : [$o{id}] ] ) : (),
- $o{noid} ? (
- 't.id <> ?' => $o{noid} ) : (),
- $o{name} ? (
- 't.id = (SELECT id FROM tags LEFT JOIN tags_aliases ON id = tag WHERE lower(name) = ? OR lower(alias) = ? LIMIT 1)' => [ lc $o{name}, lc $o{name} ]) : (),
- defined $o{state} && $o{state} != -1 ? (
- 't.state = ?' => $o{state} ) : (),
- !defined $o{state} && !$o{id} && !$o{name} ? (
- 't.state <> 1' => 1 ) : (),
- $o{search} ? (
- 't.id IN (SELECT id FROM tags LEFT JOIN tags_aliases ON id = tag WHERE name ILIKE ? OR alias ILIKE ?)' => [ "%$o{search}%", "%$o{search}%" ] ) : (),
- defined $o{meta} ? (
- 't.meta = ?' => $o{meta}?1:0 ) : (),
- );
- my @select = (
- qw|t.id t.meta t.name t.description t.state t.cat t.c_items|,
- q|extract('epoch' from t.added) as added|,
- $o{what} =~ /addedby/ ? ('t.addedby', 'u.username') : (),
- );
- my @join = $o{what} =~ /addedby/ ? 'JOIN users u ON u.id = t.addedby' : ();
-
- my $order = sprintf {
- id => 't.id %s',
- name => 't.name %s',
- added => 't.added %s',
- items => 't.c_items %s',
- search=> 'substr_score(t.name, ?) ASC, t.name %s', # Assigning a matching score for aliases is also possible, but more involved
- }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC';
- my @order = $o{sort} && $o{sort} eq 'search' ? ($o{search}) : ();
-
-
- my($r, $np) = $self->dbPage(\%o, qq|
- SELECT !s
- FROM tags t
- !s
- !W
- ORDER BY $order|,
- join(', ', @select), join(' ', @join), \%where, @order
- );
-
- if(@$r && $o{what} =~ /aliases/) {
- my %r = map {
- $_->{aliases} = [];
- ($_->{id}, $_->{aliases})
- } @$r;
-
- push @{$r{$_->{tag}}}, $_->{alias} for (@{$self->dbAll(q|
- SELECT tag, alias FROM tags_aliases WHERE tag IN(!l)|, [ keys %r ]
- )});
- }
-
- if($o{what} =~ /parents\((\d+)\)/) {
- $_->{parents} = $self->dbTTTree(tag => $_->{id}, $1, 1) for(@$r);
- }
-
- if($o{what} =~ /childs\((\d+)\)/) {
- $_->{childs} = $self->dbTTTree(tag => $_->{id}, $1) for(@$r);
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Walks the tag/trait tree
-# type = tag | trait
-# id = tag to start with, or 0 to start with top-level tags
-# lvl = max. recursion level
-# back = false for parent->child, true for child->parent
-# Returns: [ { id, name, c_items, sub => [ { id, name, c_items, sub => [..] }, .. ] }, .. ]
-sub dbTTTree {
- my($self, $type, $id, $lvl, $back) = @_;
- $lvl ||= 15;
- my $xtra = $type eq 'trait' ? ', "order"' : '';
- my $xtra2 = $type eq 'trait' ? ', t."order"' : '';
- my $r = $self->dbAll(qq|
- WITH RECURSIVE thetree(lvl, id, parent, name, c_items) AS (
- SELECT ?::integer, id, 0, name, c_items$xtra
- FROM ${type}s
- !W
- UNION ALL
- SELECT tt.lvl-1, t.id, tt.id, t.name, t.c_items$xtra2
- FROM thetree tt
- JOIN ${type}s_parents tp ON !s
- JOIN ${type}s t ON !s
- WHERE tt.lvl > 0
- AND t.state = 2
- ) SELECT DISTINCT id, parent, name, c_items$xtra FROM thetree ORDER BY name|, $lvl,
- $id ? {'id = ?' => $id} : {"NOT EXISTS(SELECT 1 FROM ${type}s_parents WHERE $type = id)" => 1, 'state = 2' => 1},
- !$back ? ('tp.parent = tt.id', "t.id = tp.$type") : ("tp.$type = tt.id", 't.id = tp.parent')
- );
-
- my %pars; # parent-id -> [ child-object, .. ]
- push @{$pars{$_->{parent}}}, $_ for(@$r);
- $_->{'sub'} = $pars{$_->{id}} || [] for(@$r);
- my @r = grep !delete($_->{parent}), @$r;
- return $id ? $r[0]{'sub'} : \@r;
-}
-
-
-# args: tag id, %options->{ columns in the tags table + parents + aliases }
-sub dbTagEdit {
- my($self, $id, %o) = @_;
-
- $self->dbExec('UPDATE tags !H WHERE id = ?', {
- $o{upddate} ? ('added = NOW()' => 1) : (),
- map exists($o{$_}) ? ("$_ = ?" => $o{$_}) : (), qw|name meta description state cat|
- }, $id);
- if($o{aliases}) {
- $self->dbExec('DELETE FROM tags_aliases WHERE tag = ?', $id);
- $self->dbExec('INSERT INTO tags_aliases (tag, alias) VALUES (?, ?)', $id, $_) for (@{$o{aliases}});
- }
- if($o{parents}) {
- $self->dbExec('DELETE FROM tags_parents WHERE tag = ?', $id);
- $self->dbExec('INSERT INTO tags_parents (tag, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- }
- $self->dbExec('DELETE FROM tags_vn WHERE tag = ?', $id) if $o{meta} || ($o{state} && $o{state} == 1);
-}
-
-
-# same args as dbTagEdit, without the first tag id
-# returns the id of the new tag
-sub dbTagAdd {
- my($self, %o) = @_;
- my $id = $self->dbRow('INSERT INTO tags (name, meta, description, state, cat, addedby) VALUES (!l, ?) RETURNING id',
- [ map $o{$_}, qw|name meta description state cat| ], $o{addedby}||$self->authInfo->{id}
- )->{id};
- $self->dbExec('INSERT INTO tags_parents (tag, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- $self->dbExec('INSERT INTO tags_aliases (tag, alias) VALUES (?, ?)', $id, $_) for (@{$o{aliases}});
- return $id;
-}
-
-
-sub dbTagMerge {
- my($self, $id, @merge) = @_;
- $self->dbExec(q|
- DELETE FROM tags_vn tv
- WHERE tag IN(!l)
- AND EXISTS(SELECT 1 FROM tags_vn ti WHERE ti.tag = ? AND ti.uid = tv.uid AND ti.vid = tv.vid)|, \@merge, $id);
- $self->dbExec('UPDATE tags_vn SET tag = ? WHERE tag IN(!l)', $id, \@merge);
- $self->dbExec('UPDATE tags_aliases SET tag = ? WHERE tag IN(!l)', $id, \@merge);
- $self->dbExec('INSERT INTO tags_aliases (tag, alias) VALUES (?, ?)', $id, $_->{name})
- for (@{$self->dbAll('SELECT name FROM tags WHERE id IN(!l)', \@merge)});
- $self->dbExec('DELETE FROM tags_parents WHERE tag IN(!l)', \@merge);
- $self->dbExec('DELETE FROM tags WHERE id IN(!l)', \@merge);
-}
-
-
-# Directly fetch rows from tags_vn
-# Options: vid uid tag page results what sort reverse
-# What: details
-sub dbTagLinks {
- my($self, %o) = @_;
- $o{results} ||= 999;
- $o{page} ||= 1;
- $o{what} ||= '';
-
- my %where = (
- $o{vid} ? ('tv.vid = ?' => $o{vid}) : (),
- $o{uid} ? ('tv.uid = ?' => $o{uid}) : (),
- $o{tag} ? ('tv.tag = ?' => $o{tag}) : (),
- );
-
- my @select = (
- qw|tv.tag tv.vid tv.uid tv.vote tv.spoiler tv.ignore|, "EXTRACT('epoch' from tv.date) AS date",
- $o{what} =~ /details/ ? (qw|v.title u.username t.name|) : (),
- );
-
- my @join = $o{what} =~ /details/ ? (
- 'JOIN vn v ON v.id = tv.vid',
- 'JOIN users u ON u.id = tv.uid',
- 'JOIN tags t ON t.id = tv.tag'
- ) : ();
-
- my $order = !$o{sort} ? '' : 'ORDER BY '.{
- username => 'u.username',
- date => 'tv.date',
- title => 'v.title',
- tag => 't.name',
- }->{$o{sort}}.($o{reverse} ? ' DESC' : ' ASC');
-
- my($r, $np) = $self->dbPage(\%o,
- 'SELECT !s FROM tags_vn tv !s !W !s',
- join(', ', @select), join(' ', @join), \%where, $order
- );
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Change a user's tags for a VN entry
-sub dbTagLinkEdit {
- my($self, $uid, $vid, $insert, $update, $delete, $overrule) = @_;
-
- # overrule
- # 1. set ignore flag for everyone except $uid
- $self->dbExec('UPDATE tags_vn SET ignore = ? WHERE tag = ? AND vid = ? AND uid <> ?',
- $overrule->{$_}?1:0, $_, $vid, $uid) for(keys %$overrule);
- # 2. make sure $uid isn't ignored when others are set to ignore
- # (this happens when a mod takes over an other mods' overrule)
- $self->dbExec('UPDATE tags_vn SET ignore = false WHERE tag = ? AND vid = ? AND uid = ?',
- $_, $vid, $uid) for(grep $overrule->{$_}, keys %$overrule);
-
- # delete
- $self->dbExec('DELETE FROM tags_vn WHERE vid = ? AND uid = ? AND tag IN(!l)',
- $vid, $uid, [ keys %$delete ]) if keys %$delete;
-
- # insert
- my $val = join ',', map '(?,?,?,?,?,?)', keys %$insert;
- $self->dbExec("INSERT INTO tags_vn (tag, vid, uid, vote, spoiler, ignore) VALUES $val", map
- +($_, $vid, $uid, $insert->{$_}[0], $insert->{$_}[1]<0?undef:$insert->{$_}[1], $insert->{$_}[2]?1:0),
- keys %$insert) if keys %$insert;
-
- # update
- $self->dbExec('UPDATE tags_vn SET vote = ?, spoiler = ?, date = NOW() WHERE tag = ? AND vid = ? AND uid = ?',
- $update->{$_}[0], $update->{$_}[1]<0?undef:$update->{$_}[1], $_, $vid, $uid) for (keys %$update);
-}
-
-
-# Fetch all tags related to a VN
-# Argument: %options->{ vid minrating results what page sort reverse }
-# sort: name, rating
-sub dbTagStats {
- my($self, %o) = @_;
- $o{results} ||= 10;
- $o{page} ||= 1;
-
- my $rating = 'avg(CASE WHEN tv.ignore THEN NULL ELSE tv.vote END)';
- my $order = sprintf {
- name => 't.name %s',
- rating => "$rating %s",
- }->{ $o{sort}||'name' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, qq|
- SELECT t.id, t.name, t.cat, count(*) as cnt, $rating as rating,
- COALESCE(avg(CASE WHEN tv.ignore THEN NULL ELSE tv.spoiler END), 0) as spoiler,
- bool_or(tv.ignore) AS overruled
- FROM tags t
- JOIN tags_vn tv ON tv.tag = t.id
- WHERE tv.vid = ?
- GROUP BY t.id, t.name, t.cat
- !s
- ORDER BY !s|,
- $o{vid}, defined $o{minrating} ? "HAVING $rating > $o{minrating}" : '', $order
- );
-
- return wantarray ? ($r, $np) : $r;
-}
-
-1;
-
diff --git a/lib/VNDB/DB/Traits.pm b/lib/VNDB/DB/Traits.pm
deleted file mode 100644
index 728e4e85..00000000
--- a/lib/VNDB/DB/Traits.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-
-package VNDB::DB::Traits;
-
-# This module is for a large part a copy of VNDB::DB::Tags. I could have chosen
-# to modify that module to work for both traits and tags but that would have
-# complicated the code, so I chose to maintain two versions with similar
-# functionality instead.
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|dbTraitGet dbTraitEdit dbTraitAdd|;
-
-
-# Options: id noid search name state what results page sort reverse
-# what: parents childs(n) addedby
-# sort: id name name added items search
-sub dbTraitGet {
- my $self = shift;
- my %o = (
- page => 1,
- results => 10,
- what => '',
- @_,
- );
-
- $o{search} =~ s/%//g if $o{search};
-
- my %where = (
- $o{id} ? ( 't.id IN(!l)' => [ ref($o{id}) ? $o{id} : [$o{id}] ]) : (),
- $o{group} ? ( 't.group = ?' => $o{group} ) : (),
- $o{noid} ? ( 't.id <> ?' => $o{noid} ) : (),
- defined $o{state} && $o{state} != -1 ? (
- 't.state = ?' => $o{state} ) : (),
- !defined $o{state} && !$o{id} && !$o{name} ? (
- 't.state = 2' => 1 ) : (),
- $o{search} ? (
- '(t.name ILIKE ? OR t.alias ILIKE ?)' => [ "%$o{search}%", "%$o{search}%" ] ) : (),
- $o{name} ? ( # TODO: This is terribly ugly, use an aliases table.
- q{(LOWER(t.name) = LOWER(?) OR t.alias ~ ('(!sin)^'||?||'$'))} => [ $o{name}, '?', quotemeta $o{name} ] ) : (),
- );
-
- my @select = (
- qw|t.id t.meta t.name t.description t.state t.alias t."group" t."order" t.sexual t.c_items|,
- 'tg.name AS groupname', 'tg."order" AS grouporder', q|extract('epoch' from t.added) as added|,
- $o{what} =~ /addedby/ ? ('t.addedby', 'u.username') : (),
- );
- my @join = $o{what} =~ /addedby/ ? 'JOIN users u ON u.id = t.addedby' : ();
- push @join, 'LEFT JOIN traits tg ON tg.id = t."group"';
-
- my $order = sprintf {
- id => 't.id %s',
- name => 't.name %s',
- group => 'tg."order" %s, t.name %1$s',
- added => 't.added %s',
- items => 't.c_items %s',
- search=> 'substr_score(t.name, ?) ASC, t.name %s', # Can't score aliases at the moment
- }->{ $o{sort}||'id' }, $o{reverse} ? 'DESC' : 'ASC';
- my @order = $o{sort} && $o{sort} eq 'search' ? ($o{search}) : ();
-
- my($r, $np) = $self->dbPage(\%o, qq|
- SELECT !s
- FROM traits t
- !s
- !W
- ORDER BY $order|,
- join(', ', @select), join(' ', @join), \%where, @order,
- );
-
- if($o{what} =~ /parents\((\d+)\)/) {
- $_->{parents} = $self->dbTTTree(trait => $_->{id}, $1, 1) for(@$r);
- }
-
- if($o{what} =~ /childs\((\d+)\)/) {
- $_->{childs} = $self->dbTTTree(trait => $_->{id}, $1) for(@$r);
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# args: trait id, %options->{ columns in the traits table + parents }
-sub dbTraitEdit {
- my($self, $id, %o) = @_;
-
- $self->dbExec('UPDATE traits !H WHERE id = ?', {
- $o{upddate} ? ('added = NOW()' => 1) : (),
- map exists($o{$_}) ? ("\"$_\" = ?" => $o{$_}) : (), qw|name meta description state alias group order sexual|
- }, $id);
- if($o{parents}) {
- $self->dbExec('DELETE FROM traits_parents WHERE trait = ?', $id);
- $self->dbExec('INSERT INTO traits_parents (trait, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- }
-}
-
-
-# same args as dbTraitEdit, without the first trait id
-# returns the id of the new trait
-sub dbTraitAdd {
- my($self, %o) = @_;
- my $id = $self->dbRow('INSERT INTO traits (name, meta, description, state, alias, "group", "order", sexual, addedby) VALUES (!l, ?) RETURNING id',
- [ map $o{$_}, qw|name meta description state alias group order sexual| ], $o{addedby}||$self->authInfo->{id}
- )->{id};
- $self->dbExec('INSERT INTO traits_parents (trait, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- return $id;
-}
-
-
-1;
-
diff --git a/lib/VNDB/DB/ULists.pm b/lib/VNDB/DB/ULists.pm
deleted file mode 100644
index e6a85ba0..00000000
--- a/lib/VNDB/DB/ULists.pm
+++ /dev/null
@@ -1,353 +0,0 @@
-
-package VNDB::DB::ULists;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-
-our @EXPORT = qw|
- dbRListGet dbVNListGet dbVNListList dbVNListAdd dbVNListDel dbRListAdd dbRListDel
- dbVoteGet dbVoteStats dbVoteAdd dbVoteDel
- dbWishListGet dbWishListAdd dbWishListDel
-|;
-
-
-# Options: uid rid
-sub dbRListGet {
- my($self, %o) = @_;
-
- my %where = (
- 'uid = ?' => $o{uid},
- $o{rid} ? ('rid IN(!l)' => [ ref $o{rid} ? $o{rid} : [$o{rid}] ]) : (),
- );
-
- return $self->dbAll(q|
- SELECT uid, rid, status
- FROM rlists
- !W|,
- \%where
- );
-}
-
-# 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
-sub dbRListAdd {
- my($self, $uid, $rid, $stat) = @_;
- $self->dbExec(
- 'UPDATE rlists SET status = ? WHERE uid = ? AND rid IN(!l)',
- $stat, $uid, ref($rid) ? $rid : [ $rid ]
- )
- ||
- $self->dbExec(
- 'INSERT INTO rlists (uid, rid, status) VALUES(?, ?, ?)',
- $uid, $rid, $stat
- );
-}
-
-
-# Arguments: uid, rid
-sub dbRListDel {
- my($self, $uid, $rid) = @_;
- $self->dbExec(
- 'DELETE FROM rlists WHERE uid = ? AND rid IN(!l)',
- $uid, ref($rid) ? $rid : [ $rid ]
- );
-}
-
-
-# Options: uid vid hide hide_ign results page what sort reverse
-# what: user, vn
-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} ? ( 'NOT EXISTS(SELECT 1 FROM users_prefs WHERE uid = n.uid AND key = \'hide_list\')' => 1 ) : (),
- $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 ) : (),
- $o{user_char} ? ( 'LOWER(SUBSTR(u.username, 1, 1)) = ?' => $o{user_char} ) : (),
- defined $o{user_char} && !$o{user_char} ? (
- '(ASCII(u.username) < 97 OR ASCII(u.username) > 122) AND (ASCII(u.username) < 65 OR ASCII(u.username) > 90)' => 1 ) : (),
- );
-
- my @select = (
- qw|n.vid n.vote n.uid|, q|extract('epoch' from n.date) as date|,
- $o{what} =~ /user/ ? ('u.username') : (),
- $o{what} =~ /vn/ ? (qw|v.title v.original|) : (),
- );
-
- my @join = (
- $o{what} =~ /vn/ ? (
- 'JOIN vn v ON v.id = n.vid',
- ) : (),
- $o{what} =~ /user/ || $o{hide} ? (
- 'JOIN users u ON u.id = n.uid'
- ) : (),
- );
-
- my $order = sprintf {
- date => 'n.date %s',
- username => '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
-# 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 ] } : {},
- )});
- 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/Users.pm b/lib/VNDB/DB/Users.pm
deleted file mode 100644
index 84ff10f2..00000000
--- a/lib/VNDB/DB/Users.pm
+++ /dev/null
@@ -1,283 +0,0 @@
-
-package VNDB::DB::Users;
-
-use strict;
-use warnings;
-use Exporter 'import';
-
-our @EXPORT = qw|
- dbUserGet dbUserEdit dbUserAdd dbUserDel dbUserPrefSet dbUserLogin dbUserLogout
- dbUserUpdateLastUsed dbUserEmailExists dbUserGetMail dbUserSetMail dbUserSetPerm dbUserAdminSetPass
- dbUserResetPass dbUserIsValidToken dbUserSetPass
- dbNotifyGet dbNotifyMarkRead dbNotifyRemove
- dbThrottleGet dbThrottleSet
-|;
-
-
-# %options->{ username session uid ip registered search results page what sort reverse notperm }
-# what: notifycount stats scryptargs extended prefs hide_list
-# sort: username registered votes changes tags
-sub dbUserGet {
- my $s = shift;
- my %o = (
- page => 1,
- results => 10,
- what => '',
- sort => '',
- @_
- );
-
- my $token = unpack 'H*', $o{session}||'';
- $o{search} =~ s/%// if $o{search};
- my %where = (
- $o{username} ? (
- 'username = ?' => $o{username} ) : (),
- $o{firstchar} ? (
- 'SUBSTRING(username from 1 for 1) = ?' => $o{firstchar} ) : (),
- !$o{firstchar} && defined $o{firstchar} ? (
- 'ASCII(username) < 97 OR ASCII(username) > 122' => 1 ) : (),
- $o{uid} && !ref($o{uid}) ? (
- 'id = ?' => $o{uid} ) : (),
- $o{uid} && ref($o{uid}) ? (
- 'id IN(!l)' => [ $o{uid} ]) : (),
- !$o{uid} && !$o{username} ? (
- 'id > 0' => 1 ) : (),
- $o{ip} ? (
- 'ip !s ?' => [ $o{ip} =~ /\// ? '<<' : '=', $o{ip} ] ) : (),
- $o{registered} ? (
- 'registered > to_timestamp(?)' => $o{registered} ) : (),
- $o{search} ? (
- 'username ILIKE ?' => "%$o{search}%") : (),
- $token ? (
- q|user_isloggedin(id, decode(?, 'hex')) IS NOT NULL| => $token ) : (),
- $o{notperm} ? (
- 'perm & ~(?::smallint) > 0' => $o{notperm} ) : (),
- );
-
- my @select = (
- qw|id username c_votes c_changes c_tags|,
- q|extract('epoch' from registered) as registered|,
- $o{what} =~ /extended/ ? qw|perm ign_votes| : (), # mail
- $o{what} =~ /hide_list/ ? 'up.value AS hide_list' : (),
- $o{what} =~ /scryptargs/ ? 'user_getscryptargs(id) AS scryptargs' : (),
- $o{what} =~ /notifycount/ ?
- '(SELECT COUNT(*) FROM notifications WHERE uid = u.id AND read IS NULL) AS notifycount' : (),
- $o{what} =~ /stats/ ? (
- '(SELECT COUNT(*) FROM rlists WHERE uid = u.id) AS releasecount',
- '(SELECT COUNT(*) FROM vnlists WHERE uid = u.id) AS vncount',
- '(SELECT COUNT(*) FROM threads_posts WHERE uid = u.id) AS postcount',
- '(SELECT COUNT(*) FROM threads_posts WHERE uid = u.id AND num = 1) AS threadcount',
- '(SELECT COUNT(DISTINCT tag) FROM tags_vn WHERE uid = u.id) AS tagcount',
- '(SELECT COUNT(DISTINCT vid) FROM tags_vn WHERE uid = u.id) AS tagvncount',
- ) : (),
- $token ? qq|extract('epoch' from user_isloggedin(id, decode('$token', 'hex'))) as session_lastused| : (),
- );
-
- my @join = (
- $o{what} =~ /hide_list/ || $o{sort} eq 'votes' ?
- "LEFT JOIN users_prefs up ON up.uid = u.id AND up.key = 'hide_list'" : (),
- );
-
- my $order = sprintf {
- id => 'u.id %s',
- username => 'u.username %s',
- registered => 'u.registered %s',
- votes => 'up.value NULLS FIRST, u.c_votes %s',
- changes => 'u.c_changes %s',
- tags => 'u.c_tags %s',
- }->{ $o{sort}||'username' }, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $s->dbPage(\%o, q|
- SELECT !s
- FROM users u
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \%where, $order
- );
-
- if(@$r && $o{what} =~ /prefs/) {
- my %r = map {
- $r->[$_]{prefs} = {};
- ($r->[$_]{id}, $r->[$_])
- } 0..$#$r;
-
- $r{$_->{uid}}{prefs}{$_->{key}} = $_->{value} for (@{$s->dbAll(q|
- SELECT uid, key, value
- FROM users_prefs
- WHERE uid IN(!l)|,
- [ keys %r ]
- )});
- }
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# uid, %options->{ columns in users table }
-sub dbUserEdit {
- my($s, $uid, %o) = @_;
-
- my %h;
- defined $o{$_} && ($h{$_.' = ?'} = $o{$_})
- for (qw| username ign_votes email_confirmed |);
-
- return if scalar keys %h <= 0;
- return $s->dbExec(q|
- UPDATE users
- !H
- WHERE id = ?|,
- \%h, $uid);
-}
-
-
-# username, mail, [ip]
-sub dbUserAdd {
- $_[0]->dbRow(q|INSERT INTO users (username, mail, ip) VALUES(?, ?, ?) RETURNING id|, $_[1], $_[2], $_[3]||$_[0]->reqIP)->{id};
-}
-
-
-# uid
-sub dbUserDel {
- $_[0]->dbExec(q|DELETE FROM users WHERE id = ?|, $_[1]);
-}
-
-
-# uid, key, val
-sub dbUserPrefSet {
- my($s, $uid, $key, $val) = @_;
- !$val ? $s->dbExec('DELETE FROM users_prefs WHERE uid = ? AND key = ?', $uid, $key)
- : $s->dbExec('UPDATE users_prefs SET value = ? WHERE uid = ? AND key = ?', $val, $uid, $key)
- || $s->dbExec('INSERT INTO users_prefs (uid, key, value) VALUES (?, ?, ?)', $uid, $key, $val);
-}
-
-
-# uid, encpass, token
-sub dbUserLogin {
- $_[0]->dbRow(
- q|SELECT user_login(?, decode(?, 'hex'), decode(?, 'hex')) AS r|,
- $_[1], unpack('H*', $_[2]), unpack('H*', $_[3])
- )->{r}||0;
-}
-
-
-# uid, token
-sub dbUserLogout {
- $_[0]->dbExec(q|SELECT user_logout(?, decode(?, 'hex'))|, $_[1], unpack 'H*', $_[2]);
-}
-
-
-# uid, token
-sub dbUserUpdateLastUsed {
- $_[0]->dbExec(q|SELECT user_update_lastused(?, decode(?, 'hex'))|, $_[1], unpack 'H*', $_[2]);
-}
-
-
-sub dbUserEmailExists {
- $_[0]->dbRow(q|SELECT user_emailexists(?) AS r|, $_[1])->{r};
-}
-
-
-sub dbUserIsValidToken {
- $_[0]->dbRow(q|SELECT user_isvalidtoken(?, decode(?, 'hex')) AS r|, $_[1], unpack 'H*', $_[2])->{r};
-}
-
-
-sub dbUserResetPass {
- $_[0]->dbRow(q|SELECT user_resetpass(?, decode(?, 'hex')) AS r|, $_[1], unpack 'H*', $_[2])->{r};
-}
-
-
-sub dbUserSetPass {
- $_[0]->dbRow(q|SELECT user_setpass(?, decode(?, 'hex'), decode(?, 'hex')) AS r|, $_[1], unpack('H*', $_[2]), unpack('H*', $_[3]))->{r};
-}
-
-
-sub dbUserGetMail {
- $_[0]->dbRow(q|SELECT user_getmail(?, ?, decode(?, 'hex')) AS r|, $_[1], $_[2], unpack 'H*', $_[3])->{r};
-}
-
-
-sub dbUserSetMail {
- $_[0]->dbExec(q|SELECT user_setmail(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], unpack('H*', $_[3]), $_[4]);
-}
-
-
-sub dbUserSetPerm {
- $_[0]->dbExec(q|SELECT user_setperm(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], unpack('H*', $_[3]), $_[4]);
-}
-
-
-sub dbUserAdminSetPass {
- $_[0]->dbExec(q|SELECT user_admin_setpass(?, ?, decode(?, 'hex'), decode(?, 'hex'))|, $_[1], $_[2], unpack('H*', $_[3]), unpack('H*', $_[4]));
-}
-
-
-# %options->{ uid id what results page reverse }
-# what: titles
-sub dbNotifyGet {
- my($s, %o) = @_;
- $o{what} ||= '';
- $o{results} ||= 10;
- $o{page} ||= 1;
-
- my %where = (
- 'n.uid = ?' => $o{uid},
- $o{id} ? (
- 'n.id = ?' => $o{id} ) : (),
- defined($o{read}) ? (
- 'n.read !s' => $o{read} ? 'IS NOT NULL' : 'IS NULL' ) : (),
- );
-
- my @join = (
- $o{what} =~ /titles/ ? 'LEFT JOIN users u ON n.c_byuser = u.id' : (),
- );
-
- my @select = (
- qw|n.id n.ntype n.ltype n.iid n.subid|,
- q|extract('epoch' from n.date) as date|,
- q|extract('epoch' from n.read) as read|,
- $o{what} =~ /titles/ ? qw|u.username n.c_title| : (),
- );
-
- my($r, $np) = $s->dbPage(\%o, q|
- SELECT !s
- FROM notifications n
- !s
- !W
- ORDER BY n.id !s
- |, join(', ', @select), join(' ', @join), \%where, $o{reverse} ? 'DESC' : 'ASC');
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# ids
-sub dbNotifyMarkRead {
- my $s = shift;
- $s->dbExec('UPDATE notifications SET read = NOW() WHERE id IN(!l)', \@_);
-}
-
-
-# ids
-sub dbNotifyRemove {
- my $s = shift;
- $s->dbExec('DELETE FROM notifications WHERE id IN(!l)', \@_);
-}
-
-
-# ip
-sub dbThrottleGet {
- my $s = shift;
- my $t = $s->dbRow("SELECT extract('epoch' from timeout) as timeout FROM login_throttle WHERE ip = ?", shift)->{timeout};
- return $t && $t >= time ? $t : time;
-}
-
-# ip, timeout
-sub dbThrottleSet {
- my($s, $ip, $timeout) = @_;
- !$timeout ? $s->dbExec('DELETE FROM login_throttle WHERE ip = ?', $ip)
- : $s->dbExec('UPDATE login_throttle SET timeout = to_timestamp(?) WHERE ip = ?', $timeout, $ip)
- || $s->dbExec('INSERT INTO login_throttle (ip, timeout) VALUES (?, to_timestamp(?))', $ip, $timeout);
-}
-
-1;
-
diff --git a/lib/VNDB/DB/VN.pm b/lib/VNDB/DB/VN.pm
deleted file mode 100644
index 55464728..00000000
--- a/lib/VNDB/DB/VN.pm
+++ /dev/null
@@ -1,365 +0,0 @@
-
-package VNDB::DB::VN;
-
-use strict;
-use warnings;
-use TUWF 'sqlprint';
-use POSIX 'strftime';
-use Exporter 'import';
-use VNDB::Func 'gtintype', 'normalize_query';
-
-our @EXPORT = qw|dbVNGet dbVNGetRev dbVNRevisionInsert dbVNImageId dbScreenshotAdd dbScreenshotGet dbScreenshotRandom dbVNImportSeiyuu|;
-
-
-# Options: id, char, search, 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
-# 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
-# Sort: id rel pop rating title tagscore rand
-sub dbVNGet {
- my($self, %o) = @_;
- $o{results} ||= 10;
- $o{page} ||= 1;
- $o{what} ||= '';
- $o{sort} ||= 'title';
- $o{tagspoil} //= 2;
-
- # user input that is literally added to the query should be checked...
- die "Invalid input for tagspoil or tag_inc at dbVNGet()\n" if
- grep !defined($_) || $_!~/^\d+$/, $o{tagspoil},
- !$o{tag_inc} ? () : (ref($o{tag_inc}) ? @{$o{tag_inc}} : $o{tag_inc});
-
- my $uid = $self->authInfo->{id};
-
- my @where = (
- $o{id} ? (
- 'v.id IN(!l)' => [ ref $o{id} ? $o{id} : [$o{id}] ] ) : (),
- $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 ) : (),
- defined $o{length} ? (
- 'v.length IN(!l)' => [ ref $o{length} ? $o{length} : [$o{length}] ]) : (),
- $o{lang} ? (
- 'v.c_languages && ARRAY[!l]::language[]' => [ ref $o{lang} ? $o{lang} : [$o{lang}] ]) : (),
- $o{olang} ? (
- 'v.c_olang && ARRAY[!l]::language[]' => [ ref $o{olang} ? $o{olang} : [$o{olang}] ]) : (),
- $o{plat} ? (
- 'v.c_platforms && ARRAY[!l]::platform[]' => [ ref $o{plat} ? $o{plat} : [$o{plat}] ]) : (),
- defined $o{hasani} ? (
- '!sEXISTS(SELECT 1 FROM vn_anime va WHERE va.id = v.id)' => [ $o{hasani} ? '' : 'NOT ' ]) : (),
- defined $o{hasshot} ? (
- '!sEXISTS(SELECT 1 FROM vn_screenshots vs WHERE vs.id = v.id)' => [ $o{hasshot} ? '' : 'NOT ' ]) : (),
- $o{tag_inc} ? (
- 'v.id IN(SELECT vid FROM tags_vn_inherit WHERE tag IN(!l) AND spoiler <= ? GROUP BY vid HAVING COUNT(tag) = ?)',
- [ ref $o{tag_inc} ? $o{tag_inc} : [$o{tag_inc}], $o{tagspoil}, ref $o{tag_inc} ? $#{$o{tag_inc}}+1 : 1 ]) : (),
- $o{tag_exc} ? (
- 'v.id NOT IN(SELECT vid FROM tags_vn_inherit WHERE tag IN(!l))' => [ ref $o{tag_exc} ? $o{tag_exc} : [$o{tag_exc}] ] ) : (),
- $o{search} ? (
- map +('v.c_search like ?', "%$_%"), normalize_query($o{search})) : (),
- $uid && $o{ul_notblack} ? (
- 'v.id NOT IN(SELECT vid FROM wlists WHERE uid = ? AND wstat = 3)' => $uid ) : (),
- $uid && defined $o{ul_onwish} ? (
- 'v.id !s IN(SELECT vid FROM wlists WHERE uid = ?)' => [ $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 ] ) : (),
- $uid && defined $o{ul_onlist} ? (
- 'v.id !s IN(SELECT vid FROM vnlists 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)
- $o{sort} eq 'rand' && $o{results} <= 10 && !grep(!/^(?:results|page|what|sort|tagspoil)$/, keys %o) ? (
- 'v.id IN(SELECT floor(random() * last_value)::integer FROM generate_series(1,20), (SELECT MAX(id) AS last_value FROM vn) s1 LIMIT 20)' ) : (),
- defined $o{date_before} ? ( 'v.c_released <= ?' => $o{date_before} ) : (),
- defined $o{date_after} ? ( 'v.c_released >= ?' => $o{date_after} ) : (),
- defined $o{released} ? ( 'v.c_released !s ?' => [ $o{released} ? '<=' : '>', strftime('%Y%m%d', gmtime) ] ) : (),
- );
-
- if($o{release}) {
- my($q, @p) = sqlprint
- 'v.id IN(SELECT rv.vid FROM releases r JOIN releases_vn rv ON rv.id = r.id !W)',
- [ 'NOT r.hidden' => 1, $self->dbReleaseFilters(%{$o{release}}), ];
- push @where, $q, \@p;
- }
-
- 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
- FROM rlists irl
- JOIN releases_vn irv ON irv.id = irl.rid
- WHERE irl.uid = $uid
- GROUP BY irv.vid
- ) AS vnlist ON vnlist.vid = v.id") : (),
- );
-
- my $tag_ids = $o{tag_inc} && join ',', ref $o{tag_inc} ? @{$o{tag_inc}} : $o{tag_inc};
- my @select = ( # see https://rt.cpan.org/Ticket/Display.html?id=54224 for the cast on c_languages and c_platforms
- qw|v.id v.locked v.hidden v.c_released v.c_languages::text[] v.c_platforms::text[] v.title v.original v.rgraph|,
- $o{what} =~ /extended/ ? (
- qw|v.alias v.image v.img_nsfw v.length v.desc v.l_wp v.l_encubed v.l_renai| ) : (),
- $o{what} =~ /relgraph/ ? 'vg.svg' : (),
- $o{what} =~ /rating/ ? (qw|v.c_popularity v.c_rating v.c_votecount|) : (),
- $o{what} =~ /ranking/ ? (
- '(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 ?
- qq|(SELECT AVG(tvh.rating) FROM tags_vn_inherit tvh WHERE tvh.tag IN($tag_ids) AND tvh.vid = v.id AND spoiler <= $o{tagspoil} GROUP BY tvh.vid) AS tagscore| : (),
- );
-
- no if $] >= 5.022, warnings => 'redundant';
- my $order = sprintf {
- id => 'v.id %s',
- rel => 'v.c_released %s, v.title ASC',
- pop => 'v.c_popularity %s NULLS LAST',
- rating => 'v.c_rating %s NULLS LAST',
- title => 'v.title %s',
- tagscore => 'tagscore %s, v.title ASC',
- rand => 'RANDOM()',
- }->{$o{sort}}, $o{reverse} ? 'DESC' : 'ASC';
-
- my($r, $np) = $self->dbPage(\%o, q|
- SELECT !s
- FROM vn v
- !s
- !W
- ORDER BY !s|,
- join(', ', @select), join(' ', @join), \@where, $order,
- );
-
- return _enrich($self, $r, $np, 0, $o{what});
-}
-
-
-sub dbVNGetRev {
- my $self = shift;
- my %o = (what => '', @_);
-
- $o{rev} ||= $self->dbRow('SELECT MAX(rev) AS rev FROM changes WHERE type = \'v\' AND itemid = ?', $o{id})->{rev};
-
- # XXX: Too much duplication with code in dbVNGet() here. Can we combine some code here?
- my $uid = $self->authInfo->{id};
-
- my $select = 'c.itemid AS id, vo.c_released, vo.c_languages::text[], vo.c_platforms::text[], v.title, v.original, vo.rgraph';
- $select .= ', extract(\'epoch\' from c.added) as added, c.requester, c.comments, u.username, c.rev, c.ihid, c.ilock';
- $select .= ', c.id AS cid, NOT EXISTS(SELECT 1 FROM changes c2 WHERE c2.type = c.type AND c2.itemid = c.itemid AND c2.rev = c.rev+1) AS lastrev';
- $select .= ', v.alias, v.image, v.img_nsfw, v.length, v.desc, v.l_wp, v.l_encubed, v.l_renai, vo.hidden, vo.locked' if $o{what} =~ /extended/;
- $select .= ', vo.c_popularity, vo.c_rating, vo.c_votecount' if $o{what} =~ /rating/;
- $select .= ', (SELECT COUNT(*)+1 FROM vn iv WHERE iv.hidden = false AND iv.c_popularity > COALESCE(vo.c_popularity, 0.0)) AS p_ranking'
- .', (SELECT COUNT(*)+1 FROM vn iv WHERE iv.hidden = false AND iv.c_rating > COALESCE(vo.c_rating, 0.0)) AS r_ranking' if $o{what} =~ /ranking/;
-
- my $r = $self->dbAll(q|
- SELECT !s
- FROM changes c
- JOIN vn vo ON vo.id = c.itemid
- JOIN vn_hist v ON v.chid = c.id
- JOIN users u ON u.id = c.requester
- WHERE c.type = 'v' AND c.itemid = ? AND c.rev = ?|,
- $select, $o{id}, $o{rev}
- );
-
- return _enrich($self, $r, 0, 1, $o{what});
-}
-
-
-sub _enrich {
- my($self, $r, $np, $rev, $what) = @_;
-
- if(@$r && $what =~ /anime|relations|screenshots|staff|seiyuu/) {
- my($col, $hist, $colname) = $rev ? ('cid', '_hist', 'chid') : ('id', '', 'id');
- my %r = map {
- $r->[$_]{anime} = [];
- $r->[$_]{credits} = [];
- $r->[$_]{seiyuu} = [];
- $r->[$_]{relations} = [];
- $r->[$_]{screenshots} = [];
- ($r->[$_]{$col}, $_)
- } 0..$#$r;
-
- if($what =~ /staff/) {
- push(@{$r->[$r{ delete $_->{xid} }]{credits}}, $_) for (@{$self->dbAll("
- SELECT vs.$colname AS xid, s.id, vs.aid, sa.name, sa.original, s.gender, s.lang, vs.role, vs.note
- FROM vn_staff$hist vs
- JOIN staff_alias sa ON vs.aid = sa.aid
- JOIN staff s ON s.id = sa.id
- WHERE s.hidden = FALSE AND vs.$colname IN(!l)
- ORDER BY vs.role ASC, sa.name ASC",
- [ keys %r ]
- )});
- }
-
- if($what =~ /seiyuu/) {
- # The seiyuu query needs the VN id to get the VN<->Char spoiler level.
- # Obtaining this ID is different when using the hist table.
- my($vid, $join) = $rev ? ('h.itemid', 'JOIN changes h ON h.id = vs.chid') : ('vs.id', '');
- push(@{$r->[$r{ delete $_->{xid} }]{seiyuu}}, $_) for (@{$self->dbAll("
- SELECT vs.$colname AS xid, s.id, vs.aid, sa.name, sa.original, s.gender, s.lang, c.id AS cid, c.name AS cname, vs.note,
- (SELECT MAX(spoil) FROM chars_vns cv WHERE cv.vid = $vid AND cv.id = c.id) AS spoil
- FROM vn_seiyuu$hist vs
- JOIN staff_alias sa ON vs.aid = sa.aid
- JOIN staff s ON s.id = sa.id
- JOIN chars c ON c.id = vs.cid
- $join
- WHERE s.hidden = FALSE AND vs.$colname IN(!l)
- ORDER BY c.name",
- [ keys %r ]
- )});
- }
-
- if($what =~ /anime/) {
- push(@{$r->[$r{ delete $_->{xid} }]{anime}}, $_) for (@{$self->dbAll("
- SELECT va.$colname AS xid, a.id, a.year, a.ann_id, a.nfo_id, a.type, a.title_romaji, a.title_kanji, extract('epoch' from a.lastfetch) AS lastfetch
- FROM vn_anime$hist va
- JOIN anime a ON va.aid = a.id
- WHERE va.$colname IN(!l)",
- [ keys %r ]
- )});
- }
-
- if($what =~ /relations/) {
- push(@{$r->[$r{ delete $_->{xid} }]{relations}}, $_) for(@{$self->dbAll("
- SELECT rel.$colname AS xid, rel.vid AS id, rel.relation, rel.official, v.title, v.original
- FROM vn_relations$hist rel
- JOIN vn v ON rel.vid = v.id
- WHERE rel.$colname IN(!l)",
- [ keys %r ]
- )});
- }
-
- if($what =~ /screenshots/) {
- push(@{$r->[$r{ delete $_->{xid} }]{screenshots}}, $_) for (@{$self->dbAll("
- SELECT vs.$colname AS xid, s.id, vs.nsfw, vs.rid, s.width, s.height
- FROM vn_screenshots$hist vs
- JOIN screenshots s ON vs.scr = s.id
- WHERE vs.$colname IN(!l)
- ORDER BY vs.scr",
- [ keys %r ]
- )});
- }
- }
-
- return wantarray ? ($r, $np) : $r;
-}
-
-
-# Updates the edit_* tables, used from dbItemEdit()
-# Arguments: { columns in producers_rev + anime + relations + screenshots }
-# screenshots = [ [ scrid, nsfw, rid ], .. ]
-# relations = [ [ rel, vid ], .. ]
-# anime = [ aid, .. ]
-sub dbVNRevisionInsert {
- my($self, $o) = @_;
-
- $o->{img_nsfw} = $o->{img_nsfw}?1:0 if exists $o->{img_nsfw};
- my %set = map exists($o->{$_}) ? (qq|"$_" = ?| => $o->{$_}) : (),
- qw|title original desc alias image img_nsfw length l_wp l_encubed l_renai|;
- $self->dbExec('UPDATE edit_vn !H', \%set) if keys %set;
-
- if($o->{screenshots}) {
- $self->dbExec('DELETE FROM edit_vn_screenshots');
- my $q = join ',', map '(?, ?, ?)', @{$o->{screenshots}};
- my @val = map +($_->{id}, $_->{nsfw}?1:0, $_->{rid}), @{$o->{screenshots}};
- $self->dbExec("INSERT INTO edit_vn_screenshots (scr, nsfw, rid) VALUES $q", @val) if @val;
- }
-
- if($o->{relations}) {
- $self->dbExec('DELETE FROM edit_vn_relations');
- my $q = join ',', map '(?, ?, ?)', @{$o->{relations}};
- my @val = map +($_->[1], $_->[0], $_->[2]?1:0), @{$o->{relations}};
- $self->dbExec("INSERT INTO edit_vn_relations (vid, relation, official) VALUES $q", @val) if @val;
- }
-
- if($o->{anime}) {
- $self->dbExec('DELETE FROM edit_vn_anime');
- my $q = join ',', map '(?)', @{$o->{anime}};
- $self->dbExec("INSERT INTO edit_vn_anime (aid) VALUES $q", @{$o->{anime}}) if @{$o->{anime}};
- }
-
- if($o->{credits}) {
- $self->dbExec('DELETE FROM edit_vn_staff');
- my $q = join ',', ('(?, ?, ?)') x @{$o->{credits}};
- my @val = map +($_->{aid}, $_->{role}, $_->{note}), @{$o->{credits}};
- $self->dbExec("INSERT INTO edit_vn_staff (aid, role, note) VALUES $q", @val) if @val;
- }
-
- if($o->{seiyuu}) {
- $self->dbExec('DELETE FROM edit_vn_seiyuu');
- my $q = join ',', ('(?, ?, ?)') x @{$o->{seiyuu}};
- my @val = map +($_->{aid}, $_->{cid}, $_->{note}), @{$o->{seiyuu}};
- $self->dbExec("INSERT INTO edit_vn_seiyuu (aid, cid, note) VALUES $q", @val) if @val;
- }
-}
-
-
-# fetches an ID for a new image
-sub dbVNImageId {
- return shift->dbRow("SELECT nextval('covers_seq') AS ni")->{ni};
-}
-
-
-# insert a new screenshot and return it's ID
-sub dbScreenshotAdd {
- my($s, $width, $height) = @_;
- return $s->dbRow(q|INSERT INTO screenshots (width, height) VALUES (?, ?) RETURNING id|, $width, $height)->{id};
-}
-
-
-# arrayref of screenshot IDs as argument
-sub dbScreenshotGet {
- return shift->dbAll(q|SELECT * FROM screenshots WHERE id IN(!l)|, shift);
-}
-
-
-# Fetch random VN + screenshots
-# if any arguments are given, it will return one random screenshot for each VN
-sub dbScreenshotRandom {
- my($self, @vids) = @_;
- return $self->dbAll(q|
- SELECT s.id AS scr, s.width, s.height, v.id AS vid, v.title
- FROM screenshots s
- JOIN vn_screenshots vs ON vs.scr = s.id
- JOIN vn v ON v.id = vs.id
- WHERE NOT v.hidden AND NOT vs.nsfw
- AND s.id IN(
- SELECT floor(random() * last_value)::integer
- FROM generate_series(1,20), (SELECT MAX(id) AS last_value FROM screenshots) s1
- LIMIT 20
- )
- LIMIT 4|
- ) if !@vids;
- # this query is faster than it looks
- return $self->dbAll(join(' UNION ALL ', map
- q|SELECT s.id AS scr, s.width, s.height, v.id AS vid, v.title, RANDOM() AS position
- FROM (
- SELECT vs2.id, vs2.scr FROM vn_screenshots vs2
- WHERE vs2.id = ? AND NOT vs2.nsfw
- ORDER BY RANDOM() LIMIT 1
- ) vs
- JOIN vn v ON v.id = vs.id
- JOIN screenshots s ON s.id = vs.scr
- |, @vids).' ORDER BY position', @vids);
-}
-
-
-# returns seiyuus that voice characters referenced by $cids in VNs other than $vid
-sub dbVNImportSeiyuu {
- my($self, $vid, $cids) = @_;
- return $self->dbAll(q|
- SELECT DISTINCT ON(c.id) c.id AS cid, c.name AS c_name, sa.id AS sid, sa.aid, sa.name
- FROM vn_seiyuu vs
- JOIN chars c ON c.id = vs.cid
- JOIN staff_alias sa ON sa.aid = vs.aid
- WHERE vs.cid IN(!l) AND vs.id <> ?|, $cids, $vid);
-}
-
-
-1;
diff --git a/lib/VNDB/Func.pm b/lib/VNDB/Func.pm
deleted file mode 100644
index 6af8f5bf..00000000
--- a/lib/VNDB/Func.pm
+++ /dev/null
@@ -1,342 +0,0 @@
-
-package VNDB::Func;
-
-use strict;
-use warnings;
-use TUWF ':html', 'kv_validate', 'xml_escape';
-use Exporter 'import';
-use POSIX 'strftime', 'ceil', 'floor';
-use JSON::XS;
-use VNDBUtil;
-our @EXPORT = (@VNDBUtil::EXPORT, qw|
- clearfloat cssicon tagscore mt minage fil_parse fil_serialize parenttags
- childtags charspoil imgpath imgurl
- fmtvote fmtmedia fmtvnlen fmtage fmtdatestr fmtdate fmtuser fmtrating fmtspoil
- json_encode json_decode script_json
- form_compare
-|);
-
-
-# three ways to represent the same information
-our $fil_escape = '_ !"#$%&\'()*+,-./:;<=>?@[\]^`{}~';
-our @fil_escape = split //, $fil_escape;
-our %fil_escape = map +($fil_escape[$_], sprintf '%02d', $_), 0..$#fil_escape;
-
-
-# Clears a float, to make sure boxes always have the correct height
-sub clearfloat {
- div class => 'clearfloat', '';
-}
-
-
-# Draws a CSS icon, arguments: class, title
-sub cssicon {
- abbr class => "icons $_[0]", title => $_[1];
- lit '&#xa0;';
- end;
-}
-
-
-# Tag score in html tags, argument: score, users
-sub tagscore {
- my $s = shift;
- div class => 'taglvl', style => sprintf('width: %.0fpx', ($s-floor($s))*10), ' ' if $s < 0 && $s-floor($s) > 0;
- for(-3..3) {
- div(class => "taglvl taglvl0", sprintf '%.1f', $s), next if !$_;
- if($_ < 0) {
- if($s > 0 || floor($s) > $_) {
- div class => "taglvl taglvl$_", ' ';
- } elsif(floor($s) != $_) {
- div class => "taglvl taglvl$_ taglvlsel", ' ';
- } else {
- div class => "taglvl taglvl$_ taglvlsel", style => sprintf('width: %.0fpx', 10-($s-$_)*10), ' ';
- }
- } else {
- if($s < 0 || ceil($s) < $_) {
- div class => "taglvl taglvl$_", ' ';
- } elsif(ceil($s) != $_) {
- div class => "taglvl taglvl$_ taglvlsel", ' ';
- } else {
- div class => "taglvl taglvl$_ taglvlsel", style => sprintf('width: %.0fpx', 10-($_-$s)*10), ' ';
- }
- }
- }
- div class => 'taglvl', style => sprintf('width: %.0fpx', (ceil($s)-$s)*10), ' ' if $s > 0 && ceil($s)-$s > 0;
-}
-
-
-# short wrapper around maketext()
-sub mt {
- return $TUWF::OBJ->{l10n}->maketext(@_);
-}
-
-
-sub minage {
- my($a, $ex) = @_;
- my $str = $a == -1 ? 'Unknown' : !$a ? 'All ages' : sprintf '%d+', $a;
- $ex = !defined($a) ? '' : {
- 0 => 'CERO A',
- 12 => 'CERO B',
- 15 => 'CERO C',
- 17 => 'CERO D',
- 18 => 'CERO Z',
- }->{$a} if $ex;
- return $str if !$ex;
- return "$str (e.g. $ex)";
-}
-
-
-# arguments: $filter_string, @allowed_keys
-sub fil_parse {
- my $str = shift;
- my %keys = map +($_,1), @_;
- my %r;
- for (split /\./, $str) {
- next if !/^([a-z0-9_]+)-([a-zA-Z0-9_~]+)$/ || !$keys{$1};
- my($f, $v) = ($1, $2);
- my @v = split /~/, $v;
- s/_([0-9]{2})/$1 > $#fil_escape ? '' : $fil_escape[$1]/eg for(@v);
- $r{$f} = @v > 1 ? \@v : $v[0]
- }
- return \%r;
-}
-
-
-sub fil_serialize {
- my $fil = shift;
- my $e = qr/([\Q$fil_escape\E])/;
- return join '.', map {
- my @v = ref $fil->{$_} ? @{$fil->{$_}} : ($fil->{$_});
- s/$e/_$fil_escape{$1}/g for(@v);
- $_.'-'.join '~', @v
- } grep defined($fil->{$_}), keys %$fil;
-}
-
-
-# generates a parent tags/traits listing
-sub parenttags {
- my($t, $index, $type) = @_;
- p;
- my @p = _parenttags(@{$t->{parents}});
- for my $p (@p ? @p : []) {
- a href => "/$type", $index;
- for (reverse @$p) {
- txt ' > ';
- a href => "/$type$_->{id}", $_->{name};
- }
- txt " > $t->{name}";
- br;
- }
- end 'p';
-}
-
-# arg: tag/trait hashref
-# returns: [ [ tag1, tag2, tag3 ], [ tag1, tag2, tag5 ] ]
-sub _parenttags {
- my @r;
- for my $t (@_) {
- for (@{$t->{'sub'}}) {
- push @r, [ $t, @$_ ] for _parenttags($_);
- }
- push @r, [$t] if !@{$t->{'sub'}};
- }
- return @r;
-}
-
-
-# a child tags/traits box
-sub childtags {
- my($self, $title, $type, $t, $order) = @_;
-
- div class => 'mainbox';
- h1 $title;
- ul class => 'tagtree';
- for my $p (sort { !$order ? @{$b->{'sub'}} <=> @{$a->{'sub'}} : $a->{$order} <=> $b->{$order} } @{$t->{childs}}) {
- li;
- a href => "/$type$p->{id}", $p->{name};
- b class => 'grayedout', " ($p->{c_items})" if $p->{c_items};
- end, next if !@{$p->{'sub'}};
- ul;
- for (0..$#{$p->{'sub'}}) {
- last if $_ >= 5 && @{$p->{'sub'}} > 6;
- li;
- txt '> ';
- a href => "/$type$p->{sub}[$_]{id}", $p->{'sub'}[$_]{name};
- b class => 'grayedout', " ($p->{sub}[$_]{c_items})" if $p->{'sub'}[$_]{c_items};
- end;
- }
- if(@{$p->{'sub'}} > 6) {
- my $c = @{$p->{'sub'}}-5;
- li;
- txt '> ';
- a href => "/$type$p->{id}", style => 'font-style: italic',
- sprintf '%d more %s%s', $c, $type eq 'g' ? 'tag' : 'trait', $c==1 ? '' : 's';
- end;
- }
- end;
- end 'li';
- }
- end 'ul';
- clearfloat;
- br;
- end 'div';
-}
-
-
-# generates the class elements for character spoiler hiding
-sub charspoil {
- return "charspoil charspoil_$_[0]".($_[0] ? ' hidden' : '');
-}
-
-
-# generates a local path to an image in static/
-sub imgpath { # <type>, <id>
- return sprintf '%s/static/%s/%02d/%d.jpg', $VNDB::ROOT, $_[0], $_[1]%100, $_[1];
-}
-
-
-# generates a URL for an image in static/
-sub imgurl {
- return sprintf '%s/%s/%02d/%d.jpg', $TUWF::OBJ->{url_static}, $_[0], $_[1]%100, $_[1];
-}
-
-
-# Formats a vote number.
-sub fmtvote {
- return !$_[0] ? '-' : $_[0] % 10 == 0 ? $_[0]/10 : sprintf '%.1f', $_[0]/10;
-}
-
-# Formats a media string ("1 CD", "2 CDs", "Internet download", etc)
-sub fmtmedia {
- my($med, $qty) = @_;
- $med = $TUWF::OBJ->{media}{$med};
- join ' ',
- ($med->[0] ? ($qty) : ()),
- $med->[ $med->[0] && $qty > 1 ? 2 : 1 ];
-}
-
-# Formats a VN length (xtra = 1 for time indication, 2 for examples)
-sub fmtvnlen {
- my($len, $xtra) = @_;
- $len = $TUWF::OBJ->{vn_lengths}[$len];
- $len->[0].
- ($xtra && $xtra == 1 && $len->[1] ? " ($len->[1])" : '').
- ($xtra && $xtra == 2 && $len->[2] ? " ($len->[2])" : '');
-}
-
-# Formats a UNIX timestamp as a '<number> <unit> ago' string
-sub fmtage {
- my $a = time-shift;
- my($t, $single, $plural) =
- $a > 60*60*24*365*2 ? ( $a/60/60/24/365, 'year', 'years' ) :
- $a > 60*60*24*(365/12)*2 ? ( $a/60/60/24/(365/12), 'month', 'months' ) :
- $a > 60*60*24*7*2 ? ( $a/60/60/24/7, 'week', 'weeks' ) :
- $a > 60*60*24*2 ? ( $a/60/60/24, 'day', 'days' ) :
- $a > 60*60*2 ? ( $a/60/60, 'hour', 'hours' ) :
- $a > 60*2 ? ( $a/60, 'min', 'min' ) :
- ( $a, 'sec', 'sec' );
- $t = sprintf '%d', $t;
- sprintf '%d %s ago', $t, $t == 1 ? $single : $plural;
-}
-
-# argument: database release date format (yyyymmdd)
-# y = 0000 -> unknown
-# y = 9999 -> TBA
-# m = 99 -> month+day unknown
-# d = 99 -> day unknown
-# return value: (unknown|TBA|yyyy|yyyy-mm|yyyy-mm-dd)
-# if date > now: <b class="future">str</b>
-sub fmtdatestr {
- 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);
-
- return $str if !$future;
- return qq|<b class="future">$str</b>|;
-}
-
-# argument: unix timestamp and optional format (compact/full)
-sub fmtdate {
- my($t, $f) = @_;
- return strftime '%Y-%m-%d', gmtime $t if !$f || $f eq 'compact';
- return strftime '%Y-%m-%d at %R', gmtime $t;
-}
-
-# Arguments: (uid, username), or a hashref containing that info
-sub fmtuser {
- my($id,$n) = ref($_[0]) eq 'HASH' ? ($_[0]{uid}||$_[0]{requester}, $_[0]{username}) : @_;
- return !$id ? '[deleted]' : sprintf '<a href="/u%d">%s</a>', $id, xml_escape $n;
-}
-
-# Turn a (natural number) vote into a rating indication
-sub fmtrating {
- ['worst ever',
- 'awful',
- 'bad',
- 'weak',
- 'so-so',
- 'decent',
- 'good',
- 'very good',
- 'excellent',
- 'masterpiece']->[shift()-1];
-}
-
-# Turn a spoiler level into a string
-sub fmtspoil {
- ['neutral',
- 'no spoiler',
- 'minor spoiler',
- 'major spoiler']->[shift()+1];
-}
-
-
-
-# JSON::XS::encode_json converts input to utf8, whereas the below functions
-# operate on wide character strings. Canonicalization is enabled to allow for
-# proper comparison of serialized objects.
-my $JSON = JSON::XS->new;
-$JSON->canonical(1);
-
-sub json_encode ($) {
- $JSON->encode(@_);
-}
-
-sub json_decode ($) {
- $JSON->decode(@_);
-}
-
-# Insert JSON-encoded data as script, arguments: id, object
-sub script_json {
- script id => $_[0], type => 'application/json';
- my $js = json_encode $_[1];
- $js =~ s/</\\u003C/g; # escape HTML tags like </script> and <!--
- lit $js;
- end;
-}
-
-
-
-# Compare the keys in %$old with the keys in %$new. Returns 1 if a difference was found, 0 otherwise.
-sub form_compare {
- my($old, $new) = @_;
- for my $k (keys %$old) {
- my($o, $n) = ($old->{$k}, $new->{$k});
- return 1 if !defined $n || ref $o ne ref $n;
- if(!ref $o) {
- return 1 if $o ne $n;
- } else { # 'json' template
- return 1 if @$o != @$n;
- return 1 if grep form_compare($o->[$_], $n->[$_]), 0..$#$o;
- }
- }
- return 0;
-}
-
-1;
-
diff --git a/lib/VNDB/Handler/Affiliates.pm b/lib/VNDB/Handler/Affiliates.pm
deleted file mode 100644
index efba6b18..00000000
--- a/lib/VNDB/Handler/Affiliates.pm
+++ /dev/null
@@ -1,152 +0,0 @@
-
-package VNDB::Handler::Affiliates;
-
-use strict;
-use warnings;
-use TUWF ':html';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{affiliates} => \&list,
- qr{affiliates/del/([1-9]\d*)} => \&linkdel,
- qr{affiliates/edit/([1-9]\d*)} => \&edit,
- qr{affiliates/new} => \&edit,
-);
-
-
-sub list {
- my $self = shift;
-
- return $self->htmlDenied if !$self->authCan('affiliate');
- my $f = $self->formValidate(
- { get => 'a', required => 0, enum => [ 0..$#{$self->{affiliates}} ] },
- { get => 'h', required => 0, default => 0, enum => [ -1..1 ] },
- { get => 'o', required => 0, default => 'a', enum => ['a', 'd'] },
- { get => 's', required => 0, default => 'rel', enum => [qw|rel prio url lastfetch|] },
- );
- return $self->resNotFound if $f->{_err};
-
- $self->htmlHeader(title => 'Affiliate administration interface');
- div class => 'mainbox';
- h1 'Affiliate administration interface';
- p class => 'browseopts';
- a defined($f->{a}) && $f->{a} == $_ ? (class => 'optselected') : (), href => "/affiliates?a=$_", $self->{affiliates}[$_]{name}
- for (grep $self->{affiliates}[$_], 0..$#{$self->{affiliates}});
- end;
- if(defined $f->{a}) {
- p class => 'browseopts';
- a $f->{h} == -1 ? (class => 'optselected') : (), href => "/affiliates?a=$f->{a};h=-1",'all';
- a $f->{h} == 1 ? (class => 'optselected') : (), href => "/affiliates?a=$f->{a};h=1", 'hidden';
- a $f->{h} == 0 ? (class => 'optselected') : (), href => "/affiliates?a=$f->{a};h=0", 'non-hidden';
- end;
- }
- end;
-
- if(defined $f->{a}) {
- my $list = $self->dbAffiliateGet(
- affiliate => $f->{a}, hidden => $f->{h}==-1?undef:$f->{h},
- what => 'release',
- sort => $f->{s}, reverse => $f->{o} eq 'd'
- );
- $self->htmlBrowse(
- items => $list,
- nextpage => 0,
- options => {p=>0, %$f},
- pageurl => '',
- sorturl => "/affiliates?a=$f->{a};h=$f->{h}",
- header => [
- ['Release', 'rel'],
- ['Version'],
- ['Hid'],
- ['Prio', 'prio'],
- ['Price / Lastfetch', 'lastfetch'],
- ['', 'url' ]
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1'; a href => "/r$l->{rid}", shorten $l->{title}, 50; end;
- td class => 'tc2', $l->{version} || '<default>';
- td class => 'tc3', $l->{hidden} ? 'YES' : 'no';
- td class => 'tc4', $l->{priority};
- td class => 'tc5', sprintf '%s / %s', $l->{price}, $l->{lastfetch} ? fmtage($l->{lastfetch}) : '-';
- td class => 'tc6';
- a href => $l->{url}, 'link';
- txt ' | ';
- a href => "/affiliates/edit/$l->{id}", 'edit';
- txt ' | ';
- a href => "/affiliates/del/$l->{id}?formcode=".$self->authGetCode("/affiliates/del/$l->{id}"), 'del';
- end;
- end;
- },
- );
- }
- $self->htmlFooter;
-}
-
-
-sub linkdel {
- my($self, $id) = @_;
- return $self->htmlDenied if !$self->authCan('affiliate');
- return if !$self->authCheckCode;
- my $l = $self->dbAffiliateGet(id => $id)->[0];
- return $self->resNotFound if !$l;
- $self->dbAffiliateDel($id);
- $self->resRedirect("/affiliates?a=$l->{affiliate}");
-}
-
-
-sub edit {
- my($self, $id) = @_;
- return $self->htmlDenied if !$self->authCan('affiliate');
-
- my $r = $id && $self->dbAffiliateGet(id => $id)->[0];
- return $self->resNotFound if $id && !$r;
-
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'rid', required => 1, template => 'id' },
- { post => 'priority', required => 0, default => 0, template => 'int' },
- { post => 'hidden', required => 0, default => 0, enum => [0,1] },
- { post => 'affiliate',required => 1, enum => [0..$#{$self->{affiliates}}] },
- { post => 'url', required => 1 },
- { post => 'version', required => 0, default => '' },
- { post => 'price', required => 0, default => '' },
- { post => 'lastfetch',required => 0, template => 'uint' },
- { post => 'data', required => 0, default => '' },
- );
- if(!$frm->{_err}) {
- $self->dbAffiliateEdit($id, %$frm) if $id;
- $self->dbAffiliateAdd(%$frm) if !$id;
- return $self->resRedirect("/affiliates?a=$frm->{affiliate}", 'post');
- }
- }
-
- if($id) {
- $frm->{$_} = $r->{$_} for(qw|rid priority hidden affiliate url version price lastfetch data|);
- } else {
- $frm->{rid} = $self->reqGet('rid');
- }
-
- $self->htmlHeader(title => 'Edit affiliate link');
- $self->htmlForm({ frm => $frm, action => $id ? "/affiliates/edit/$id" : '/affiliates/new' }, 'blah' => [ 'Edit affiliate link',
- [ input => short => 'rid', name => 'Release ID', width => 100 ],
- [ input => short => 'priority', name => 'Priority', width => 50 ],
- [ check => short => 'hidden', name => 'Hidden' ],
- [ select => short => 'affiliate', name => 'Affiliate', options => [ map
- [ $_, $self->{affiliates}[$_]{name} ], grep $self->{affiliates}[$_], 0..$#{$self->{affiliates}} ] ],
- [ input => short => 'url', name => 'URL', width => 400 ],
- [ input => short => 'version', name => 'Version', width => 400 ],
- [ input => short => 'price', name => 'Price' ],
- [ input => short => 'lastfetch', name => 'Lastfetch', post => ' UNIX timestamp' ],
- [ input => short => 'data', name => 'Data', width => 400 ],
- ]);
- $self->htmlFooter;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Chars.pm b/lib/VNDB/Handler/Chars.pm
deleted file mode 100644
index d412aae9..00000000
--- a/lib/VNDB/Handler/Chars.pm
+++ /dev/null
@@ -1,586 +0,0 @@
-
-package VNDB::Handler::Chars;
-
-use strict;
-use warnings;
-use TUWF ':html', 'uri_escape';
-use Exporter 'import';
-use VNDB::Func;
-use List::Util 'min';
-
-our @EXPORT = ('charOps', 'charTable', 'charBrowseTable');
-
-TUWF::register(
- qr{c([1-9]\d*)(?:\.([1-9]\d*))?} => \&page,
- qr{c(?:([1-9]\d*)(?:\.([1-9]\d*))?/(edit|copy)|/new)}
- => \&edit,
- qr{c/([a-z0]|all)} => \&list,
-);
-
-
-sub page {
- my($self, $id, $rev) = @_;
-
- my $method = $rev ? 'dbCharGetRev' : 'dbCharGet';
- my $r = $self->$method(
- id => $id,
- what => 'extended traits vns seiyuu',
- $rev ? ( rev => $rev ) : ()
- )->[0];
- return $self->resNotFound if !$r->{id};
-
- my $metadata = {
- 'og:title' => $r->{name},
- 'og:description' => $r->{desc},
- 'og:image' => $r->{image} && imgurl(ch => $r->{image}),
- };
-
- $self->htmlHeader(title => $r->{name}, noindex => $rev, metadata => $metadata);
- $self->htmlMainTabs(c => $r);
- return if $self->htmlHiddenMessage('c', $r);
-
- if($rev) {
- my $prev = $rev && $rev > 1 && $self->dbCharGetRev(id => $id, rev => $rev-1, what => 'extended traits vns')->[0];
- $self->htmlRevision('c', $prev, $r,
- [ name => 'Name', diff => 1 ],
- [ original => 'Original name', diff => 1 ],
- [ alias => 'Aliases', diff => qr/[ ,\n\.]/ ],
- [ desc => 'Description', diff => qr/[ ,\n\.]/ ],
- [ gender => 'Gender', serialize => sub { $self->{genders}{$_[0]} } ],
- [ b_month => 'Birthday/month',serialize => sub { $_[0]||'[empty]' } ],
- [ b_day => 'Birthday/day', serialize => sub { $_[0]||'[empty]' } ],
- [ s_bust => 'Bust', serialize => sub { $_[0]||'[empty]' } ],
- [ s_waist => 'Waist', serialize => sub { $_[0]||'[empty]' } ],
- [ s_hip => 'Hip', serialize => sub { $_[0]||'[empty]' } ],
- [ height => 'Height', serialize => sub { $_[0]||'[empty]' } ],
- [ weight => 'Weight', serialize => sub { $_[0]||'[empty]' } ],
- [ bloodt => 'Blood type', serialize => sub { $self->{blood_types}{$_[0]} } ],
- [ main => 'Main character',htmlize => sub { $_[0] ? sprintf '<a href="/c%d">c%d</a>', $_[0], $_[0] : '[empty]' } ],
- [ main_spoil=> 'Spoiler', serialize => \&fmtspoil ],
- [ image => 'Image', htmlize => sub {
- return $_[0] ? sprintf '<img src="%s" />', imgurl(ch => $_[0]) : 'No image';
- }],
- [ traits => 'Traits', join => '<br />', split => sub {
- map sprintf('%s<a href="/i%d">%s</a> (%s)', $_->{group}?qq|<b class="grayedout">$_->{groupname} / </b> |:'',
- $_->{tid}, $_->{name}, fmtspoil $_->{spoil}), @{$_[0]}
- }],
- [ vns => 'Visual novels', join => '<br />', split => sub {
- map sprintf('<a href="/v%d">v%d</a> %s %s (%s)', $_->{vid}, $_->{vid},
- $_->{rid}?sprintf('[<a href="/r%d">r%d</a>]', $_->{rid}, $_->{rid}):'',
- $self->{char_roles}{$_->{role}}[0], fmtspoil $_->{spoil}), @{$_[0]};
- }],
- );
- }
-
- div class => 'mainbox';
- $self->htmlItemMessage('c', $r);
- $self->charOps(1);
- h1 $r->{name};
- h2 class => 'alttitle', $r->{original} if $r->{original};
- $self->charTable($r);
- end;
-
- # TODO: ordering of these instances?
- my $inst = [];
- if(!$r->{main}) {
- $inst = $self->dbCharGet(instance => $r->{id}, what => 'extended traits vns seiyuu');
- } else {
- $inst = $self->dbCharGet(instance => $r->{main}, notid => $r->{id}, what => 'extended traits vns seiyuu');
- push @$inst, $self->dbCharGet(id => $r->{main}, what => 'extended traits vns seiyuu')->[0];
- }
- if(@$inst) {
- my $spoil = sub { local $_=shift; !$r->{main} ? $_->{main_spoil} : $_->{main_spoil} > $r->{main_spoil} ? $_->{main_spoil} : $r->{main_spoil} };
- my $minspoil = min map $spoil->($_), @$inst;
- div class => 'mainbox '.charspoil($minspoil);
- h1 'Other instances';
- $self->charTable($_, 1, $_ != $inst->[0], 0, $spoil->($_)) for @$inst;
- end;
- }
-
- $self->htmlFooter;
-}
-
-
-sub charOps {
- my($self, $sexual) = @_;
- my $spoil = $self->authPref('spoilers')||0;
- p id => 'charops';
- # Note: Order of these links is hardcoded in JS
- a href => '#', $spoil == $_ ? (class => 'sel') : (), ['Hide spoilers', 'Show minor spoilers', 'Spoil me!']->[$_] for (0..2);
- a href => '#', class => 'sec'.($self->authPref('traits_sexual') ? ' sel' : ''), 'Show sexual traits' if $sexual;
- end;
-}
-
-
-# Also used from Handler::VNPage
-sub charTable {
- my($self, $r, $link, $sep, $vn, $spoil) = @_;
- $spoil ||= 0;
-
- div class => 'chardetails '.charspoil($spoil).($sep ? ' charsep' : '');
-
- # image
- div class => 'charimg';
- if(!$r->{image}) {
- p 'No image uploaded yet';
- } else {
- img src => imgurl(ch => $r->{image}), alt => $r->{name};
- }
- end 'div';
-
- # info table
- table class => 'stripe';
- thead;
- Tr;
- td colspan => 2;
- if($link) {
- a href => "/c$r->{id}", style => 'margin-right: 10px; font-weight: bold', $r->{name};
- } else {
- b style => 'margin-right: 10px', $r->{name};
- }
- b class => 'grayedout', style => 'margin-right: 10px', $r->{original} if $r->{original};
- cssicon "gen $r->{gender}", $self->{genders}{$r->{gender}} if $r->{gender} ne 'unknown';
- span $self->{blood_types}{$r->{bloodt}} if $r->{bloodt} ne 'unknown';
- end;
- end;
- end;
-
- if($r->{alias}) {
- $r->{alias} =~ s/\n/, /g;
- Tr;
- td class => 'key', 'Aliases';
- td $r->{alias};
- end;
- }
- if($r->{weight} || $r->{height} || $r->{s_bust} || $r->{s_waist} || $r->{s_hip}) {
- Tr;
- td class => 'key', 'Measurements';
- td join ', ',
- $r->{height} ? "Height: $r->{height}cm" : (),
- $r->{weight} ? "Weight: $r->{weight}kg" : (),
- $r->{s_bust} || $r->{s_waist} || $r->{s_hip} ?
- sprintf 'Bust-Waist-Hips: %s-%s-%scm', $r->{s_bust}||'??', $r->{s_waist}||'??', $r->{s_hip}||'??' : ();
- end;
- }
- if($r->{b_month} && $r->{b_day}) {
- Tr;
- td class => 'key', 'Birthday';
- td $r->{b_day}.' '.[qw{January February March April May June July August September October November December}]->[$r->{b_month}-1];
- end;
- }
-
- # traits
- my %groups;
- my @groups;
- for (@{$r->{traits}}) {
- my $g = $_->{group}||$_->{tid};
- push @groups, $g if !$groups{$g};
- push @{$groups{ $g }}, $_
- }
- for my $g (@groups) {
- Tr class => 'traitrow';
- td class => 'key'; a href => '/i'.($groups{$g}[0]{group}||$groups{$g}[0]{tid}), $groups{$g}[0]{groupname} || $groups{$g}[0]{name}; end;
- td;
- for (0..$#{$groups{$g}}) {
- my $t = $groups{$g}[$_];
- span class => charspoil($t->{spoil}).($t->{sexual} ? ' sexual hidden' : '');
- span ', ';
- a href => "/i$t->{tid}", $t->{name};
- end;
- }
- end;
- end;
- }
-
- # vns
- if(@{$r->{vns}} && (!$vn || $vn && (@{$r->{vns}} > 1 || $r->{vns}[0]{rid}))) {
- my %vns;
- push @{$vns{$_->{vid}}}, $_ for(sort { !defined($a->{rid})?1:!defined($b->{rid})?-1:$a->{rtitle} cmp $b->{rtitle} } @{$r->{vns}});
- Tr;
- td class => 'key', $vn ? 'Releases' : 'Visual novels';
- td;
- my $first = 0;
- for my $g (sort { $vns{$a}[0]{vntitle} cmp $vns{$b}[0]{vntitle} } keys %vns) {
- br if $first++;
- my @r = @{$vns{$g}};
- # special case: all releases, no exceptions
- if(!$vn && @r == 1 && !$r[0]{rid}) {
- span class => charspoil $r[0]{spoil};
- txt $self->{char_roles}{$r[0]{role}}[0].' - ';
- a href => "/v$r[0]{vid}/chars", $r[0]{vntitle};
- end;
- next;
- }
- # otherwise, print VN title and list releases separately
- my $minspoil = 5;
- $minspoil = $minspoil > $_->{spoil} ? $_->{spoil} : $minspoil for (@r);
- span class => charspoil $minspoil;
- a href => "/v$r[0]{vid}/chars", $r[0]{vntitle} if !$vn;
- for(@r) {
- span class => charspoil $_->{spoil};
- br if !$vn || $_ != $r[0];
- b class => 'grayedout', '> ';
- txt $self->{char_roles}{$_->{role}}[0].' - ';
- if($_->{rid}) {
- b class => 'grayedout', "r$_->{rid}:";
- a href => "/r$_->{rid}", $_->{rtitle};
- } else {
- txt 'All other releases';
- }
- end;
- }
- end;
- }
- end;
- end;
- }
-
- if(@{$r->{seiyuu}}) {
- Tr;
- td class => 'key', 'Voiced by';
- td;
- my $last_name = '';
- for my $s (sort { $a->{name} cmp $b->{name} } @{$r->{seiyuu}}) {
- next if $s->{name} eq $last_name;
- a href => "/s$s->{sid}", title => $s->{original}||$s->{name}, $s->{name};
- txt ' ('.$s->{note}.')' if $s->{note};
- br;
- $last_name = $s->{name};
- }
- end;
- end;
- }
-
- # description
- if($r->{desc}) {
- Tr class => 'nostripe';
- td class => 'chardesc', colspan => 2;
- h2 'Description';
- p;
- lit bb2html $r->{desc}, 0, 1;
- end;
- end;
- end;
- }
-
- end 'table';
- end;
- clearfloat;
-}
-
-
-
-sub edit {
- my($self, $id, $rev, $copy) = @_;
-
- $copy = $rev && $rev eq 'copy' || $copy && $copy eq 'copy';
- $rev = undef if defined $rev && $rev !~ /^\d+$/;
-
- my $r = $id && $self->dbCharGetRev(id => $id, what => 'extended vns traits', $rev ? (rev => $rev) : ())->[0];
- return $self->resNotFound if $id && !$r->{id};
- $rev = undef if !$r || $r->{lastrev};
-
- return $self->htmlDenied if !$self->authCan('edit')
- || $id && (($r->{locked} || $r->{hidden}) && !$self->authCan('dbmod'));
-
- my %b4 = !$id ? () : (
- (map +($_ => $r->{$_}), qw|name original alias desc image ihid ilock s_bust s_waist s_hip height weight bloodt gender main_spoil|),
- main => $r->{main}||0,
- bday => $r->{b_month} ? sprintf('%02d-%02d', $r->{b_month}, $r->{b_day}) : '',
- traits => join(' ', map sprintf('%d-%d', $_->{tid}, $_->{spoil}), sort { $a->{tid} <=> $b->{tid} } @{$r->{traits}}),
- vns => join(' ', map sprintf('%d-%d-%d-%s', $_->{vid}, $_->{rid}||0, $_->{spoil}, $_->{role}),
- sort { $a->{vid} <=> $b->{vid} || ($a->{rid}||0) <=> ($b->{rid}||0) } @{$r->{vns}}),
- );
- my $frm;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'name', maxlength => 200 },
- { post => 'original', required => 0, maxlength => 200, default => '' },
- { post => 'alias', required => 0, maxlength => 500, default => '' },
- { post => 'desc', required => 0, maxlength => 5000, default => '' },
- { post => 'gender', required => 0, default => 'unknown', enum => [ keys %{$self->{genders}} ] },
- { post => 'image', required => 0, default => 0, template => 'id' },
- { post => 'bday', required => 0, default => '', regex => [ qr/^(?:[01]?[0-9])-(?:[0123]?[0-9])$/, 'Birthday must be in MM-DD format.' ] },
- { post => 's_bust', required => 0, default => 0, template => 'uint', max => 32767 },
- { post => 's_waist', required => 0, default => 0, template => 'uint', max => 32767 },
- { post => 's_hip', required => 0, default => 0, template => 'uint', max => 32767 },
- { post => 'height', required => 0, default => 0, template => 'uint', max => 32767 },
- { post => 'weight', required => 0, default => 0, template => 'uint', max => 32767 },
- { post => 'bloodt', required => 0, default => 'unknown', enum => [ keys %{$self->{blood_types}} ] },
- { post => 'main', required => 0, default => 0, template => 'id' },
- { post => 'main_spoil', required => 0, default => 0, enum => [ 0..2 ] },
- { post => 'traits', required => 0, default => '', regex => [ qr/^(?:[1-9]\d*-[0-2])(?: +[1-9]\d*-[0-2])*$/, 'Incorrect trait format.' ] },
- { post => 'vns', required => 0, default => '', regex => [ qr/^(?:[1-9]\d*-\d+-[0-2]-[a-z]+)(?: +[1-9]\d*-\d+-[0-2]-[a-z]+)*$/, 'Incorrect VN format.' ] },
- { post => 'editsum', template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- );
-
- # handle image upload
- $frm->{image} = _uploadimage($self, $frm);
-
- # validate main character
- if(!$frm->{_err} && $frm->{main}) {
- my $m = $self->dbCharGet(id => $frm->{main}, what => 'extended')->[0];
- push @{$frm->{_err}}, 'Invalid main character. Make sure the ID is correct,'
- .' that the main character itself is not an instance of an other character,'
- .' and that this entry is not used as a main character elsewhere.'
- if !$m || $m->{main} || $r && !$copy && ($m->{id} == $r->{id} || $self->dbCharGet(instance => $r->{id})->[0]);
- }
-
- my(@traits, @vns);
- if(!$frm->{_err}) {
- # parse and normalize
- @traits = sort { $a->[0] <=> $b->[0] } map /^(\d+)-(\d+)$/&&[$1,$2], split / /, $frm->{traits};
- @vns = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } map [split /-/], split / /, $frm->{vns};
- $frm->{traits} = join(' ', map sprintf('%d-%d', @$_), @traits);
- $frm->{vns} = join(' ', map sprintf('%d-%d-%d-%s', @$_), @vns);
- $frm->{ihid} = $frm->{ihid} ?1:0;
- $frm->{ilock} = $frm->{ilock}?1:0;
- $frm->{desc} = $self->bbSubstLinks($frm->{desc});
- $frm->{main_spoil} = 0 if !$frm->{main};
-
- my %traits = @traits ? map +($_->{id}, 1), @{$self->dbTraitGet(results => 500, state => 2, id => [ map $_->[0], @traits ])} : ();
- @traits = grep $traits{$_->[0]}, @traits;
-
- # check for changes
- my $same = $id && !grep $frm->{$_} ne $b4{$_}, keys %b4;
- return $self->resRedirect("/c$id", 'post') if !$copy && $same;
- $frm->{_err} = ["No changes, please don't create an entry that is fully identical to another"] if $copy && $same;
- }
-
- if(!$frm->{_err}) {
- # modify for dbCharRevisionInsert
- ($frm->{b_month}, $frm->{b_day}) = delete($frm->{bday}) =~ /^(\d{2})-(\d{2})$/ ? ($1, $2) : (0, 0);
- $frm->{main} ||= undef;
- $frm->{traits} = \@traits;
- $_->[1]||=undef for (@vns);
- $frm->{vns} = \@vns;
-
- my $nrev = $self->dbItemEdit(c => !$copy && $id ? ($r->{id}, $r->{rev}) : (undef, undef), %$frm);
- return $self->resRedirect("/c$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- if(!$id) {
- my $vid = $self->formValidate({ get => 'vid', required => 1, template => 'id'});
- $frm->{vns} //= "$vid->{vid}-0-0-primary" if !$vid->{_err};
- }
- $frm->{$_} //= $b4{$_} for keys %b4;
- $frm->{editsum} //= sprintf 'Reverted to revision c%d.%d', $id, $rev if !$copy && $rev;
- $frm->{editsum} = sprintf 'New character based on c%d.%d', $id, $r->{rev} if $copy;
-
- my $title = !$r ? 'Add new character' : $copy ? "Copy $r->{name}" : "Edit $r->{name}";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('c', $r, $copy ? 'copy' : 'edit') if $r;
- $self->htmlEditMessage('c', $r, $title, $copy);
- $self->htmlForm({ frm => $frm, action => $r ? "/c$id/".($copy ? 'copy' : 'edit') : '/c/new', editsum => 1, upload => 1 },
- chare_geninfo => [ 'General info',
- [ input => name => 'Name (romaji)', short => 'name' ],
- [ input => name => 'Original name', short => 'original' ],
- [ static => content => 'The original name of the character, leave blank if it is already in the Latin alphabet.' ],
- [ text => name => 'Aliases', short => 'alias', rows => 3 ],
- [ static => content => '(Un)official aliases, separated by a newline.' ],
- [ text => name => 'Description<br /><b class="standout">English please!</b>', short => 'desc', rows => 6 ],
- [ select => name => 'Gender',short => 'gender', options => [
- map [ $_, $self->{genders}{$_} ], keys %{$self->{genders}} ] ],
- [ input => name => 'Birthday', short => 'bday', width => 100,post => ' MM-DD (e.g. "01-26" for the 26th of January)' ],
- [ input => name => 'Bust', short => 's_bust', width => 50, post => ' cm' ],
- [ input => name => 'Waist', short => 's_waist',width => 50, post => ' cm' ],
- [ input => name => 'Hips', short => 's_hip', width => 50, post => ' cm' ],
- [ input => name => 'Height', short => 'height', width => 50, post => ' cm' ],
- [ input => name => 'Weight', short => 'weight', width => 50, post => ' kg' ],
- [ select => name => 'Blood type',short => 'bloodt', options => [
- map [ $_, $self->{blood_types}{$_} ], keys %{$self->{blood_types}} ] ],
- [ static => content => '<br />' ],
- [ input => name => 'Instance of',short => 'main', width => 50, post => ' ID of the main character - the character of which this is an instance of.' ],
- [ select => name => 'Spoiler', short => 'main_spoil', options => [
- map [$_, fmtspoil $_], 0..2 ] ],
- ],
-
- chare_img => [ 'Image', [ static => nolabel => 1, content => sub {
- div class => 'img';
- p 'No image uploaded yet' if !$frm->{image};
- img src => imgurl(ch => $frm->{image}) if $frm->{image};
- end;
-
- div;
- h2 'Image ID';
- input type => 'text', class => 'text', name => 'image', id => 'image', value => $frm->{image}||'';
- p 'Use a character image that is already on the server. Set to \'0\' to remove the current image.';
- br; br;
-
- h2 'Upload new image';
- input type => 'file', class => 'text', name => 'img', id => 'img';
- p 'Image must be in JPEG or PNG format and at most 1MiB. Images larger than 256x300 will automatically be resized. Image must be safe for work!';
- end;
- }]],
-
- chare_traits => [ 'Traits',
- [ hidden => short => 'traits' ],
- [ static => nolabel => 1, content => sub {
- h2 'Current traits';
- table; tbody id => 'traits_tbl';
- Tr id => 'traits_loading'; td colspan => '3', 'Loading...'; end;
- end; end;
- h2 'Add trait';
- table; Tr;
- td class => 'tc_name'; input id => 'trait_input', type => 'text', class => 'text'; end;
- td colspan => 2, '';
- end; end 'table';
- }],
- ],
-
- chare_vns => [ 'Visual novels',
- [ hidden => short => 'vns' ],
- [ static => nolabel => 1, content => sub {
- h2 'Selected visual novels';
- table; tbody id => 'vns_tbl';
- Tr id => 'vns_loading'; td colspan => '4', 'Loading...'; end;
- end; end;
- h2 'Add visual novel';
- table; Tr;
- td class => 'tc_vnadd'; input id => 'vns_input', type => 'text', class => 'text'; end;
- td colspan => 3, '';
- end; end;
- }],
- ]);
- $self->htmlFooter;
-}
-
-
-sub _uploadimage {
- my($self, $frm) = @_;
-
- if($frm->{_err} || !$self->reqPost('img')) {
- return 0 if !$frm->{image};
- push @{$frm->{_err}}, 'No image with that ID' if !-s imgpath(ch => $frm->{image});
- return $frm->{image};
- }
-
- # perform some elementary checks
- my $imgdata = $self->reqUploadRaw('img');
- $frm->{_err} = [ 'Image must be in JPEG or PNG format' ] if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG headers
- $frm->{_err} = [ 'Image is too large, only 1MB allowed' ] if length($imgdata) > 1024*1024;
- return undef if $frm->{_err};
-
- # resize/compress
- my $im = Image::Magick->new;
- $im->BlobToImage($imgdata);
- my($ow, $oh) = ($im->Get('width'), $im->Get('height'));
- my($nw, $nh) = imgsize($ow, $oh, @{$self->{ch_size}});
- $im->Set(background => '#ffffff');
- $im->Set(alpha => 'Remove');
- 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);
- }
- $im->Set(magick => 'JPEG', quality => 90);
-
- # Get ID and save
- my $imgid = $self->dbCharImageId;
- my $fn = imgpath(ch => $imgid);
- $im->Write($fn);
- chmod 0666, $fn;
-
- return $imgid;
-}
-
-
-sub list {
- my($self, $fch) = @_;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'q', required => 0, default => '' },
- { get => 'fil', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my($list, $np) = $self->filFetchDB(char => $f->{fil}, {
- tagspoil => $self->authPref('spoilers')||0,
- }, {
- $fch ne 'all' ? ( char => $fch ) : (),
- $f->{q} ? ( search => $f->{q} ) : (),
- results => 50,
- page => $f->{p},
- what => 'vns',
- });
-
- $self->htmlHeader(title => 'Browse characters');
-
- my $quri = uri_escape($f->{q});
- form action => '/c/all', 'accept-charset' => 'UTF-8', method => 'get';
- div class => 'mainbox';
- h1 'Browse characters';
- $self->htmlSearchBox('c', $f->{q});
- p class => 'browseopts';
- for ('all', 'a'..'z', 0) {
- a href => "/c/$_?q=$quri", $_ eq $fch ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#';
- }
- end;
-
- p class => 'filselect';
- a id => 'filselect', href => '#c';
- lit '<i>&#9656;</i> Filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => 'fil', id => 'fil', value => $f->{fil};
- end;
- end 'form';
-
- if(!@$list) {
- div class => 'mainbox';
- h1 'No results';
- p 'No characters found that matched your criteria.';
- end;
- }
-
- @$list && $self->charBrowseTable($list, $np, $f, "/c/$fch?q=$quri;fil=$f->{fil}");
-
- $self->htmlFooter;
-}
-
-
-# Also used on Handler::Traits
-sub charBrowseTable {
- my($self, $list, $np, $f, $uri) = @_;
-
- $self->htmlBrowse(
- class => 'charb',
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => $uri,
- sorturl => $uri,
- header => [ [ '' ], [ '' ] ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1';
- cssicon "gen $l->{gender}", $self->{genders}{$l->{gender}} if $l->{gender} ne 'unknown';
- end;
- td class => 'tc2';
- a href => "/c$l->{id}", title => $l->{original}||$l->{name}, shorten $l->{name}, 50;
- b class => 'grayedout';
- my $i = 1;
- my %vns;
- for (@{$l->{vns}}) {
- next if $_->{spoil} || $vns{$_->{vid}}++;
- last if $i++ > 4;
- txt ', ' if $i > 2;
- a href => "/v$_->{vid}/chars", title => $_->{vntitle}, shorten $_->{vntitle}, 30;
- }
- end;
- end;
- end;
- }
- )
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Discussions.pm b/lib/VNDB/Handler/Discussions.pm
deleted file mode 100644
index f7f26a5e..00000000
--- a/lib/VNDB/Handler/Discussions.pm
+++ /dev/null
@@ -1,703 +0,0 @@
-
-package VNDB::Handler::Discussions;
-
-use strict;
-use warnings;
-use TUWF ':html', 'xml_escape', 'uri_escape';
-use POSIX 'ceil';
-use VNDB::Func;
-use List::Util qw(first max);
-
-
-TUWF::register(
- qr{t([1-9]\d*)(?:/([1-9]\d*))?} => \&thread,
- qr{t([1-9]\d*)(/[1-9]\d*)?/vote} => \&vote,
- qr{t([1-9]\d*)\.([1-9]\d*)} => \&redirect,
- qr{t/(all|db|an|ge|[vpu])([1-9]\d*)?} => \&board,
- qr{t([1-9]\d*)/reply} => \&edit,
- qr{t([1-9]\d*)\.([1-9]\d*)/edit} => \&edit,
- qr{t/(db|an|ge|[vpu])([1-9]\d*)?/new} => \&edit,
- qr{t/search} => \&search,
- qr{t} => \&index,
-);
-
-
-sub caneditpost {
- my($self, $post) = @_;
- return $self->authCan('boardmod') ||
- ($self->authInfo->{id} && $post->{uid} == $self->authInfo->{id} && !$post->{hidden} && time()-$post->{date} < $self->{board_edit_time})
-}
-
-
-sub thread {
- my($self, $tid, $page) = @_;
- $page ||= 1;
-
- my $t = $self->dbThreadGet(id => $tid, what => 'boardtitles poll')->[0];
- return $self->resNotFound if !$t->{id} || $t->{hidden} && !$self->authCan('boardmod');
-
- my $p = $self->dbPostGet(tid => $tid, results => 25, page => $page, what => 'user');
- return $self->resNotFound if !$p->[0];
-
- $self->htmlHeader(title => $t->{title}, noindex => 1);
- div class => 'mainbox';
- h1 $t->{title};
- h2 'Posted in';
- ul;
- for (sort { $a->{type}.$a->{iid} cmp $b->{type}.$b->{iid} } @{$t->{boards}}) {
- li;
- a href => "/t/$_->{type}", $self->{discussion_boards}{$_->{type}};
- if($_->{iid}) {
- txt ' > ';
- a style => 'font-weight: bold', href => "/t/$_->{type}$_->{iid}", "$_->{type}$_->{iid}";
- txt ':';
- a href => "/$_->{type}$_->{iid}", title => $_->{original}, $_->{title};
- }
- end;
- }
- end;
- end 'div';
-
- _poll($self, $t, "/t$tid".($page > 1 ? "/$page" : '')) if $t->{haspoll};
-
- $self->htmlBrowseNavigate("/t$tid/", $page, [ $t->{count}, 25 ], 't', 1);
- div class => 'mainbox thread';
- table class => 'stripe';
- for my $i (0..$#$p) {
- local $_ = $p->[$i];
- Tr $_->{deleted} ? (class => 'deleted') : ();
- td class => 'tc1';
- a href => "/t$tid.$_->{num}", name => $_->{num}, "#$_->{num}";
- if(!$_->{hidden}) {
- lit ' by '.fmtuser($_);
- br;
- txt fmtdate $_->{date}, 'full';
- }
- end;
- td class => 'tc2';
- if(caneditpost($self, $_)) {
- i class => 'edit';
- txt '< ';
- a href => "/t$tid.$_->{num}/edit", 'edit';
- txt ' >';
- end;
- }
- if($_->{hidden}) {
- i class => 'deleted', 'Post deleted.';
- } else {
- lit bb2html $_->{msg};
- i class => 'lastmod', 'Last modified on '.fmtdate($_->{edited}, 'full') if $_->{edited};
- }
- end;
- end;
- }
- end;
- end 'div';
- $self->htmlBrowseNavigate("/t$tid/", $page, [ $t->{count}, 25 ], 'b', 1);
-
- if($t->{locked}) {
- div class => 'mainbox';
- h1 'Reply';
- p class => 'center', 'This thread has been locked, you can\'t reply to it anymore';
- end;
- } elsif($t->{count} <= $page*25 && $self->authCan('board')) {
- form action => "/t$tid/reply", method => 'post', 'accept-charset' => 'UTF-8';
- div class => 'mainbox';
- fieldset class => 'submit';
- input type => 'hidden', class => 'hidden', name => 'formcode', value => $self->authGetCode("/t$tid/reply");
- h2;
- txt 'Quick reply';
- b class => 'standout', ' (English please!)';
- end;
- textarea name => 'msg', id => 'msg', rows => 4, cols => 50, '';
- br;
- input type => 'submit', value => 'Reply', class => 'submit';
- input type => 'submit', value => 'Go advanced...', class => 'submit', name => 'fullreply';
- end;
- end;
- end 'form';
- } elsif(!$self->authCan('board')) {
- div class => 'mainbox';
- h1 'Reply';
- p class => 'center', 'You must be logged in to reply to this thread.';
- end;
- }
-
- $self->htmlFooter;
-}
-
-
-sub redirect {
- my($self, $tid, $num) = @_;
- $self->resRedirect("/t$tid".($num > 25 ? '/'.ceil($num/25) : '').'#'.$num, 'perm');
-}
-
-
-# Arguments, action
-# tid reply
-# tid, 1 edit thread
-# tid, num edit post
-# type, (iid) start new thread
-sub edit {
- my($self, $tid, $num) = @_;
- $num ||= 0;
-
- # in case we start a new thread, parse boards
- my $board = '';
- if($tid !~ /^\d+$/) {
- return $self->resNotFound if $tid =~ /(db|an|ge)/ && $num || $tid =~ /[vpu]/ && !$num;
- $board = $tid.($num||'');
- $tid = 0;
- $num = 0;
- }
-
- # get thread and post, if any
- my $t = $tid && $self->dbThreadGet(id => $tid, what => 'boards poll')->[0];
- return $self->resNotFound if $tid && !$t->{id};
-
- my $p = $num && $self->dbPostGet(tid => $tid, num => $num, what => 'user')->[0];
- return $self->resNotFound if $num && !$p->{num};
-
- # are we allowed to perform this action?
- return $self->htmlDenied if !$self->authCan('board')
- || ($tid && ($t->{locked} || $t->{hidden}) && !$self->authCan('boardmod'))
- || ($num && !caneditpost($self, $p));
-
- # check form etc...
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- my $haspoll = $self->reqPost('poll') && 1;
- $frm = $self->formValidate(
- !$tid || $num == 1 ? (
- { post => 'title', maxlength => 50 },
- { post => 'boards', maxlength => 100 },
- $haspoll ? (
- { post => 'poll', required => 0 },
- { post => 'poll_question', required => 1, maxlength => 100 },
- { post => 'poll_options', required => 1, maxlength => 100*$self->{poll_options} },
- { post => 'poll_max_options', required => 1, default => 1, template => 'uint', min => 1, max => $self->{poll_options} },
- { post => 'poll_preview', required => 0 },
- { post => 'poll_recast', required => 0 },
- ) : (),
- ) : (),
- $self->authCan('boardmod') ? (
- { post => 'locked', required => 0 },
- { post => 'hidden', required => 0 },
- { post => 'nolastmod', required => 0 },
- ) : (),
- { post => 'msg', maxlength => 32768 },
- { post => 'fullreply', required => 0 },
- );
-
- $frm->{_err} = 1 if $frm->{fullreply};
-
- # check for double-posting
- push @{$frm->{_err}}, 'Please wait 30 seconds before making another post' if !$num && !$frm->{_err} && $self->dbPostGet(
- uid => $self->authInfo->{id}, tid => $tid, mindate => time - 30, results => 1, $tid ? () : (num => 1))->[0]{num};
-
- # Don't allow regular users to create more than 10 threads a day
- push @{$frm->{_err}}, 'You can only create 5 threads every 24 hours' if
- !$tid && !$self->authCan('boardmod') &&
- @{$self->dbPostGet(uid => $self->authInfo->{id}, mindate => time - 24*3600, num => 1)} >= 5;
-
- # parse and validate the boards
- my @boards;
- if(!$frm->{_err} && $frm->{boards}) {
- for (split /[ ,]/, $frm->{boards}) {
- my($ty, $id) = ($1, $2) if /^([a-z]{1,2})([0-9]*)$/;
- push @boards, [ $ty, $id ] if !grep $_->[0].$_->[1] eq $ty.$id, @boards;
- push @{$frm->{_err}}, "Wrong board: $_" if
- !$ty || !$self->{discussion_boards}{$ty}
- || $ty eq 'an' && ($id || !$self->authCan('boardmod'))
- || $ty eq 'db' && $id
- || $ty eq 'ge' && $id
- || $ty eq 'v' && (!$id || !$self->dbVNGet(id => $id)->[0]{id})
- || $ty eq 'p' && (!$id || !$self->dbProducerGet(id => $id)->[0]{id})
- || $ty eq 'u' && (!$id || !$self->dbUserGet(uid => $id)->[0]{id});
- }
- }
-
- # validate poll options
- my @poll_options;
- if(!$frm->{_err} && $haspoll) {
- @poll_options = split /\s*\n\s*/, $frm->{poll_options};
- push @{$frm->{_err}}, [ 'poll_options', 'mincount', 2 ] if @poll_options < 2;
- push @{$frm->{_err}}, [ 'poll_options', 'maxcount', $frm->{poll_max_options} ] if @poll_options > $self->{poll_options};
- push @{$frm->{_err}}, [ 'poll_max_options', 'template', 'uint' ] if @poll_options > 1 && @poll_options < $frm->{poll_max_options};
- }
-
- if(!$frm->{_err}) {
- my($ntid, $nnum) = ($tid, $num);
-
- # create/edit thread
- if(!$tid || $num == 1) {
- my $pollchange = $haspoll && (!$t
- || ($t->{poll_question}||'') ne $frm->{poll_question}
- || $t->{poll_max_options} != $frm->{poll_max_options}
- || join("\n", map $_->[1], @{$t->{poll_options}}) ne join("\n", @poll_options)
- );
- my %thread = (
- title => $frm->{title},
- boards => \@boards,
- hidden => $frm->{hidden},
- locked => $frm->{locked},
- poll_preview => $frm->{poll_preview}||0,
- poll_recast => $frm->{poll_recast}||0,
- !$haspoll ? (
- poll_question => undef # Make sure any existing poll gets deleted
- ) : $pollchange ? (
- poll_question => $frm->{poll_question},
- poll_max_options => $frm->{poll_max_options},
- poll_options => \@poll_options
- ) : (),
- );
- $self->dbThreadEdit($tid, %thread) if $tid;
- $ntid = $self->dbThreadAdd(%thread) if !$tid;
- }
-
- # create/edit post
- my %post = (
- msg => $self->bbSubstLinks($frm->{msg}),
- hidden => $num != 1 && $frm->{hidden},
- lastmod => !$num || $frm->{nolastmod} ? 0 : time,
- );
- $self->dbPostEdit($tid, $num, %post) if $num;
- $nnum = $self->dbPostAdd($ntid, %post) if !$num;
-
- return $self->resRedirect("/t$ntid".($nnum > 25 ? '/'.ceil($nnum/25) : '').'#'.$nnum, 'post');
- }
- }
-
- # fill out form if we have some data
- if($p) {
- $frm->{msg} ||= $p->{msg};
- $frm->{hidden} = $p->{hidden} if $num != 1 && !exists $frm->{hidden};
- if($num == 1) {
- $frm->{boards} ||= join ' ', sort map $_->[1]?$_->[0].$_->[1]:$_->[0], @{$t->{boards}};
- $frm->{title} ||= $t->{title};
- $frm->{locked} //= $t->{locked};
- $frm->{hidden} //= $t->{hidden};
- if($t->{haspoll}) {
- $frm->{poll} //= 1;
- $frm->{poll_question} ||= $t->{poll_question};
- $frm->{poll_max_options} ||= $t->{poll_max_options};
- $frm->{poll_preview} //= $t->{poll_preview};
- $frm->{poll_recast} //= $t->{poll_recast};
- $frm->{poll_options} ||= join "\n", map $_->[1], @{$t->{poll_options}};
- }
- }
- }
- delete $frm->{_err} unless ref $frm->{_err};
- $frm->{boards} ||= $board;
- $frm->{poll_preview} //= 1;
- $frm->{poll_max_options} ||= 1;
-
- # generate html
- my $url = !$tid ? "/t/$board/new" : !$num ? "/t$tid/reply" : "/t$tid.$num/edit";
- my $title = !$tid ? 'Start new thread' :
- !$num ? "Reply to $t->{title}" :
- 'Edit post';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlForm({ frm => $frm, action => $url }, 'postedit' => [$title,
- [ static => label => 'Username', content => fmtuser($p ? ($p->{uid}, $p->{username}) : ($self->authInfo->{id}, $self->authInfo->{username})) ],
- !$tid || $num == 1 ? (
- [ input => short => 'title', name => 'Thread title' ],
- [ input => short => 'boards', name => 'Board(s)' ],
- [ static => content => 'Read <a href="/d9.2">d9.2</a> for information about how to specify boards.' ],
- $self->authCan('boardmod') ? (
- [ check => name => 'Locked', short => 'locked' ],
- ) : (),
- ) : (
- [ static => label => 'Topic', content => qq|<a href="/t$tid">|.xml_escape($t->{title}).'</a>' ],
- ),
- $self->authCan('boardmod') ? (
- [ check => name => 'Hidden', short => 'hidden' ],
- $num ? (
- [ check => name => 'Don\'t update last modified field', short => 'nolastmod' ],
- ) : (),
- ) : (),
- [ text => name => 'Message<br /><b class="standout">English please!</b>', short => 'msg', rows => 25, cols => 75 ],
- [ static => content => 'See <a href="/d9.3">d9.3</a> for the allowed formatting codes' ],
- (!$tid || $num == 1) ? (
- [ static => content => '<br />' ],
- [ check => short => 'poll', name => 'Add poll' ],
- $num && $frm->{poll_question} ? (
- [ static => content => '<b class="standout">All votes will be reset if any changes to the poll fields are made!</b>' ]
- ) : (),
- [ input => short => 'poll_question', name => 'Poll question', width => 250 ],
- [ text => short => 'poll_options', name => "Poll options<br /><i>one per line,<br />$self->{poll_options} max</i>", rows => 8, cols => 35 ],
- [ input => short => 'poll_max_options',width => 16, post => ' Number of options voter is allowed to choose' ],
- [ check => short => 'poll_preview', name => 'Allow users to view poll results before voting' ],
- [ check => short => 'poll_recast', name => 'Allow users to change their vote' ],
- ) : (),
- ]);
- $self->htmlFooter;
-}
-
-
-sub vote {
- my($self, $tid, $page) = @_;
- return $self->htmlDenied if !$self->authCan('board');
- return if !$self->authCheckCode;
-
- my $url = '/t'.$tid.($page ? "/$page" : '');
- my $t = $self->dbThreadGet(id => $tid, what => 'poll')->[0];
- return $self->resNotFound if !$t;
-
- # user has already voted and poll doesn't allow to change a vote.
- my $voted = ($self->dbPollStats($tid))[2][0];
- return $self->resRedirect($url, 'post') if $voted && !$t->{poll_recast};
-
- my $f = $self->formValidate(
- { post => 'option', multi => 1, mincount => 1, maxcount => $t->{poll_max_options}, enum => [ map $_->[0], @{$t->{poll_options}} ] }
- );
- if($f->{_err}) {
- $self->htmlHeader(title => 'Poll error');
- $self->htmlFormError($f, 1);
- $self->htmlFooter;
- return;
- }
-
- $self->dbPollVote($t->{id}, $self->authInfo->{id}, @{$f->{option}});
- $self->resRedirect($url, 'post');
-}
-
-
-sub board {
- my($self, $type, $iid) = @_;
- $iid ||= '';
- return $self->resNotFound if $type =~ /(db|an|ge|all)/ && $iid;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- );
- return $self->resNotFound if $f->{_err};
-
- my $obj = !$iid ? undef :
- $type eq 'u' ? $self->dbUserGet(uid => $iid, what => 'hide_list')->[0] :
- $type eq 'p' ? $self->dbProducerGet(id => $iid)->[0] :
- $self->dbVNGet(id => $iid)->[0];
- return $self->resNotFound if $iid && !$obj;
- my $ititle = $obj && ($obj->{title}||$obj->{name}||$obj->{username});
- my $title = !$obj ? $self->{discussion_boards}{$type} || 'All boards' : "Related discussions for $ititle";
-
- my($list, $np) = $self->dbThreadGet(
- $type ne 'all' ? (type => $type) : (),
- $iid ? (iid => $iid) : (),
- results => 50,
- page => $f->{p},
- what => 'firstpost lastpost boardtitles',
- sort => $type eq 'an' ? 'id' : 'lastpost', reverse => 1,
- );
-
- $self->htmlHeader(title => $title, noindex => 1, feeds => [ $type eq 'an' ? 'announcements' : 'posts' ]);
-
- $self->htmlMainTabs($type, $obj, 'disc') if $iid;
- form action => '/t/search', method => 'get';
- div class => 'mainbox';
- h1 $title;
- p;
- a href => '/t', 'Discussion board';
- txt ' > ';
- a href => "/t/$type", $self->{discussion_boards}{$type}||'All boards';
- if($iid) {
- txt ' > ';
- a style => 'font-weight: bold', href => "/t/$type$iid", "$type$iid";
- txt ':';
- a href => "/$type$iid", $ititle;
- }
- end;
- if(!$iid) {
- fieldset class => 'search';
- input type => 'text', name => 'bq', id => 'bq', class => 'text';
- input type => 'hidden', name => 'b', value => $type if $type ne 'all';
- input type => 'submit', class => 'submit', value => 'Search!';
- end 'fieldset';
- }
- p class => 'center';
- if(!@$list) {
- b 'No related threads found';
- br; br;
- a href => "/t/$type$iid/new", 'Why not create one yourself?';
- } else {
- a href => '/t/'.($iid ? $type.$iid : $type ne 'ge' ? 'db' : $type).'/new', 'Start a new thread' if $type ne 'all';
- }
- end;
- end 'div';
- end 'form';
-
- _threadlist($self, $list, $f, $np, "/t/$type$iid", $type.$iid) if @$list;
-
- $self->htmlFooter;
-}
-
-
-sub index {
- my $self = shift;
-
- $self->htmlHeader(title => 'Discussion board index', noindex => 1, feeds => [ 'posts', 'announcements' ]);
- form action => '/t/search', method => 'get';
- div class => 'mainbox';
- h1 'Discussion board index';
- fieldset class => 'search';
- input type => 'text', name => 'bq', id => 'bq', class => 'text';
- input type => 'submit', class => 'submit', value => 'Search!';
- end 'fieldset';
- p class => 'browseopts';
- a href => '/t/all', 'All boards';
- a href => '/t/'.$_, $self->{discussion_boards}{$_}
- for (keys %{$self->{discussion_boards}});
- end;
- end;
- end;
-
- for (keys %{$self->{discussion_boards}}) {
- my $list = $self->dbThreadGet(
- type => $_,
- results => /^(db|v|ge)$/ ? 10 : 5,
- page => 1,
- what => 'firstpost lastpost boardtitles',
- sort => 'lastpost', reverse => 1,
- );
- h1 class => 'boxtitle';
- a href => "/t/$_", $self->{discussion_boards}{$_};
- end;
- _threadlist($self, $list, {p=>1}, 0, "/t", $_);
- }
-
- $self->htmlFooter;
-}
-
-
-sub search {
- my $self = shift;
-
- my $frm = $self->formValidate(
- { get => 'bq', required => 0, maxlength => 100 },
- { get => 'b', required => 0, multi => 1, enum => [ keys %{$self->{discussion_boards}} ] },
- { get => 't', required => 0 },
- { get => 'p', required => 0, default => 1, template => 'page' },
- );
- return $self->resNotFound if $frm->{_err};
-
- $self->htmlHeader(title => 'Search the discussion board', noindex => 1);
- $self->htmlForm({ frm => $frm, action => '/t/search', method => 'get', nosubmit => 1, noformcode => 1 }, 'boardsearch' => ['Search the discussion board',
- [ input => short => 'bq', name => 'Query' ],
- [ check => short => 't', name => 'Only search thread titles' ],
- [ select => short => 'b', name => 'Boards', multi => 1, size => scalar keys %{$self->{discussion_boards}},
- options => [ map [$_,$self->{discussion_boards}{$_}], keys %{$self->{discussion_boards}} ] ],
- [ static => content => sub {
- input type => 'submit', class => 'submit', tabindex => 10, value => 'Search!';
- } ],
- ]);
- return $self->htmlFooter if !$frm->{bq};
-
- my %boards = map +($_,1), @{$frm->{b}};
- %boards = () if keys %boards == keys %{$self->{discussion_boards}};
-
- my($l, $np);
- if($frm->{t}) {
- ($l, $np) = $self->dbThreadGet(
- keys %boards ? ( type => [keys %boards] ) : (),
- search => $frm->{bq},
- results => 50,
- page => $frm->{p},
- what => 'firstpost lastpost boardtitles',
- sort => 'lastpost', reverse => 1,
- );
- } else {
- # TODO: Allow or-matching too. But what syntax?
- (my $ts = $frm->{bq}) =~ y{+|&:*()="';!?$%^\\[]{}<>~` }{ }s;
- $ts =~ s/ +/ /;
- $ts =~ s/^ //;
- $ts =~ s/ $//;
- $ts =~ s/ / & /g;
- $ts =~ s/(?:^| )-([^ ]+)/ !$1 /;
- ($l, $np) = $self->dbPostGet(
- keys %boards ? ( type => [keys %boards] ) : (),
- search => $ts,
- results => 20,
- page => $frm->{p},
- hide => 1,
- what => 'thread user',
- sort => 'date', reverse => 1,
- headline => {
- # HACK: The bbcodes are stripped from the original messages when
- # creating the headline, so they are guaranteed not to show up in the
- # message. This means we can re-use them for highlighting without
- # worrying that they conflict with the message contents.
- MaxFragments => 2, MinWords => 15, MaxWords => 40, StartSel => '[raw]', StopSel => '[/raw]', FragmentDelimiter => '[code]',
- },
- );
- }
-
- my $url = '/t/search?'.join ';', 'bq='.uri_escape($frm->{bq}), $frm->{t} ? 't=1' : (), map "b=$_", keys %boards;
- if(!@$l) {
- div class => 'mainbox';
- h1 'No results';
- p 'No threads or messages found matching your criteria.';
- end;
- } elsif($frm->{t}) {
- _threadlist($self, $l, $frm, $np, $url, 'all');
- } else {
- $self->htmlBrowse(
- items => $l,
- options => $frm,
- nextpage => $np,
- pageurl => $url,
- class => 'postsearch',
- header => [
- sub { td class => 'tc1_1', ''; td class => 'tc1_2', ''; },
- [ 'Date' ],
- [ 'User' ],
- [ 'Message' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- my $link = "/t$l->{tid}.$l->{num}";
- Tr;
- td class => 'tc1_1'; a href => $link, 't'.$l->{tid}; end;
- td class => 'tc1_2'; a href => $link, '.'.$l->{num}; end;
- td class => 'tc2', fmtdate $l->{date};
- td class => 'tc3'; lit fmtuser $l->{uid}, $l->{username}; end;
- td class => 'tc4';
- div class => 'title';
- a href => $link, $l->{title};
- end;
- my $h = xml_escape $l->{headline};
- $h =~ s/\[raw\]/<b class="standout">/g;
- $h =~ s/\[\/raw\]/<\/b>/g;
- $h =~ s/\[code\]/<b class="grayedout">...<\/b><br \/>/g;
- div class => 'thread';
- lit $h;
- end;
- end;
- end;
- }
- );
- }
- $self->htmlFooter;
-}
-
-
-sub _threadlist {
- my($self, $list, $f, $np, $url, $board) = @_;
- $self->htmlBrowse(
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => $url,
- class => 'discussions',
- header => [
- [ 'Topic' ],
- [ 'Replies' ],
- [ 'Starter' ],
- [ 'Last post' ],
- ],
- row => sub {
- my($self, $n, $o) = @_;
- Tr;
- td class => 'tc1';
- a $o->{locked} ? ( class => 'locked' ) : (), href => "/t$o->{id}";
- span class => 'pollflag', '[poll]' if $o->{haspoll};
- txt shorten $o->{title}, 50;
- end;
- b class => 'boards';
- my $i = 1;
- my @boards = sort { $a->{type}.$a->{iid} cmp $b->{type}.$b->{iid} } grep $_->{type}.($_->{iid}||'') ne $board, @{$o->{boards}};
- for(@boards) {
- last if $i++ > 4;
- txt ', ' if $i > 2;
- a href => "/t/$_->{type}".($_->{iid}||''),
- title => $_->{original}||$self->{discussion_boards}{$_->{type}},
- shorten $_->{title}||$self->{discussion_boards}{$_->{type}}, 30;
- }
- txt ', ...' if @boards > 4;
- end;
- end;
- td class => 'tc2', $o->{count}-1;
- td class => 'tc3';
- lit fmtuser $o->{fuid}, $o->{fusername};
- end;
- td class => 'tc4';
- lit fmtuser $o->{luid}, $o->{lusername};
- lit ' @ ';
- a href => "/t$o->{id}.$o->{count}", fmtdate $o->{ldate}, 'full';
- end;
- end 'tr';
- }
- );
-}
-
-
-sub _poll {
- my($self, $t, $url) = @_;
- my($num_votes, $stats, $own_votes) = $self->dbPollStats($t->{id});
- my %own_votes = map +($_ => 1), @$own_votes;
- my $preview = !@$own_votes && $self->reqGet('pollview') && $t->{poll_preview};
- my $allow_vote = $self->authCan('board') && (!@$own_votes || $t->{poll_recast});
-
- div class => 'mainbox poll';
- form action => $url.'/vote', method => 'post';
- h1 class => 'question', $t->{poll_question};
- input type => 'hidden', name => 'formcode', value => $self->authGetCode($url.'/vote') if $allow_vote;
- table class => 'votebooth';
- if($allow_vote && $t->{poll_max_options} > 1) {
- thead; Tr; td colspan => 3;
- i "You may choose up to $t->{poll_max_options} options";
- end; end; end;
- }
- tfoot; Tr;
- td class => 'tc1';
- input type => 'submit', class => 'submit', value => 'Vote' if $allow_vote;
- if(!$self->authCan('board')) {
- b class => 'standout', 'You must be logged in to be able to vote.';
- }
- end;
- td class => 'tc2', colspan => 2;
- if($t->{poll_preview} || @$own_votes) {
- if(!$num_votes) {
- i 'Nobody voted yet.';
- } elsif(!$preview && !@$own_votes) {
- a href => $url.'?pollview=1', id => 'pollpreview', 'View results';
- } else {
- txt sprintf '%d vote%s total', $num_votes, $num_votes == 1 ? '' : 's';
- }
- }
- end;
- end; end;
- tbody;
- my $max = max values %$stats;
- my $show_graph = $max && (@$own_votes || $preview);
- my $graph_width = 200;
- for my $opt (@{$t->{poll_options}}) {
- my $votes = $stats->{$opt->[0]};
- my $own = exists $own_votes{$opt->[0]} ? ' own' : '';
- Tr $own ? (class => 'odd') : ();
- td class => 'tc1';
- label;
- input type => $t->{poll_max_options} > 1 ? 'checkbox' : 'radio', name => 'option', class => 'option', value => $opt->[0], $own ? (checked => '') : () if $allow_vote;
- span class => 'option'.$own, $opt->[1];
- end;
- end;
- if($show_graph) {
- td class => 'tc2';
- div class => 'graph', style => sprintf('width: %dpx', ($votes||0)/$max*$graph_width), ' ';
- div class => 'number', $votes;
- end;
- td class => 'tc3', sprintf('%.3g%%', $votes ? $votes/$num_votes*100 : 0);
- } else {
- td class => 'tc2', colspan => 2, '';
- }
- end;
- }
- end;
- end 'table';
- end 'form';
- end 'div';
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Misc.pm b/lib/VNDB/Handler/Misc.pm
deleted file mode 100644
index e3b67d52..00000000
--- a/lib/VNDB/Handler/Misc.pm
+++ /dev/null
@@ -1,414 +0,0 @@
-
-package VNDB::Handler::Misc;
-
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml', 'xml_escape', 'uri_escape';
-use VNDB::Func;
-use POSIX 'strftime';
-
-
-TUWF::register(
- qr{}, \&homepage,
- qr{(?:([upvrcs])([1-9]\d*)/)?hist},\&history,
- qr{d([1-9]\d*)}, \&docpage,
- qr{nospam}, \&nospam,
- qr{xml/prefs\.xml}, \&prefs,
- qr{opensearch\.xml}, \&opensearch,
-
- # redirects for old URLs
- qr{u([1-9]\d*)/tags}, sub { $_[0]->resRedirect("/g/links?u=$_[1]", 'perm') },
- qr{(.*[^/]+)/+}, sub { $_[0]->resRedirect("/$_[1]", 'perm') },
- qr{([pv])}, sub { $_[0]->resRedirect("/$_[1]/all", 'perm') },
- qr{v/search}, sub { $_[0]->resRedirect("/v/all?q=".uri_escape($_[0]->reqGet('q')||''), 'perm') },
- qr{notes}, sub { $_[0]->resRedirect('/d8', 'perm') },
- qr{faq}, sub { $_[0]->resRedirect('/d6', 'perm') },
- qr{v([1-9]\d*)/(?:stats|scr)},
- sub { $_[0]->resRedirect("/v$_[1]", 'perm') },
- qr{u/list(/[a-z0]|/all)?},
- sub { my $l = defined $_[1] ? $_[1] : '/all'; $_[0]->resRedirect("/u$l", 'perm') },
- qr{d([1-9]\d*)\.([1-9]\d*)},
- sub { $_[0]->resRedirect("/d$_[1]#$_[2]", 'perm') }
-);
-
-
-sub homepage {
- my $self = shift;
-
- my $title = 'The Visual Novel Database';
- my $desc = 'VNDB.org strives to be a comprehensive database for information about visual novels.';
-
- my $metadata = {
- 'og:type' => 'website',
- 'og:title' => $title,
- 'og:description' => $desc,
- };
-
- $self->htmlHeader(title => $title, feeds => [ keys %{$self->{atom_feeds}} ], metadata => $metadata);
-
- div class => 'mainbox';
- h1 $title;
- p class => 'description';
- txt $desc;
- br;
- txt 'This website is built as a wiki, meaning that anyone can freely add'
- .' and contribute information to the database, allowing us to create the'
- .' largest, most accurate and most up-to-date visual novel database on the web.';
- end;
-
- # with filters applied it's signifcantly slower, so special-code the situations with and without filters
- my @vns;
- if($self->authPref('filter_vn')) {
- my $r = $self->filFetchDB(vn => undef, undef, {hasshot => 1, results => 4, sort => 'rand'});
- @vns = map $_->{id}, @$r;
- }
- my $scr = $self->dbScreenshotRandom(@vns);
- p class => 'screenshots';
- for (@$scr) {
- my($w, $h) = imgsize($_->{width}, $_->{height}, @{$self->{scr_size}});
- a href => "/v$_->{vid}", title => $_->{title};
- img src => imgurl(st => $_->{scr}), alt => $_->{title}, width => $w, height => $h;
- end;
- }
- end;
- end 'div';
-
- table class => 'mainbox threelayout';
- Tr;
-
- # Recent changes
- td;
- h1;
- a href => '/hist', 'Recent Changes'; txt ' ';
- a href => '/feeds/changes.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- my $changes = $self->dbRevisionGet(results => 10, auto => 1);
- ul;
- for (@$changes) {
- li;
- txt "$_->{type}:";
- a href => "/$_->{type}$_->{itemid}.$_->{rev}", title => $_->{ioriginal}||$_->{ititle}, shorten $_->{ititle}, 33;
- lit " by ".fmtuser($_);
- end;
- }
- end;
- end 'td';
-
- # Announcements
- td;
- my $an = $self->dbThreadGet(type => 'an', sort => 'id', reverse => 1, results => 2);
- h1;
- a href => '/t/an', 'Announcements'; txt ' ';
- a href => '/feeds/announcements.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- for (@$an) {
- my $post = $self->dbPostGet(tid => $_->{id}, num => 1)->[0];
- h2;
- a href => "/t$_->{id}", $_->{title};
- end;
- p;
- lit bb2html $post->{msg}, 150;
- end;
- }
- end 'td';
-
- # Recent posts
- td;
- h1;
- a href => '/t/all', 'Recent Posts'; txt ' ';
- a href => '/feeds/posts.atom'; cssicon 'feed', 'Atom Feed'; end;
- end;
- my $posts = $self->dbThreadGet(what => 'lastpost boardtitles', results => 10, sort => 'lastpost', reverse => 1, notusers => 1);
- ul;
- for (@$posts) {
- my $boards = join ', ', map $self->{discussion_boards}{$_->{type}}.($_->{iid}?' > '.$_->{title}:''), @{$_->{boards}};
- li;
- txt fmtage($_->{ldate}).' ';
- a href => "/t$_->{id}.$_->{count}", title => "Posted in $boards", shorten $_->{title}, 25;
- lit ' by '.fmtuser($_->{luid}, $_->{lusername});
- end;
- }
- end;
- end 'td';
-
- end 'tr';
- Tr;
-
- # Random visual novels
- td;
- h1;
- a href => '/v/rand', 'Random visual novels';
- end;
- my $random = $self->filFetchDB(vn => undef, undef, {results => 10, sort => 'rand'});
- ul;
- for (@$random) {
- li;
- a href => "/v$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40;
- end;
- }
- end;
- end 'td';
-
- # Upcoming releases
- td;
- h1;
- a href => '/r?fil=released-0;o=a;s=released', 'Upcoming releases';
- end;
- my $upcoming = $self->filFetchDB(release => undef, undef, {results => 10, released => 0, what => 'platforms'});
- ul;
- for (@$upcoming) {
- li;
- lit fmtdatestr $_->{released};
- txt ' ';
- cssicon $_, $self->{platforms}{$_} for (@{$_->{platforms}});
- cssicon "lang $_", $self->{languages}{$_} for (@{$_->{languages}});
- txt ' ';
- a href => "/r$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 30;
- end;
- }
- end;
- end 'td';
-
- # Just released
- td;
- h1;
- a href => '/r?fil=released-1;o=d;s=released', 'Just released';
- end;
- my $justrel = $self->filFetchDB(release => undef, undef, {results => 10, sort => 'released', reverse => 1, released => 1, what => 'platforms'});
- ul;
- for (@$justrel) {
- li;
- lit fmtdatestr $_->{released};
- txt ' ';
- cssicon $_, $self->{platforms}{$_} for (@{$_->{platforms}});
- cssicon "lang $_", $self->{languages}{$_} for (@{$_->{languages}});
- txt ' ';
- a href => "/r$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 30;
- end;
- }
- end;
- end 'td';
-
- end 'tr';
- end 'table';
-
- $self->htmlFooter;
-}
-
-
-sub history {
- my($self, $type, $id) = @_;
- $type ||= '';
- $id ||= 0;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'm', required => 0, default => !$type, enum => [ 0, 1 ] },
- { get => 'h', required => 0, default => 0, enum => [ -1..1 ] },
- { get => 't', required => 0, default => '', enum => [qw|v r p c s a|] },
- { get => 'e', required => 0, default => 0, enum => [ -1..1 ] },
- { get => 'r', required => 0, default => 0, enum => [ 0, 1 ] },
- );
- return $self->resNotFound if $f->{_err};
-
- # get item object and title
- my $obj = $type eq 'u' ? $self->dbUserGet(uid => $id, what => 'hide_list')->[0] :
- $type eq 'p' ? $self->dbProducerGet(id => $id)->[0] :
- $type eq 'r' ? $self->dbReleaseGet(id => $id)->[0] :
- $type eq 'c' ? $self->dbCharGet(id => $id)->[0] :
- $type eq 's' ? $self->dbStaffGet(id => $id)->[0] :
- $type eq 'v' ? $self->dbVNGet(id => $id)->[0] : undef;
- return $self->resNotFound if $type && !$obj->{id};
- my $title = $type ? 'Edit history of '.($obj->{title} || $obj->{name} || $obj->{username}) : 'Recent changes';
-
- # get the edit history
- my($list, $np) = $self->dbRevisionGet(
- $type && $type ne 'u' ? ( type => $type, itemid => $id ) : (),
- $type eq 'u' ? ( uid => $id ) : (),
- $f->{t} ? ( type => $f->{t} eq 'a' ? [qw|v r p s|] : $f->{t} ) : (),
- page => $f->{p},
- results => 50,
- auto => $f->{m},
- hidden => $type && $type ne 'u' ? 0 : $f->{h},
- edit => $f->{e},
- releases => $f->{r},
- );
-
- $self->htmlHeader(title => $title, noindex => 1, feeds => [ 'changes' ]);
- $self->htmlMainTabs($type, $obj, 'hist') if $type;
-
- # url generator
- my $u = sub {
- my($n, $v) = @_;
- $n ||= '';
- local $_ = ($type ? "/$type$id" : '').'/hist';
- $_ .= '?m='.($n eq 'm' ? $v : $f->{m});
- $_ .= ';h='.($n eq 'h' ? $v : $f->{h});
- $_ .= ';t='.($n eq 't' ? $v : $f->{t});
- $_ .= ';e='.($n eq 'e' ? $v : $f->{e});
- $_ .= ';r='.($n eq 'r' ? $v : $f->{r});
- };
-
- # filters
- div class => 'mainbox';
- h1 $title;
- if($type ne 'u') {
- p class => 'browseopts';
- a !$f->{m} ? (class => 'optselected') : (), href => $u->(m => 0), 'Show automated edits';
- a $f->{m} ? (class => 'optselected') : (), href => $u->(m => 1), 'Hide automated edits';
- end;
- }
- if(!$type || $type eq 'u') {
- if($self->authCan('dbmod')) {
- p class => 'browseopts';
- a $f->{h} == 1 ? (class => 'optselected') : (), href => $u->(h => 1), 'Hide deleted items';
- a $f->{h} == -1 ? (class => 'optselected') : (), href => $u->(h => -1), 'Show deleted items';
- end;
- }
- p class => 'browseopts';
- a !$f->{t} ? (class => 'optselected') : (), href => $u->(t => ''), 'Show all items';
- a $f->{t} eq 'v' ? (class => 'optselected') : (), href => $u->(t => 'v'), 'Only visual novels';
- a $f->{t} eq 'r' ? (class => 'optselected') : (), href => $u->(t => 'r'), 'Only releases';
- a $f->{t} eq 'p' ? (class => 'optselected') : (), href => $u->(t => 'p'), 'Only producers';
- a $f->{t} eq 's' ? (class => 'optselected') : (), href => $u->(t => 's'), 'Only staff';
- a $f->{t} eq 'c' ? (class => 'optselected') : (), href => $u->(t => 'c'), 'Only characters';
- a $f->{t} eq 'a' ? (class => 'optselected') : (), href => $u->(t => 'a'), 'All except characters';
- end;
- p class => 'browseopts';
- a !$f->{e} ? (class => 'optselected') : (), href => $u->(e => 0), 'Show all changes';
- a $f->{e} == 1 ? (class => 'optselected') : (), href => $u->(e => 1), 'Only edits';
- a $f->{e} == -1 ? (class => 'optselected') : (), href => $u->(e => -1), 'Only newly created pages';
- end;
- }
- if($type eq 'v') {
- p class => 'browseopts';
- a !$f->{r} ? (class => 'optselected') : (), href => $u->(r => 0), 'Exclude edits of releases';
- a $f->{r} ? (class => 'optselected') : (), href => $u->(r => 1), 'Include edits of releases';
- end;
- }
- end 'div';
-
- $self->htmlBrowseHist($list, $f, $np, $u->());
- $self->htmlFooter;
-}
-
-
-sub docpage {
- my($self, $did) = @_;
-
- my $f = sprintf('%s/data/docs/%d', $VNDB::ROOT, $did);
- my $F;
- open($F, '<:utf8', $f) or return $self->resNotFound;
- my @c = <$F>;
- close $F;
-
- (my $title = shift @c) =~ s/^:TITLE://;
- chomp $title;
-
- my($sec, $subsec) = (0,0);
- for (@c) {
- s{^:SUB:(.+)\r?\n$}{
- $sec++;
- $subsec = 0;
- qq|<h3><a href="#$sec" name="$sec">$sec. $1</a></h3>\n|
- }e;
- s{^:SUBSUB:(.+)\r?\n$}{
- $subsec++;
- qq|<h4><a href="#$sec.$subsec" name="$sec.$subsec">$sec.$subsec. $1</a></h4>\n|
- }e;
- s{^:INC:(.+)\r?\n$}{
- $f = sprintf('%s/data/docs/%s', $VNDB::ROOT, $1);
- open($F, '<:utf8', $f) or die $!;
- my $ii = join('', <$F>);
- close $F;
- $ii;
- }e;
- s{^:MODERATORS:$}{
- my $l = $self->dbUserGet(results => 100, sort => 'id', notperm => $self->{default_perm}, what => 'extended');
- my $admin = 0;
- $admin |= $_ for values %{$self->{permissions}};
- '<dl>'.join('', map {
- my $u = $_;
- my $p = $u->{perm} >= $admin ? 'admin' : join ', ', sort map +($u->{perm} &~ $self->{default_perm}) & $self->{permissions}{$_} ? $_ : (), keys %{$self->{permissions}};
- $p ? sprintf('<dt><a href="/u%d">%s</a></dt><dd>%s</dd>', $_->{id}, $_->{username}, $p) : ()
- } @$l).'</dl>';
- }e;
- s{^:SKINCONTRIB:$}{
- my %users;
- push @{$users{ $self->{skins}{$_}[1] }}, [ $_, $self->{skins}{$_}[0] ]
- for sort { $self->{skins}{$a}[0] cmp $self->{skins}{$b}[0] } keys %{$self->{skins}};
- my $u = $self->dbUserGet(uid => [ keys %users ]);
- '<dl>'.join('', map sprintf('<dt><a href="/u%d">%s</a></dt><dd>%s</dd>',
- $_->{id}, $_->{username}, join(', ', map sprintf('<a href="?skin=%s">%s</a>', $_->[0], $_->[1]), @{$users{$_->{id}}})
- ), @$u).'</dl>';
- }e;
- }
-
- $self->htmlHeader(title => $title);
- div class => 'mainbox';
- h1 $title;
- div class => 'docs';
- lit join '', @c;
- end;
- end;
- $self->htmlFooter;
-}
-
-
-sub nospam {
- my $self = shift;
- $self->htmlHeader(title => 'Could not send form', noindex => 1);
-
- div class => 'mainbox';
- h1 'Could not send form';
- div class => 'warning';
- h2 'Error';
- p 'The form could not be sent, please make sure you have Javascript enabled in your browser.';
- end;
- end;
-
- $self->htmlFooter;
-}
-
-
-sub prefs {
- my $self = shift;
- return if !$self->authCheckCode;
- return $self->resNotFound if !$self->authInfo->{id};
- my $f = $self->formValidate(
- { get => 'key', enum => [qw|filter_vn filter_release|] },
- { get => 'value', required => 0, maxlength => 2000 },
- );
- return $self->resNotFound if $f->{_err};
- $self->authPref($f->{key}, $f->{value});
-
- # doesn't really matter what we return, as long as it's XML
- $self->resHeader('Content-type' => 'text/xml');
- xml;
- tag 'done', '';
-}
-
-
-sub opensearch {
- my $self = shift;
- my $h = $self->reqBaseURI();
- $self->resHeader('Content-Type' => 'application/opensearchdescription+xml');
- xml;
- tag 'OpenSearchDescription',
- xmlns => 'http://a9.com/-/spec/opensearch/1.1/', 'xmlns:moz' => 'http://www.mozilla.org/2006/browser/search/';
- tag 'ShortName', 'VNDB';
- tag 'LongName', 'VNDB.org visual novel search';
- tag 'Description', 'Search visual vovels on VNDB.org';
- tag 'Image', width => 16, height => 16, type => 'image/x-icon', "$h/favicon.ico"
- if -s "$VNDB::ROOT/www/favicon.ico";
- tag 'Url', type => 'text/html', method => 'get', template => "$h/v/all?q={searchTerms}", undef;
- tag 'Url', type => 'application/opensearchdescription+xml', rel => 'self', template => "$h/opensearch.xml", undef;
- tag 'Query', role => 'example', searchTerms => 'Tsukihime', undef;
- tag 'moz:SearchForm', "$h/v/all";
- end 'OpenSearchDescription';
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Producers.pm b/lib/VNDB/Handler/Producers.pm
deleted file mode 100644
index 42c4e7f0..00000000
--- a/lib/VNDB/Handler/Producers.pm
+++ /dev/null
@@ -1,494 +0,0 @@
-
-package VNDB::Handler::Producers;
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml', 'xml_escape', 'html_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{p([1-9]\d*)/rg} => \&rg,
- qr{p([1-9]\d*)(?:\.([1-9]\d*))?} => \&page,
- qr{p/add} => \&addform,
- qr{p(?:([1-9]\d*)(?:\.([1-9]\d*))?/edit|/new)}
- => \&edit,
- qr{p/([a-z0]|all)} => \&list,
- qr{xml/producers\.xml} => \&pxml,
-);
-
-
-sub rg {
- my($self, $pid) = @_;
-
- my $p = $self->dbProducerGet(id => $pid, what => 'relgraph')->[0];
- return $self->resNotFound if !$p->{id} || !$p->{rgraph};
-
- my $title = "Relation graph for $p->{name}";
- return if $self->htmlRGHeader($title, 'p', $p);
-
- $p->{svg} =~ s/id="node_p$pid"/id="graph_current"/;
-
- div class => 'mainbox';
- h1 $title;
- p class => 'center';
- lit $p->{svg};
- end;
- end;
- $self->htmlFooter;
-}
-
-
-sub page {
- my($self, $pid, $rev) = @_;
-
- my $method = $rev ? 'dbProducerGetRev' : 'dbProducerGet';
- my $p = $self->$method(
- id => $pid,
- what => 'extended relations',
- $rev ? ( rev => $rev ) : ()
- )->[0];
- return $self->resNotFound if !$p->{id};
-
- my $metadata = {
- 'og:title' => $p->{name},
- 'og:description' => $p->{desc},
- };
-
- $self->htmlHeader(title => $p->{name}, noindex => $rev, metadata => $metadata);
- $self->htmlMainTabs(p => $p);
- return if $self->htmlHiddenMessage('p', $p);
-
- if($rev) {
- my $prev = $rev && $rev > 1 && $self->dbProducerGetRev(id => $pid, rev => $rev-1, what => 'extended relations')->[0];
- $self->htmlRevision('p', $prev, $p,
- [ type => 'Type', serialize => sub { $self->{producer_types}{$_[0]} } ],
- [ name => 'Name (romaji)', diff => 1 ],
- [ original => 'Original name', diff => 1 ],
- [ alias => 'Aliases', diff => qr/[ ,\n\.]/ ],
- [ lang => 'Language', serialize => sub { "$_[0] ($self->{languages}{$_[0]})" } ],
- [ website => 'Website', diff => 1 ],
- [ l_wp => 'Wikipedia link',htmlize => sub {
- $_[0] ? sprintf '<a href="http://en.wikipedia.org/wiki/%s">%1$s</a>', xml_escape $_[0] : '[empty]'
- }],
- [ desc => 'Description', diff => qr/[ ,\n\.]/ ],
- [ relations => 'Relations', join => '<br />', split => sub {
- my @r = map sprintf('%s: <a href="/p%d" title="%s">%s</a>',
- $self->{prod_relations}{$_->{relation}}[1], $_->{id}, xml_escape($_->{original}||$_->{name}), xml_escape shorten $_->{name}, 40
- ), sort { $a->{id} <=> $b->{id} } @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- );
- }
-
- div class => 'mainbox';
- $self->htmlItemMessage('p', $p);
- h1 $p->{name};
- h2 class => 'alttitle', $p->{original} if $p->{original};
- p class => 'center';
- txt "$self->{languages}{$p->{lang}} $self->{producer_types}{$p->{type}}";
- lit '<br />a.k.a. '.html_escape $p->{alias} if $p->{alias};
-
- my @links = (
- $p->{website} ? [ 'Homepage', $p->{website} ] : (),
- $p->{l_wp} ? [ 'Wikipedia', "http://en.wikipedia.org/wiki/$p->{l_wp}" ] : (),
- );
- br if @links;
- for(@links) {
- a href => $_->[1], $_->[0];
- txt ' - ' if $_ ne $links[$#links];
- }
- end 'p';
-
- if(@{$p->{relations}}) {
- my %rel;
- push @{$rel{$_->{relation}}}, $_
- for (sort { $a->{name} cmp $b->{name} } @{$p->{relations}});
- p class => 'center';
- br;
- for my $r (keys %{$self->{prod_relations}}) {
- next if !$rel{$r};
- txt $self->{prod_relations}{$r}[1].': ';
- for (@{$rel{$r}}) {
- a href => "/p$_->{id}", title => $_->{original}||$_->{name}, shorten $_->{name}, 40;
- txt ', ' if $_ ne $rel{$r}[$#{$rel{$r}}];
- }
- br;
- }
- end 'p';
- }
-
- if($p->{desc}) {
- p class => 'description';
- lit bb2html $p->{desc};
- end;
- }
- end 'div';
-
- _releases($self, $p);
-
- $self->htmlFooter;
-}
-
-sub _releases {
- my($self, $p) = @_;
-
- # prodpage_(dev|pub)
- my $r = $self->dbReleaseGet(pid => $p->{id}, results => 999, what => 'vn platforms');
- div class => 'mainbox';
- a href => '#', id => 'expandprodrel', 'collapse';
- h1 'Releases';
- if(!@$r) {
- p 'We have currently no visual novels by this producer.';
- end;
- return;
- }
-
- my %vn; # key = vid, value = [ $r1, $r2, $r3, .. ]
- my @vn; # $vn objects in order of first release
- for my $rel (@$r) {
- for my $v (@{$rel->{vn}}) {
- push @vn, $v if !$vn{$v->{vid}};
- push @{$vn{$v->{vid}}}, $rel;
- }
- }
-
- table id => 'prodrel';
- for my $v (@vn) {
- Tr class => 'vn';
- td colspan => 6;
- i; lit fmtdatestr $vn{$v->{vid}}[0]{released}; end;
- a href => "/v$v->{vid}", title => $v->{original}, $v->{title};
- span '('.join(', ',
- (grep($_->{developer}, @{$vn{$v->{vid}}}) ? 'developer' : ()),
- (grep($_->{publisher}, @{$vn{$v->{vid}}}) ? 'publisher' : ())
- ).')';
- end;
- end;
- for my $rel (@{$vn{$v->{vid}}}) {
- Tr class => 'rel';
- td class => 'tc1'; lit fmtdatestr $rel->{released}; end;
- td class => 'tc2', $rel->{minage} < 0 ? '' : minage $rel->{minage};
- td class => 'tc3';
- for (sort @{$rel->{platforms}}) {
- next if $_ eq 'oth';
- cssicon $_, $self->{platforms}{$_};
- }
- cssicon "lang $_", $self->{languages}{$_} for (@{$rel->{languages}});
- cssicon "rt$rel->{type}", $rel->{type};
- end;
- td class => 'tc4';
- a href => "/r$rel->{id}", title => $rel->{original}||$rel->{title}, $rel->{title};
- b class => 'grayedout', ' (patch)' if $rel->{patch};
- end;
- td class => 'tc5', join ', ',
- ($rel->{developer} ? 'developer' : ()), ($rel->{publisher} ? 'publisher' : ());
- td class => 'tc6';
- if($rel->{website}) {
- a href => $rel->{website}, rel => 'nofollow';
- cssicon 'external', 'External link';
- end;
- } else {
- txt ' ';
- }
- end;
- end 'tr';
- }
- }
- end 'table';
- end 'div';
-}
-
-
-sub addform {
- my $self = shift;
- return $self->htmlDenied if !$self->authCan('edit');
-
- my $frm;
- my $l = [];
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'name', maxlength => 200 },
- { post => 'original', required => 0, maxlength => 200, default => '' },
- { post => 'alias', required => 0, maxlength => 500, default => '' },
- { post => 'continue_ign',required => 0 },
- );
-
- # look for duplicates
- if(!$frm->{_err} && !$frm->{continue_ign}) {
- $l = $self->dbProducerGet(search => $frm->{name}, what => 'extended', results => 50, inc_hidden => 1);
- push @$l, @{$self->dbProducerGet(search => $frm->{original}, what => 'extended', results => 50, inc_hidden => 1)} if $frm->{original};
- $_ && push @$l, @{$self->dbProducerGet(search => $_, what => 'extended', results => 50, inc_hidden => 1)} for(split /\s*,\s*/, $frm->{alias});
- my %ids = map +($_->{id}, $_), @$l;
- $l = [ map $ids{$_}, sort { $ids{$a}{name} cmp $ids{$b}{name} } keys %ids ];
- }
-
- return edit($self, undef, undef, 1) if !@$l && !$frm->{_err};
- }
-
- $self->htmlHeader(title => 'Add a new producer', noindex => 1);
- if(@$l) {
- div class => 'mainbox';
- h1 'Possible duplicates found';
- div class => 'warning';
- p;
- txt 'The following is a list of producers that match the name(s) you gave.'
- .' Please check this list to avoid creating a duplicate producer entry.'
- .' Be especially wary of items that have been deleted! To see why an entry has been deleted, click on its title.';
- br; br;
- txt 'To add the producer anyway, hit the "Continue and ignore duplicates" button below.';
- end;
- end;
- ul;
- for(@$l) {
- li;
- a href => "/p$_->{id}", title => $_->{original}||$_->{name}, "p$_->{id}: ".shorten($_->{name}, 50);
- b class => 'standout', ' deleted' if $_->{hidden};
- end;
- }
- end;
- end 'div';
- }
-
- $self->htmlForm({ frm => $frm, action => '/p/add', continue => @$l ? 2 : 1 },
- vn_add => [ 'Add a new producer',
- [ input => name => 'Name (romaji)', short => 'name' ],
- [ input => name => 'Original name', short => 'original' ],
- [ static => content => 'The original name of the producer, leave blank if it is already in the Latin alphabet.' ],
- [ input => name => 'Aliases', short => 'alias', width => 400 ],
- [ static => content => '(Un)official aliases, separated by a comma.' ],
- ]);
- $self->htmlFooter;
-}
-
-
-# pid as argument = edit producer
-# no arguments = add new producer
-sub edit {
- my($self, $pid, $rev, $nosubmit) = @_;
-
- my $p = $pid && $self->dbProducerGetRev(id => $pid, what => 'extended relations', rev => $rev)->[0];
- return $self->resNotFound if $pid && !$p->{id};
- $rev = undef if !$p || $p->{lastrev};
-
- return $self->htmlDenied if !$self->authCan('edit')
- || $pid && (($p->{locked} || $p->{hidden}) && !$self->authCan('dbmod'));
-
- my %b4 = !$pid ? () : (
- (map { $_ => $p->{$_} } qw|type name original lang website desc alias ihid ilock|),
- l_wp => $p->{l_wp} || '',
- prodrelations => join('|||', map $_->{relation}.','.$_->{id}.','.$_->{name}, sort { $a->{id} <=> $b->{id} } @{$p->{relations}}),
- );
- my $frm;
-
- if($self->reqMethod eq 'POST') {
- return if !$nosubmit && !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'type', required => !$nosubmit, enum => [ keys %{$self->{producer_types}} ] },
- { post => 'name', maxlength => 200 },
- { post => 'original', required => 0, maxlength => 200, default => '' },
- { post => 'alias', required => 0, maxlength => 500, default => '' },
- { post => 'lang', required => !$nosubmit, enum => [ keys %{$self->{languages}} ] },
- { post => 'website', required => 0, maxlength => 250, default => '', template => 'weburl' },
- { post => 'l_wp', required => 0, maxlength => 150, default => '' },
- { post => 'desc', required => 0, maxlength => 5000, default => '' },
- { post => 'prodrelations', required => 0, maxlength => 5000, default => '' },
- { post => 'editsum', required => !$nosubmit, template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- );
- if(!$nosubmit && !$frm->{_err}) {
- # parse
- my $relations = [ map { /^([a-z]+),([0-9]+),(.+)$/ && (!$pid || $2 != $pid) ? [ $1, $2, $3 ] : () } split /\|\|\|/, $frm->{prodrelations} ];
-
- # normalize
- $frm->{ihid} = $frm->{ihid}?1:0;
- $frm->{ilock} = $frm->{ilock}?1:0;
- $frm->{desc} = $self->bbSubstLinks($frm->{desc});
- $relations = [] if $frm->{ihid};
- $frm->{prodrelations} = join '|||', map $_->[0].','.$_->[1].','.$_->[2], sort { $a->[1] <=> $b->[1]} @{$relations};
-
- return $self->resRedirect("/p$pid", 'post')
- if $pid && !grep $frm->{$_} ne $b4{$_}, keys %b4;
-
- $frm->{relations} = $relations;
- $frm->{l_wp} = undef if !$frm->{l_wp};
- my $nrev = $self->dbItemEdit(p => $pid||undef, $pid ? $p->{rev} : undef, %$frm);
-
- # update reverse relations
- if(!$pid && $#$relations >= 0 || $pid && $frm->{prodrelations} ne $b4{prodrelations}) {
- my %old = $pid ? (map { $_->{id} => $_->{relation} } @{$p->{relations}}) : ();
- my %new = map { $_->[1] => $_->[0] } @$relations;
- _updreverse($self, \%old, \%new, $nrev->{itemid}, $nrev->{rev});
- }
-
- return $self->resRedirect("/p$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- !defined $frm->{$_} && ($frm->{$_} = $b4{$_}) for keys %b4;
- $frm->{lang} = 'ja' if !$pid && !defined $frm->{lang};
- $frm->{editsum} = sprintf 'Reverted to revision p%d.%d', $pid, $rev if $rev && !defined $frm->{editsum};
-
- my $title = $pid ? "Edit $p->{name}" : 'Add new producer';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('p', $p, 'edit') if $pid;
- $self->htmlEditMessage('p', $p, $title);
- $self->htmlForm({ frm => $frm, action => $pid ? "/p$pid/edit" : '/p/new', editsum => 1 },
- 'pedit_geninfo' => [ 'General info',
- [ select => name => 'Type', short => 'type',
- options => [ map [ $_, $self->{producer_types}{$_} ], keys %{$self->{producer_types}} ] ],
- [ input => name => 'Name (romaji)', short => 'name' ],
- [ input => name => 'Original name', short => 'original' ],
- [ static => content => 'The original name of the producer, leave blank if it is already in the Latin alphabet.' ],
- [ input => name => 'Aliases', short => 'alias', width => 400 ],
- [ static => content => '(Un)official aliases, separated by a comma.' ],
- [ select => name => 'Primary language', short => 'lang',
- options => [ map [ $_, "$_ ($self->{languages}{$_})" ], keys %{$self->{languages}} ] ],
- [ input => name => 'Website', short => 'website' ],
- [ input => name => 'Wikipedia link', short => 'l_wp', pre => 'http://en.wikipedia.org/wiki/' ],
- [ text => name => 'Description<br /><b class="standout">English please!</b>', short => 'desc', rows => 6 ],
- ], 'pedit_rel' => [ 'Relations',
- [ hidden => short => 'prodrelations' ],
- [ static => nolabel => 1, content => sub {
- h2 'Selected producers';
- table;
- tbody id => 'relation_tbl';
- # to be filled using javascript
- end;
- end;
-
- h2 'Add producer';
- table;
- Tr id => 'relation_new';
- td class => 'tc_prod';
- input type => 'text', class => 'text';
- end;
- td class => 'tc_rel';
- Select;
- option value => $_, $self->{prod_relations}{$_}[1]
- for (keys %{$self->{prod_relations}});
- end;
- end;
- td class => 'tc_add';
- a href => '#', 'add';
- end;
- end;
- end 'table';
- }],
- ]);
- $self->htmlFooter;
-}
-
-sub _updreverse {
- my($self, $old, $new, $pid, $rev) = @_;
- my %upd;
-
- # compare %old and %new
- for (keys %$old, keys %$new) {
- if(exists $$old{$_} and !exists $$new{$_}) {
- $upd{$_} = undef;
- } elsif((!exists $$old{$_} and exists $$new{$_}) || ($$old{$_} ne $$new{$_})) {
- $upd{$_} = $self->{prod_relations}{$$new{$_}}[0];
- }
- }
- return if !keys %upd;
-
- # edit all related producers
- for my $i (keys %upd) {
- my $r = $self->dbProducerGetRev(id => $i, what => 'relations')->[0];
- my @newrel = map $_->{id} != $pid ? [ $_->{relation}, $_->{id} ] : (), @{$r->{relations}};
- push @newrel, [ $upd{$i}, $pid ] if $upd{$i};
- $self->dbItemEdit(p => $i, $r->{rev},
- relations => \@newrel,
- editsum => "Reverse relation update caused by revision p$pid.$rev",
- uid => 1,
- );
- }
-}
-
-
-sub list {
- my($self, $char) = @_;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'q', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my($list, $np) = $self->dbProducerGet(
- $char ne 'all' ? ( char => $char ) : (),
- $f->{q} ? ( search => $f->{q} ) : (),
- results => 150,
- page => $f->{p}
- );
-
- $self->htmlHeader(title => 'Browse producers');
-
- div class => 'mainbox';
- h1 'Browse producers';
- form action => '/p/all', 'accept-charset' => 'UTF-8', method => 'get';
- $self->htmlSearchBox('p', $f->{q});
- end;
- p class => 'browseopts';
- for ('all', 'a'..'z', 0) {
- a href => "/p/$_", $_ eq $char ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#';
- }
- end;
- end;
-
- my $pageurl = "/p/$char" . ($f->{q} ? "?q=$f->{q}" : '');
- $self->htmlBrowseNavigate($pageurl, $f->{p}, $np, 't');
- div class => 'mainbox producerbrowse';
- h1 $f->{q} ? 'Search results' : 'Producer list';
- if(!@$list) {
- p 'No results found';
- } else {
- # spread the results over 3 equivalent-sized lists
- my $perlist = @$list/3 < 1 ? 1 : @$list/3;
- for my $c (0..(@$list < 3 ? $#$list : 2)) {
- ul;
- for ($perlist*$c..($perlist*($c+1))-1) {
- li;
- cssicon 'lang '.$list->[$_]{lang}, $self->{languages}{$list->[$_]{lang}};
- a href => "/p$list->[$_]{id}", title => $list->[$_]{original}, $list->[$_]{name};
- end;
- }
- end;
- }
- }
- clearfloat;
- end 'div';
- $self->htmlBrowseNavigate($pageurl, $f->{p}, $np, 'b');
- $self->htmlFooter;
-}
-
-
-# peforms a (simple) search and returns the results in XML format
-sub pxml {
- my $self = shift;
-
- my $q = $self->formValidate({ get => 'q', maxlength => 500 });
- return $self->resNotFound if $q->{_err};
- $q = $q->{q};
-
- my($list, $np) = $self->dbProducerGet(
- $q =~ /^p([1-9]\d*)/ ? (id => $1) : (search => $q, sort => 'search'),
- results => 10,
- page => 1,
- );
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'producers', more => $np ? 'yes' : 'no', query => $q;
- for(@$list) {
- tag 'item', id => $_->{id}, $_->{name};
- }
- end;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Releases.pm b/lib/VNDB/Handler/Releases.pm
deleted file mode 100644
index 19fa0678..00000000
--- a/lib/VNDB/Handler/Releases.pm
+++ /dev/null
@@ -1,655 +0,0 @@
-
-package VNDB::Handler::Releases;
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml', 'uri_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{r([1-9]\d*)(?:\.([1-9]\d*))?} => \&page,
- qr{(v)([1-9]\d*)/add} => \&edit,
- qr{r} => \&browse,
- qr{r(?:([1-9]\d*)(?:\.([1-9]\d*))?/(edit|copy))}
- => \&edit,
- qr{xml/releases.xml} => \&relxml,
-);
-
-
-sub page {
- my($self, $rid, $rev) = @_;
-
- my $method = $rev ? 'dbReleaseGetRev' : 'dbReleaseGet';
- my $r = $self->$method(
- id => $rid,
- what => 'vn extended producers platforms media',
- $rev ? (rev => $rev) : (),
- )->[0];
- return $self->resNotFound if !$r->{id};
-
- my $metadata = {
- 'og:title' => $r->{title},
- 'og:description' => $r->{notes},
- };
-
- $self->htmlHeader(title => $r->{title}, noindex => $rev, metadata => $metadata);
- $self->htmlMainTabs('r', $r);
- return if $self->htmlHiddenMessage('r', $r);
-
- if($rev) {
- my $prev = $rev && $rev > 1 && $self->dbReleaseGetRev(
- id => $rid, rev => $rev-1,
- what => 'vn extended producers platforms media changes'
- )->[0];
- $self->htmlRevision('r', $prev, $r,
- [ vn => 'Relations', join => '<br />', split => sub {
- map sprintf('<a href="/v%d" title="%s">%s</a>', $_->{vid}, $_->{original}||$_->{title}, shorten $_->{title}, 50), @{$_[0]};
- } ],
- [ type => 'Type' ],
- [ patch => 'Patch', serialize => sub { $_[0] ? 'Yes' : 'No' } ],
- [ freeware => 'Freeware', serialize => sub { $_[0] ? 'Yes' : 'No' } ],
- [ doujin => 'Doujin', serialize => sub { $_[0] ? 'Yes' : 'No' } ],
- [ title => 'Title (romaji)', diff => 1 ],
- [ original => 'Original title', diff => 1 ],
- [ gtin => 'JAN/UPC/EAN', serialize => sub { $_[0]||'[empty]' } ],
- [ catalog => 'Catalog number', serialize => sub { $_[0]||'[empty]' } ],
- [ languages => 'Language', join => ', ', split => sub { map $self->{languages}{$_}, @{$_[0]} } ],
- [ website => 'Website' ],
- [ released => 'Release date', htmlize => \&fmtdatestr ],
- [ minage => 'Age rating', serialize => \&minage ],
- [ notes => 'Notes', diff => qr/[ ,\n\.]/ ],
- [ platforms => 'Platforms', join => ', ', split => sub { map $self->{platforms}{$_}, @{$_[0]} } ],
- [ media => 'Media', join => ', ', split => sub { map fmtmedia($_->{medium}, $_->{qty}), @{$_[0]} } ],
- [ resolution => 'Resolution', serialize => sub { $self->{resolutions}[$_[0]][0]; } ],
- [ voiced => 'Voiced', serialize => sub { $self->{voiced}[$_[0]] } ],
- [ ani_story => 'Story animation', serialize => sub { $self->{animated}[$_[0]] } ],
- [ ani_ero => 'Ero animation', serialize => sub { $self->{animated}[$_[0]] } ],
- [ producers => 'Producers', join => '<br />', split => sub {
- map sprintf('<a href="/p%d" title="%s">%s</a> (%s)', $_->{id}, $_->{original}||$_->{name}, shorten($_->{name}, 50),
- join(', ', $_->{developer} ? 'developer' :(), $_->{publisher} ? 'publisher' :())
- ), @{$_[0]};
- } ],
- );
- }
-
- div class => 'mainbox release';
- $self->htmlItemMessage('r', $r);
- h1 $r->{title};
- h2 class => 'alttitle', $r->{original} if $r->{original};
-
- _infotable($self, $r);
-
- if($r->{notes}) {
- p class => 'description';
- lit bb2html $r->{notes};
- end;
- }
-
- end;
- $self->htmlFooter;
-}
-
-
-sub _infotable {
- my($self, $r) = @_;
- table class => 'stripe';
-
- Tr;
- td class => 'key', 'Relation';
- td;
- for (@{$r->{vn}}) {
- a href => "/v$_->{vid}", title => $_->{original}||$_->{title}, shorten $_->{title}, 60;
- br if $_ != $r->{vn}[$#{$r->{vn}}];
- }
- end;
- end;
-
- Tr;
- td 'Title';
- td $r->{title};
- end;
-
- if($r->{original}) {
- Tr;
- td 'Original title';
- td $r->{original};
- end;
- }
-
- Tr;
- td 'Type';
- td;
- cssicon "rt$r->{type}", $r->{type};
- txt sprintf ' %s%s', ucfirst($r->{type}), $r->{patch} ? ', patch' : '';
- end;
- end;
-
- Tr;
- td 'Language';
- td;
- for (@{$r->{languages}}) {
- cssicon "lang $_", $self->{languages}{$_};
- txt ' '.$self->{languages}{$_};
- br if $_ ne $r->{languages}[$#{$r->{languages}}];
- }
- end;
- end;
-
- Tr;
- td 'Publication';
- td join ', ',
- $r->{freeware} ? 'Freeware' : 'Non-free',
- $r->{patch} ? () : ($r->{doujin} ? 'doujin' : 'commercial');
- end;
-
- if(@{$r->{platforms}}) {
- Tr;
- td 'Platform'.(@{$r->{platforms}} == 1 ? '' : 's');
- td;
- for(@{$r->{platforms}}) {
- cssicon $_, $self->{platforms}{$_};
- txt ' '.$self->{platforms}{$_};
- br if $_ ne $r->{platforms}[$#{$r->{platforms}}];
- }
- end;
- end;
- }
-
- if(@{$r->{media}}) {
- Tr;
- td @{$r->{media}} == 1 ? 'Medium' : 'Media';
- td join ', ', map fmtmedia($_->{medium}, $_->{qty}), @{$r->{media}};
- end;
- }
-
- if($r->{resolution}) {
- Tr;
- td 'Resolution';
- td $self->{resolutions}[$r->{resolution}][0];
- end;
- }
-
- if($r->{voiced}) {
- Tr;
- td 'Voiced';
- td $self->{voiced}[$r->{voiced}];
- end;
- }
-
- if($r->{ani_story} || $r->{ani_ero}) {
- Tr;
- td 'Animation';
- td join ', ',
- $r->{ani_story} ? "Story: $self->{animated}[$r->{ani_story}]" : (),
- $r->{ani_ero} ? "Ero scenes: $self->{animated}[$r->{ani_ero}]" : ();
- end;
- }
-
- Tr;
- td 'Released';
- td;
- lit fmtdatestr $r->{released};
- end;
- end;
-
- if($r->{minage} >= 0) {
- Tr;
- td 'Age rating';
- td minage $r->{minage};
- end;
- }
-
- for my $t (qw|developer publisher|) {
- my @prod = grep $_->{$t}, @{$r->{producers}};
- if(@prod) {
- Tr;
- td ucfirst($t).(@prod == 1 ? '' : 's');
- td;
- for (@prod) {
- a href => "/p$_->{id}", title => $_->{original}||$_->{name}, shorten $_->{name}, 60;
- br if $_ != $prod[$#prod];
- }
- end;
- end;
- }
- }
-
- if($r->{gtin}) {
- Tr;
- td gtintype $r->{gtin};
- td $r->{gtin};
- end;
- }
-
- if($r->{catalog}) {
- Tr;
- td 'Catalog no.';
- td $r->{catalog};
- end;
- }
-
- if($r->{website}) {
- Tr;
- td 'Links';
- td;
- a href => $r->{website}, rel => 'nofollow', 'Official website';
- end;
- end;
- }
-
- if($self->authInfo->{id}) {
- my $rl = $self->dbRListGet(uid => $self->authInfo->{id}, rid => $r->{id})->[0];
- Tr;
- td 'User options';
- td;
- Select id => 'listsel', name => $self->authGetCode("/r$r->{id}/list");
- option value => -2, !$rl ? 'not on your list' : "Status: $self->{rlist_status}[$rl->{status}]";
- optgroup label => 'Set status';
- option value => $_, $self->{rlist_status}[$_]
- for (0..$#{$self->{rlist_status}});
- end;
- option value => -1, 'remove from list' if $rl;
- end;
- end;
- end 'tr';
- }
-
- end 'table';
-}
-
-
-# rid = \d -> edit/copy release
-# rid = 'v' -> add release to VN with id $rev
-sub edit {
- my($self, $rid, $rev, $copy) = @_;
-
- my $vid = 0;
- $copy = $rev && $rev eq 'copy' || $copy && $copy eq 'copy';
- $rev = undef if defined $rev && $rev !~ /^\d+$/;
- if($rid eq 'v') {
- $vid = $rev;
- $rev = undef;
- $rid = 0;
- }
-
- my $r = $rid && $self->dbReleaseGetRev(id => $rid, what => 'vn extended producers platforms media', $rev ? (rev => $rev) : ())->[0];
- return $self->resNotFound if $rid && !$r->{id};
- $rev = undef if !$r || $r->{lastrev};
-
- my $v = $vid && $self->dbVNGet(id => $vid)->[0];
- return $self->resNotFound if $vid && !$v->{id};
-
- return $self->htmlDenied if !$self->authCan('edit')
- || $rid && (($r->{locked} || $r->{hidden}) && !$self->authCan('dbmod'));
-
- my $vn = $rid ? $r->{vn} : [{ vid => $vid, title => $v->{title} }];
- my %b4 = !$rid ? () : (
- (map { $_ => $r->{$_} } qw|type title original gtin catalog languages website released minage
- notes platforms patch resolution voiced freeware doujin ani_story ani_ero ihid ilock|),
- media => join(',', sort map "$_->{medium} $_->{qty}", @{$r->{media}}),
- producers => join('|||', map
- sprintf('%d,%d,%s', $_->{id}, ($_->{developer}?1:0)+($_->{publisher}?2:0), $_->{name}),
- sort { $a->{id} <=> $b->{id} } @{$r->{producers}}
- ),
- );
- gtintype($b4{gtin}) if $b4{gtin}; # normalize gtin code
- $b4{vn} = join('|||', map "$_->{vid},$_->{title}", @$vn);
- my $frm;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'type', enum => $self->{release_types} },
- { post => 'patch', required => 0, default => 0 },
- { post => 'freeware', required => 0, default => 0 },
- { post => 'doujin', required => 0, default => 0 },
- { post => 'title', maxlength => 250 },
- { post => 'original', required => 0, default => '', maxlength => 250 },
- { post => 'gtin', required => 0, default => '0', template => 'gtin' },
- { post => 'catalog', required => 0, default => '', maxlength => 50 },
- { post => 'languages', multi => 1, enum => [ keys %{$self->{languages}} ] },
- { post => 'website', required => 0, default => '', maxlength => 250, template => 'weburl' },
- { post => 'released', required => 0, default => 0, template => 'rdate' },
- { post => 'minage' , required => 0, default => -1, enum => $self->{age_ratings} },
- { post => 'notes', required => 0, default => '', maxlength => 10240 },
- { post => 'platforms', required => 0, default => '', multi => 1, enum => [ keys %{$self->{platforms}} ] },
- { post => 'media', required => 0, default => '' },
- { post => 'resolution',required => 0, default => 0, enum => [ 0..$#{$self->{resolutions}} ] },
- { post => 'voiced', required => 0, default => 0, enum => [ 0..$#{$self->{voiced}} ] },
- { post => 'ani_story', required => 0, default => 0, enum => [ 0..$#{$self->{animated}} ] },
- { post => 'ani_ero', required => 0, default => 0, enum => [ 0..$#{$self->{animated}} ] },
- { post => 'producers', required => 0, default => '' },
- { post => 'vn', maxlength => 50000 },
- { post => 'editsum', template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- );
-
- push @{$frm->{_err}}, [ 'released', 'required', 1 ] if !$frm->{released};
-
- my($media, $producers, $new_vn);
- if(!$frm->{_err}) {
- # de-serialize
- $media = [ map [ split / / ], split /,/, $frm->{media} ];
- $producers = [ map { /^([0-9]+),([1-3])/ ? [ $1, $2&1?1:0, $2&2?1:0] : () } split /\|\|\|/, $frm->{producers} ];
- $new_vn = [ map { /^([0-9]+)/ ? $1 : () } split /\|\|\|/, $frm->{vn} ];
- $frm->{platforms} = [ grep $_, @{$frm->{platforms}} ];
- $frm->{$_} = $frm->{$_} ? 1 : 0 for (qw|patch freeware doujin ihid ilock|);
-
- # reset some fields when the patch flag is set
- $frm->{doujin} = $frm->{resolution} = $frm->{voiced} = $frm->{ani_story} = $frm->{ani_ero} = 0 if $frm->{patch};
-
- my $same = $rid &&
- (join(',', sort @{$b4{platforms}}) eq join(',', sort @{$frm->{platforms}})) &&
- (join(',', map join(' ', @$_), sort { $a->[0] <=> $b->[0] } @$producers) eq join(',', map sprintf('%d %d %d',$_->{id}, $_->{developer}?1:0, $_->{publisher}?1:0), sort { $a->{id} <=> $b->{id} } @{$r->{producers}})) &&
- (join(',', sort @$new_vn) eq join(',', sort map $_->{vid}, @$vn)) &&
- (join(',', sort @{$b4{languages}}) eq join(',', sort @{$frm->{languages}})) &&
- !grep !/^(platforms|producers|vn|languages)$/ && $frm->{$_} ne $b4{$_}, keys %b4;
- return $self->resRedirect("/r$rid", 'post') if !$copy && $same;
- $frm->{_err} = [ "No changes, please don't create an entry that is fully identical to another" ] if $copy && $same;
- }
-
- if(!$frm->{_err}) {
- my $nrev = $self->dbItemEdit(r => !$copy && $rid ? ($r->{id}, $r->{rev}) : (undef, undef),
- (map { $_ => $frm->{$_} } qw| type title original gtin catalog languages website released minage
- notes platforms resolution editsum patch voiced freeware doujin ani_story ani_ero ihid ilock|),
- vn => $new_vn,
- producers => $producers,
- media => $media,
- );
-
- return $self->resRedirect("/r$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- !defined $frm->{$_} && ($frm->{$_} = $b4{$_}) for keys %b4;
- $frm->{languages} = ['ja'] if !$rid && !defined $frm->{languages};
- $frm->{editsum} = sprintf 'Reverted to revision r%d.%d', $rid, $rev if !$copy && $rev && !defined $frm->{editsum};
- $frm->{editsum} = sprintf 'New release based on r%d.%d', $rid, $r->{rev} if $copy && !defined $frm->{editsum};
- $frm->{title} = $v->{title} if !defined $frm->{title} && !$r;
- $frm->{original} = $v->{original} if !defined $frm->{original} && !$r;
-
- my $title = !$rid ? "Add release to $v->{title}" : $copy ? "Copy $r->{title}" : "Edit $r->{title}";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('r', $r, $copy ? 'copy' : 'edit') if $rid;
- $self->htmlMainTabs('v', $v, 'edit') if $vid;
- $self->htmlEditMessage('r', $r, $title, $copy);
- _listrel($self, $vid) if $vid && $self->reqMethod ne 'POST';
- _form($self, $r, $v, $frm, $copy);
- $self->htmlFooter;
-}
-
-
-sub _form {
- my($self, $r, $v, $frm, $copy) = @_;
-
- $self->htmlForm({ frm => $frm, action => $r ? "/r$r->{id}/".($copy ? 'copy' : 'edit') : "/v$v->{id}/add", editsum => 1 },
- rel_geninfo => [ 'General info',
- [ select => short => 'type', name => 'Type',
- options => [ map [ $_, ucfirst $_ ], @{$self->{release_types}} ] ],
- [ check => short => 'patch', name => 'This release is a patch to another release.' ],
- [ check => short => 'freeware', name => 'Freeware (i.e. available at no cost)' ],
- [ check => short => 'doujin', name => 'Doujin (self-published, not by a company)' ],
- [ input => short => 'title', name => 'Title (romaji)', width => 450 ],
- [ input => short => 'original', name => 'Original title', width => 450 ],
- [ static => content => 'The original title of this release, leave blank if it already is in the Latin alphabet.' ],
- [ select => short => 'languages', name => 'Language(s)', multi => 1,
- options => [ map [ $_, "$_ ($self->{languages}{$_})" ], keys %{$self->{languages}} ] ],
- [ input => short => 'gtin', name => 'JAN/UPC/EAN' ],
- [ input => short => 'catalog', name => 'Catalog number' ],
- [ input => short => 'website', name => 'Official website' ],
- [ date => short => 'released', name => 'Release date' ],
- [ static => content => 'Leave month or day blank if they are unknown' ],
- [ select => short => 'minage', name => 'Age rating',
- options => [ map [ $_, minage $_, 1 ], @{$self->{age_ratings}} ] ],
- [ textarea => short => 'notes', name => 'Notes<br /><b class="standout">English please!</b>' ],
- [ static => content =>
- 'Miscellaneous notes/comments, information that does not fit in the above fields.'
- .' E.g.: Censored/uncensored or for which releases this patch applies.' ],
- ],
-
- rel_format => [ 'Format',
- [ select => short => 'resolution', name => 'Resolution', options => [
- map [ $_, @{$self->{resolutions}[$_]} ], 0..$#{$self->{resolutions}} ] ],
- [ select => short => 'voiced', name => 'Voiced', options => [
- map [ $_, $self->{voiced}[$_] ], 0..$#{$self->{voiced}} ] ],
- [ select => short => 'ani_story', name => 'Story animation', options => [
- map [ $_, $self->{animated}[$_] ], 0..$#{$self->{animated}} ] ],
- [ select => short => 'ani_ero', name => 'Ero animation', options => [
- map [ $_, $_ ? $self->{animated}[$_] : 'Unknown / no ero scenes' ], 0..$#{$self->{animated}} ] ],
- [ static => content => 'Animation in erotic scenes, leave to unknown if there are no ero scenes.' ],
- [ hidden => short => 'media' ],
- [ static => nolabel => 1, content => sub {
- h2 'Platforms';
- div class => 'platforms';
- for my $p (sort keys %{$self->{platforms}}) {
- span;
- input type => 'checkbox', name => 'platforms', value => $p, id => $p,
- $frm->{platforms} && grep($_ eq $p, @{$frm->{platforms}}) ? (checked => 'checked') : ();
- label for => $p;
- cssicon $p, $self->{platforms}{$p};
- txt ' '.$self->{platforms}{$p};;
- end;
- end;
- }
- end;
-
- h2 'Media';
- div id => 'media_div', '';
- }],
- ],
-
- rel_prod => [ 'Producers',
- [ hidden => short => 'producers' ],
- [ static => nolabel => 1, content => sub {
- h2 'Selected producers';
- table; tbody id => 'producer_tbl'; end; end;
- h2 'Add producer';
- table; Tr;
- td class => 'tc_name'; input id => 'producer_input', type => 'text', class => 'text'; end;
- td class => 'tc_role'; Select id => 'producer_role';
- option value => 1, 'Developer';
- option value => 2, selected => 'selected', 'Publisher';
- option value => 3, 'Both';
- end; end;
- td class => 'tc_add'; a id => 'producer_add', href => '#', 'add'; end;
- end; end 'table';
- }],
- ],
-
- rel_vn => [ 'Visual novels',
- [ hidden => short => 'vn' ],
- [ static => nolabel => 1, content => sub {
- h2 'Selected visual novels';
- table class => 'stripe'; tbody id => 'vn_tbl'; end; end;
- h2 'Add visual novel';
- div;
- input id => 'vn_input', type => 'text', class => 'text';
- a href => '#', id => 'vn_add', 'add';
- end;
- }],
- ],
- );
-}
-
-sub _listrel {
- my($self, $vid) = @_;
- my $l = $self->dbReleaseGet(vid => $vid, hidden_only => 1, results => 50);
- return if !@$l;
- div class => 'mainbox';
- h1 'Deleted releases';
- div class => 'warning';
- p q{This visual novel has releases that have been deleted before. Please
- review this list to make sure you're not adding a release that has already
- been deleted before.};
- br;
- ul;
- for(@$l) {
- li;
- txt '['.join(',', @{$_->{languages}}).'] ';
- a href => "/r$_->{id}", title => $_->{original}||$_->{title}, "$_->{title} (r$_->{id})";
- end;
- }
- end;
- end;
- end;
-}
-
-sub browse {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'o', required => 0, default => 'a', enum => ['a', 'd'] },
- { get => 'q', required => 0, default => '', maxlength => 500 },
- { get => 's', required => 0, default => 'title', enum => [qw|released minage title|] },
- { get => 'fil',required => 0 },
- );
- return $self->resNotFound if $f->{_err};
- $f->{fil} //= $self->authPref('filter_release');
-
- my %compat = _fil_compat($self);
- my($list, $np) = !$f->{q} && !$f->{fil} && !keys %compat ? ([], 0) : $self->filFetchDB(release => $f->{fil}, \%compat, {
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- page => $f->{p},
- results => 50,
- what => 'platforms',
- $f->{q} ? ( search => $f->{q} ) : (),
- });
-
- $self->htmlHeader(title => 'Browse releases');
-
- form method => 'get', action => '/r', 'accept-charset' => 'UTF-8';
- div class => 'mainbox';
- h1 'Browse releases';
- $self->htmlSearchBox('r', $f->{q});
- p class => 'filselect';
- a id => 'filselect', href => '#r';
- lit '<i>&#9656;</i> Filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => 'fil', id => 'fil', value => $f->{fil};
- end;
- end 'form';
-
- my $uri = sprintf '/r?q=%s;fil=%s', uri_escape($f->{q}), $f->{fil};
- $self->htmlBrowse(
- class => 'relbrowse',
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => "$uri;s=$f->{s};o=$f->{o}",
- sorturl => $uri,
- header => [
- [ 'Released', 'released' ],
- [ 'Rating', 'minage' ],
- [ '', '' ],
- [ 'Title', 'title' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1';
- lit fmtdatestr $l->{released};
- end;
- td class => 'tc2', $l->{minage} < 0 ? '' : minage $l->{minage};
- td class => 'tc3';
- $_ ne 'oth' && cssicon $_, $self->{platforms}{$_} for (@{$l->{platforms}});
- cssicon "lang $_", $self->{languages}{$_} for (@{$l->{languages}});
- cssicon "rt$l->{type}", $l->{type};
- end;
- td class => 'tc4';
- a href => "/r$l->{id}", title => $l->{original}||$l->{title}, shorten $l->{title}, 90;
- b class => 'grayedout', ' (patch)' if $l->{patch};
- end;
- end 'tr';
- },
- ) if @$list;
- if(($f->{q} || $f->{fil}) && !@$list) {
- div class => 'mainbox';
- h1 'No results found';
- div class => 'notice';
- p;
- txt 'Sorry, couldn\'t find anything that comes through your filters. You might want to disable a few filters to get more results.';
- br; br;
- txt 'Also, keep in mind that we don\'t have all information about all releases.'
- .' So e.g. filtering on screen resolution will exclude all releases of which we don\'t know it\'s resolution,'
- .' even though it might in fact be in the resolution you\'re looking for.';
- end
- end;
- end;
- }
- $self->htmlFooter(pref_code => 1);
-}
-
-
-# provide compatibility with old URLs
-sub _fil_compat {
- my $self = shift;
- my %c;
- my $f = $self->formValidate(
- { get => 'ln', required => 0, multi => 1, default => '', enum => [ keys %{$self->{languages}} ] },
- { get => 'pl', required => 0, multi => 1, default => '', enum => [ keys %{$self->{platforms}} ] },
- { get => 'me', required => 0, multi => 1, default => '', enum => [ keys %{$self->{media}} ] },
- { get => 'tp', required => 0, default => '', enum => [ '', @{$self->{release_types}} ] },
- { get => 'pa', required => 0, default => 0, enum => [ 0..2 ] },
- { get => 'fw', required => 0, default => 0, enum => [ 0..2 ] },
- { get => 'do', required => 0, default => 0, enum => [ 0..2 ] },
- { get => 'ma_m', required => 0, default => 0, enum => [ 0, 1 ] },
- { get => 'ma_a', required => 0, default => 0, enum => $self->{age_ratings} },
- { get => 'mi', required => 0, default => 0, template => 'uint' },
- { get => 'ma', required => 0, default => 99999999, template => 'uint' },
- { get => 're', required => 0, multi => 1, default => 0, enum => [ 1..$#{$self->{resolutions}} ] },
- );
- return () if $f->{_err};
- $c{minage} = [ grep $_ >= 0 && ($f->{ma_m} ? $f->{ma_a} >= $_ : $f->{ma_a} <= $_), @{$self->{age_ratings}} ] if $f->{ma_a} || $f->{ma_m};
- $c{date_after} = $f->{mi} if $f->{mi};
- $c{date_before} = $f->{ma} if $f->{ma} < 99990000;
- $c{plat} = $f->{pl} if $f->{pl}[0];
- $c{lang} = $f->{ln} if $f->{ln}[0];
- $c{med} = $f->{me} if $f->{me}[0];
- $c{resolution} = $f->{re} if $f->{re}[0];
- $c{type} = $f->{tp} if $f->{tp};
- $c{patch} = $f->{pa} == 2 ? 0 : 1 if $f->{pa};
- $c{freeware} = $f->{fw} == 2 ? 0 : 1 if $f->{fw};
- $c{doujin} = $f->{do} == 2 ? 0 : 1 if $f->{do};
- return %c;
-}
-
-
-sub relxml {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 'v', required => 1, multi => 1, mincount => 1, template => 'id' }
- );
- return $self->resNotFound if $f->{_err};
-
- my $list = $self->dbReleaseGet(vid => $f->{v}, results => 100, what => 'vn');
- my %vns = map +($_,0), @{$f->{v}};
- for my $r (@$list) {
- for my $v (@{$r->{vn}}) {
- next if !exists $vns{$v->{vid}};
- $vns{$v->{vid}} = [ $v ] if !$vns{$v->{vid}};
- push @{$vns{$v->{vid}}}, $r;
- }
- }
- !$vns{$_} && delete $vns{$_} for(keys %vns);
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'vns';
- for (sort { $a->[0]{title} cmp $b->[0]{title} } values %vns) {
- next if !$_;
- my $v = shift @$_;
- tag 'vn', id => $v->{vid}, title => $v->{title};
- tag 'release', id => $_->{id}, lang => join(',', @{$_->{languages}}), $_->{title}
- for (@$_);
- end;
- }
- end;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/Staff.pm b/lib/VNDB/Handler/Staff.pm
deleted file mode 100644
index ca2f9842..00000000
--- a/lib/VNDB/Handler/Staff.pm
+++ /dev/null
@@ -1,392 +0,0 @@
-
-package VNDB::Handler::Staff;
-
-use strict;
-use warnings;
-use TUWF qw(:html :xml uri_escape xml_escape);
-use VNDB::Func;
-use List::Util qw(first);
-
-TUWF::register(
- qr{s([1-9]\d*)(?:\.([1-9]\d*))?} => \&page,
- qr{s(?:([1-9]\d*)(?:\.([1-9]\d*))?/edit|/new)}
- => \&edit,
- qr{s/([a-z0]|all)} => \&list,
- qr{xml/staff\.xml} => \&staffxml,
-);
-
-
-sub page {
- my($self, $id, $rev) = @_;
-
- my $method = $rev ? 'dbStaffGetRev' : 'dbStaffGet';
- my $s = $self->$method(
- id => $id,
- what => 'extended aliases roles',
- $rev ? ( rev => $rev ) : ()
- )->[0];
- return $self->resNotFound if !$s->{id};
-
- my $metadata = {
- 'og:title' => $s->{name},
- 'og:description' => $s->{desc},
- };
-
- $self->htmlHeader(title => $s->{name}, noindex => $rev, metadata => $metadata);
- $self->htmlMainTabs('s', $s) if $id;
- return if $self->htmlHiddenMessage('s', $s);
-
- if($rev) {
- my $prev = $rev && $rev > 1 && $self->dbStaffGetRev(id => $id, rev => $rev-1, what => 'extended aliases')->[0];
- $self->htmlRevision('s', $prev, $s,
- [ name => 'Name (romaji)', diff => 1 ],
- [ original => 'Original name', diff => 1 ],
- [ gender => 'Gender', serialize => sub { $self->{genders}{$_[0]} } ],
- [ lang => 'Language', serialize => sub { "$_[0] ($self->{languages}{$_[0]})" } ],
- [ l_site => 'Official page', diff => 1 ],
- [ l_wp => 'Wikipedia link', htmlize => sub {
- $_[0] ? sprintf '<a href="http://en.wikipedia.org/wiki/%s">%1$s</a>', xml_escape $_[0] : '[empty]'
- }],
- [ l_twitter => 'Twitter account', diff => 1 ],
- [ l_anidb => 'AniDB creator ID', serialize => sub { $_[0] // '' } ],
- [ desc => 'Description', diff => qr/[ ,\n\.]/ ],
- [ aliases => 'Aliases', join => '<br />', split => sub {
- map xml_escape(sprintf('%s%s', $_->{name}, $_->{original} ? ' ('.$_->{original}.')' : '')), @{$_[0]};
- }],
- );
- }
-
- div class => 'mainbox staffpage';
- $self->htmlItemMessage('s', $s);
- h1 $s->{name};
- h2 class => 'alttitle', $s->{original} if $s->{original};
-
- # info table
- table class => 'stripe';
- thead;
- Tr;
- td colspan => 2;
- b style => 'margin-right: 10px', $s->{name};
- b class => 'grayedout', style => 'margin-right: 10px', $s->{original} if $s->{original};
- cssicon "gen $s->{gender}", $self->{genders}{$s->{gender}} if $s->{gender} ne 'unknown';
- end;
- end;
- end;
- Tr;
- td class => 'key', 'Language';
- td $self->{languages}{$s->{lang}};
- end;
- if(@{$s->{aliases}}) {
- Tr;
- td class => 'key', @{$s->{aliases}} == 1 ? 'Alias' : 'Aliases';
- td;
- table class => 'aliases';
- for my $alias (@{$s->{aliases}}) {
- Tr class => 'nostripe';
- td $alias->{original} ? () : (colspan => 2), class => 'key';
- txt $alias->{name};
- end;
- td $alias->{original} if $alias->{original};
- end;
- }
- end;
- end;
- end;
- }
- my @links = (
- $s->{l_site} ? [ 'Official page', $s->{l_site} ] : (),
- $s->{l_wp} ? [ 'Wikipedia', "http://en.wikipedia.org/wiki/$s->{l_wp}" ] : (),
- $s->{l_twitter} ? [ 'Twitter', "https://twitter.com/$s->{l_twitter}" ] : (),
- $s->{l_anidb} ? [ 'AniDB', "http://anidb.net/cr$s->{l_anidb}" ] : (),
- );
- if(@links) {
- Tr;
- td class => 'key', 'Links';
- td;
- for(@links) {
- a href => $_->[1], $_->[0];
- br if $_ != $links[$#links];
- }
- end;
- end;
- }
- end 'table';
-
- # description
- p class => 'description';
- lit bb2html $s->{desc}, 0, 1;
- end;
- end;
-
- _roles($self, $s);
- _cast($self, $s);
- $self->htmlFooter;
-}
-
-
-sub _roles {
- my($self, $s) = @_;
- return if !@{$s->{roles}};
-
- h1 class => 'boxtitle', 'Credits';
- $self->htmlBrowse(
- items => $s->{roles},
- class => 'staffroles',
- header => [
- [ 'Title' ],
- [ 'Released' ],
- [ 'Role' ],
- [ 'As' ],
- [ 'Note' ],
- ],
- row => sub {
- my($r, $n, $l) = @_;
- Tr;
- td class => 'tc1'; a href => "/v$l->{vid}", title => $l->{t_original}||$l->{title}, shorten $l->{title}, 60; end;
- td class => 'tc2'; lit fmtdatestr $l->{c_released}; end;
- td class => 'tc3', $self->{staff_roles}{$l->{role}};
- td class => 'tc4', title => $l->{original}||$l->{name}, $l->{name};
- td class => 'tc5', $l->{note};
- end;
- },
- );
-}
-
-
-sub _cast {
- my($self, $s) = @_;
- return if !@{$s->{cast}};
-
- h1 class => 'boxtitle', sprintf 'Voiced characters (%d)', scalar @{$s->{cast}};
- $self->htmlBrowse(
- items => $s->{cast},
- class => 'staffroles',
- header => [
- [ 'Title' ],
- [ 'Released' ],
- [ 'Cast' ],
- [ 'As' ],
- [ 'Note' ],
- ],
- row => sub {
- my($r, $n, $l) = @_;
- Tr;
- td class => 'tc1'; a href => "/v$l->{vid}", title => $l->{t_original}||$l->{title}, shorten $l->{title}, 60; end;
- td class => 'tc2'; lit fmtdatestr $l->{c_released}; end;
- td class => 'tc3'; a href => "/c$l->{cid}", title => $l->{c_original}, $l->{c_name}; end;
- td class => 'tc4', title => $l->{original}||$l->{name}, $l->{name};
- td class => 'tc5', $l->{note};
- end;
- },
- );
-}
-
-
-sub edit {
- my($self, $sid, $rev) = @_;
-
- my $s = $sid && $self->dbStaffGetRev(id => $sid, what => 'extended aliases roles', $rev ? (rev => $rev) : ())->[0];
- return $self->resNotFound if $sid && !$s->{id};
- $rev = undef if !$s || $s->{lastrev};
-
- return $self->htmlDenied if !$self->authCan('edit')
- || $sid && (($s->{locked} || $s->{hidden}) && !$self->authCan('dbmod'));
-
- my %b4 = !$sid ? () : (
- (map { $_ => $s->{$_} } qw|name original gender lang desc l_wp l_site l_twitter l_anidb ihid ilock|),
- primary => $s->{aid},
- aliases => [
- map +{ aid => $_->{aid}, name => $_->{name}, orig => $_->{original} },
- sort { $a->{name} cmp $b->{name} || $a->{original} cmp $b->{original} } @{$s->{aliases}}
- ],
- );
- my $frm;
-
- if ($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate (
- { post => 'name', maxlength => 200 },
- { post => 'original', required => 0, maxlength => 200, default => '' },
- { post => 'primary', required => 0, template => 'id', default => 0 },
- { post => 'desc', required => 0, maxlength => 5000, default => '' },
- { post => 'gender', required => 0, default => 'unknown', enum => [qw|unknown m f|] },
- { post => 'lang', enum => [ keys %{$self->{languages}} ] },
- { post => 'l_wp', required => 0, maxlength => 150, default => '' },
- { post => 'l_site', required => 0, template => 'weburl', maxlength => 250, default => '' },
- { post => 'l_twitter', required => 0, maxlength => 16, default => '', regex => [ qr/^\S+$/, 'Invalid twitter username' ] },
- { post => 'l_anidb', required => 0, template => 'id', default => undef },
- { post => 'aliases', template => 'json', json_sort => ['name','orig'], json_fields => [
- { field => 'name', required => 1, maxlength => 200 },
- { field => 'orig', required => 0, maxlength => 200, default => '' },
- { field => 'aid', required => 0, template => 'id', default => 0 },
- ]},
- { post => 'editsum', template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- );
-
- if(!$frm->{_err}) {
- my %old_aliases = $sid ? ( map +($_->{aid} => 1), @{$self->dbStaffAliasIds($sid)} ) : ();
- $frm->{primary} = 0 unless exists $old_aliases{$frm->{primary}};
-
- # reset aid to zero for newly added aliases.
- $_->{aid} *= $old_aliases{$_->{aid}} ? 1 : 0 for(@{$frm->{aliases}});
-
- # Make sure no aliases that have been linked to a VN are removed.
- my %new_aliases = map +($_, 1), grep $_, $frm->{primary}, map $_->{aid}, @{$frm->{aliases}};
- $frm->{_err} = [ "Can't remove an alias that is still linked to a VN." ]
- if grep !$new_aliases{$_->{aid}}, @{$s->{roles}}, @{$self->{cast}};
- }
-
- if(!$frm->{_err}) {
- $frm->{ihid} = $frm->{ihid} ?1:0;
- $frm->{ilock} = $frm->{ilock}?1:0;
- $frm->{aid} = $frm->{primary} if $sid;
- $frm->{desc} = $self->bbSubstLinks($frm->{desc});
- return $self->resRedirect("/s$sid", 'post') if $sid && !form_compare(\%b4, $frm);
-
- my $nrev = $self->dbItemEdit(s => $sid ? ($s->{id}, $s->{rev}) : (undef, undef), %$frm);
- return $self->resRedirect("/s$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- $frm->{$_} //= $b4{$_} for keys %b4;
- $frm->{editsum} //= sprintf 'Reverted to revision s%d.%d', $sid, $rev if $rev;
- $frm->{lang} = 'ja' if !$sid && !defined $frm->{lang};
-
- my $title = $s ? "Edit $s->{name}" : 'Add staff member';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('s', $s, 'edit') if $s;
- $self->htmlEditMessage('s', $s, $title);
- $self->htmlForm({ frm => $frm, action => $s ? "/s$sid/edit" : '/s/new', editsum => 1 },
- staffe_geninfo => [ 'General info',
- [ hidden => short => 'name' ],
- [ hidden => short => 'original' ],
- [ hidden => short => 'primary' ],
- [ json => short => 'aliases' ],
- $sid && @{$s->{aliases}} ?
- [ static => content => 'You may choose a different primary name.' ] : (),
- [ static => label => 'Names', content => sub {
- table id => 'names';
- thead; Tr;
- td class => 'tc_id'; end;
- td class => 'tc_name', 'Name (romaji)';
- td class => 'tc_original', 'Original'; td; end;
- end; end;
- tbody id => 'alias_tbl';
- # filled with javascript
- end;
- end;
- }],
- [ static => content => '<br />' ],
- [ text => name => 'Staff note<br /><b class="standout">English please!</b>', short => 'desc', rows => 4 ],
- [ select => name => 'Gender',short => 'gender', options => [
- map [ $_, $self->{genders}{$_} ], qw(unknown m f) ] ],
- [ select => name => 'Primary language', short => 'lang',
- options => [ map [ $_, "$_ ($self->{languages}{$_})" ], keys %{$self->{languages}} ] ],
- [ input => name => 'Official page', short => 'l_site' ],
- [ input => name => 'Wikipedia link', short => 'l_wp', pre => 'http://en.wikipedia.org/wiki/' ],
- [ input => name => 'Twitter username', short => 'l_twitter' ],
- [ input => name => 'AniDB creator ID', short => 'l_anidb' ],
- [ static => content => '<br />' ],
- ]);
-
- $self->htmlFooter;
-}
-
-
-sub list {
- my ($self, $char) = @_;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'q', required => 0, default => '' },
- { get => 'fil', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my ($list, $np) = $self->filFetchDB(staff => $f->{fil}, {}, {
- $char ne 'all' ? ( char => $char ) : (),
- $f->{q} ? ($f->{q} =~ /^=(.+)$/ ? (exact => $1) : (search => $f->{q})) : (),
- results => 150,
- page => $f->{p}
- });
-
- return $self->resRedirect('/s'.$list->[0]{id}, 'temp')
- if $f->{q} && @$list && (!first { $_->{id} != $list->[0]{id} } @$list) && $f->{p} == 1 && !$f->{fil};
- # redirect to the staff page if all results refer to the same entry
-
- my $quri = join(';', $f->{q} ? 'q='.uri_escape($f->{q}) : (), $f->{fil} ? "fil=$f->{fil}" : ());
- $quri = '?'.$quri if $quri;
- my $pageurl = "/s/$char$quri";
-
- $self->htmlHeader(title => 'Browse staff');
-
- form action => '/s/all', 'accept-charset' => 'UTF-8', method => 'get';
- div class => 'mainbox';
- h1 'Browse staff';
- $self->htmlSearchBox('s', $f->{q});
- p class => 'browseopts';
- for ('all', 'a'..'z', 0) {
- a href => "/s/$_$quri", $_ eq $char ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#';
- }
- end;
-
- p class => 'filselect';
- a id => 'filselect', href => '#s';
- lit '<i>&#9656;</i> Filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => 'fil', id => 'fil', value => $f->{fil};
- end;
- end 'form';
-
- $self->htmlBrowseNavigate($pageurl, $f->{p}, $np, 't');
- div class => 'mainbox staffbrowse';
- h1 $f->{q} ? 'Search results' : 'Staff list';
- if(!@$list) {
- p 'No results found';
- } else {
- # spread the results over 3 equivalent-sized lists
- my $perlist = @$list/3 < 1 ? 1 : @$list/3;
- for my $c (0..(@$list < 3 ? $#$list : 2)) {
- ul;
- for ($perlist*$c..($perlist*($c+1))-1) {
- li;
- my $gender = $list->[$_]{gender};
- cssicon 'lang '.$list->[$_]{lang}, $self->{languages}{$list->[$_]{lang}};
- a href => "/s$list->[$_]{id}",
- title => $list->[$_]{original}, $list->[$_]{name};
- end;
- }
- end;
- }
- }
- clearfloat;
- end 'div';
- $self->htmlBrowseNavigate($pageurl, $f->{p}, $np, 'b');
- $self->htmlFooter;
-}
-
-
-sub staffxml {
- my $self = shift;
-
- my $q = $self->formValidate({ get => 'q', required => 0, maxlength => 500 });
- return $self->resNotFound if $q->{_err} || !$q->{q};
-
- my($list, $np) = $self->dbStaffGet(
- $q->{q} =~ /^s([1-9]\d*)/ ? (id => $1) : $q->{q} =~ /^=(.+)/ ? (exact => $1) : (search => $q->{q}, sort => 'search'),
- results => 10, page => 1,
- );
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'staff', more => $np ? 'yes' : 'no';
- for(@$list) {
- tag 'item', sid => $_->{id}, id => $_->{aid}, orig => $_->{original}, $_->{name};
- }
- end;
-}
-
-1;
diff --git a/lib/VNDB/Handler/Tags.pm b/lib/VNDB/Handler/Tags.pm
deleted file mode 100644
index 43215fde..00000000
--- a/lib/VNDB/Handler/Tags.pm
+++ /dev/null
@@ -1,762 +0,0 @@
-
-package VNDB::Handler::Tags;
-
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml', 'xml_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{g([1-9]\d*)}, \&tagpage,
- qr{g([1-9]\d*)/(edit)}, \&tagedit,
- qr{g([1-9]\d*)/(add)}, \&tagedit,
- qr{g/new}, \&tagedit,
- qr{g/list}, \&taglist,
- qr{g/links}, \&taglinks,
- qr{v([1-9]\d*)/tagmod}, \&vntagmod,
- qr{u([1-9]\d*)/tags}, \&usertags,
- qr{g}, \&tagindex,
- qr{g/debug}, \&fulltree,
- qr{xml/tags\.xml}, \&tagxml,
-);
-
-
-sub tagpage {
- my($self, $tag) = @_;
-
- my $t = $self->dbTagGet(id => $tag, what => 'parents(0) childs(2) aliases')->[0];
- return $self->resNotFound if !$t;
-
- my $f = $self->formValidate(
- { get => 's', required => 0, default => 'tagscore', enum => [ qw|title rel pop tagscore rating| ] },
- { get => 'o', required => 0, default => 'd', enum => [ 'a','d' ] },
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'm', required => 0, default => $self->authPref('spoilers') || 0, enum => [qw|0 1 2|] },
- { get => 'fil', required => 0 },
- );
- return $self->resNotFound if $f->{_err};
- $f->{fil} //= $self->authPref('filter_vn');
-
- my($list, $np) = $t->{meta} || $t->{state} != 2 ? ([],0) : $self->filFetchDB(vn => $f->{fil}, undef, {
- what => 'rating',
- results => 50,
- page => $f->{p},
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- tagspoil => $f->{m},
- tag_inc => $tag,
- tag_exc => undef,
- });
-
- my $title = ($t->{meta} ? 'Meta tag: ' : 'Tag: ').$t->{name};
- $self->htmlHeader(title => $title, noindex => $t->{state} != 2);
- $self->htmlMainTabs('g', $t);
-
- if($t->{state} != 2) {
- div class => 'mainbox';
- h1 $title;
- if($t->{state} == 1) {
- div class => 'warning';
- h2 'Tag deleted';
- p;
- txt 'This tag has been removed from the database, and cannot be used or re-added.';
- br;
- txt 'File a request on the ';
- a href => '/t/db', 'discussion board';
- txt ' if you disagree with this.';
- end;
- end;
- } else {
- div class => 'notice';
- h2 'Waiting for approval';
- p 'This tag is waiting for a moderator to approve it. You can still use it to tag VNs as you would with a normal tag.';
- end;
- }
- end 'div';
- }
-
- div class => 'mainbox';
- a class => 'addnew', href => "/g$tag/add", 'Create child tag' if $self->authCan('tag') && $t->{state} != 1;
- h1 $title;
-
- parenttags($t, 'Tags', 'g');
-
- if($t->{description}) {
- p class => 'description';
- lit bb2html $t->{description};
- end;
- }
- p class => 'center';
- b 'Category';
- br;
- txt $self->{tag_categories}{$t->{cat}};
- end;
- if(@{$t->{aliases}}) {
- p class => 'center';
- b 'Aliases';
- br;
- lit xml_escape($_).'<br />' for (@{$t->{aliases}});
- end;
- }
- end 'div';
-
- childtags($self, 'Child tags', 'g', $t) if @{$t->{childs}};
-
- if(!$t->{meta} && $t->{state} == 2) {
- form action => "/g$t->{id}", 'accept-charset' => 'UTF-8', method => 'get';
- div class => 'mainbox';
- a class => 'addnew', href => "/g/links?t=$tag", 'Recently tagged';
- h1 'Visual novels';
-
- p class => 'browseopts';
- a href => "/g$t->{id}?fil=$f->{fil};m=0", $f->{m} == 0 ? (class => 'optselected') : (), 'Hide spoilers';
- a href => "/g$t->{id}?fil=$f->{fil};m=1", $f->{m} == 1 ? (class => 'optselected') : (), 'Show minor spoilers';
- a href => "/g$t->{id}?fil=$f->{fil};m=2", $f->{m} == 2 ? (class => 'optselected') : (), 'Spoil me!';
- end;
-
- p class => 'filselect';
- a id => 'filselect', href => '#v';
- lit '<i>&#9656;</i> Filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => 'fil', id => 'fil', value => $f->{fil};
-
- if(!@$list) {
- p; br; br; txt 'This tag has not been linked to any visual novels yet, or they were hidden because of your spoiler settings or default filters.'; end;
- }
- p; br; txt 'The list below also includes all visual novels linked to child tags. This list is cached, it can take up to 24 hours after a visual novel has been tagged for it to show up on this page.'; end;
- end 'div';
- end 'form';
- $self->htmlBrowseVN($list, $f, $np, "/g$t->{id}?fil=$f->{fil};m=$f->{m}", 1) if @$list;
- }
-
- $self->htmlFooter(pref_code => 1);
-}
-
-
-sub tagedit {
- my($self, $tag, $act) = @_;
-
- my($frm, $par);
- if($act && $act eq 'add') {
- $par = $self->dbTagGet(id => $tag)->[0];
- return $self->resNotFound if !$par;
- $frm->{parents} = $par->{name};
- $frm->{cat} = $par->{cat};
- $tag = undef;
- }
-
- return $self->htmlDenied if !$self->authCan('tag') || $tag && !$self->authCan('tagmod');
-
- my $t = $tag && $self->dbTagGet(id => $tag, what => 'parents(1) aliases addedby')->[0];
- return $self->resNotFound if $tag && !$t;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'name', required => 1, maxlength => 250, regex => [ qr/^[^,]+$/, 'A comma is not allowed in tag names' ] },
- { post => 'state', required => 0, default => 0, enum => [ 0..2 ] },
- { post => 'cat', required => 1, enum => [ keys %{$self->{tag_categories}} ] },
- { post => 'catrec', required => 0 },
- { post => 'meta', required => 0, default => 0 },
- { post => 'alias', required => 0, maxlength => 1024, default => '', regex => [ qr/^[^,]+$/s, 'No comma allowed in aliases' ] },
- { post => 'description', required => 0, maxlength => 10240, default => '' },
- { post => 'parents', required => !$self->authCan('tagmod'), default => '' },
- { post => 'merge', required => 0, default => '' },
- );
- my @aliases = split /[\t\s]*\n[\t\s]*/, $frm->{alias};
- my @parents = split /[\t\s]*,[\t\s]*/, $frm->{parents};
- my @merge = split /[\t\s]*,[\t\s]*/, $frm->{merge};
- if(!$frm->{_err}) {
- my @dups = @{$self->dbTagGet(name => $frm->{name}, noid => $tag)};
- push @dups, @{$self->dbTagGet(name => $_, noid => $tag)} for @aliases;
- push @{$frm->{_err}}, \sprintf 'Tag <a href="/g%d">%s</a> already exists!', $_->{id}, xml_escape $_->{name} for @dups;
- for(@parents, @merge) {
- my $c = $self->dbTagGet(name => $_, noid => $tag);
- push @{$frm->{_err}}, "Tag '$_' not found" if !@$c;
- $_ = $c->[0]{id};
- }
- }
-
- if(!$frm->{_err}) {
- $frm->{state} = $frm->{meta} = 0 if !$self->authCan('tagmod');
- my %opts = (
- name => $frm->{name},
- state => $frm->{state},
- cat => $frm->{cat},
- description => $frm->{description},
- meta => $frm->{meta}?1:0,
- aliases => \@aliases,
- parents => \@parents,
- );
- if(!$tag) {
- $tag = $self->dbTagAdd(%opts);
- } else {
- $self->dbTagEdit($tag, %opts, upddate => $frm->{state} == 2 && $t->{state} != 2);
- _set_childs_cat($self, $tag, $frm->{cat}) if $frm->{catrec};
- }
- $self->dbTagMerge($tag, @merge) if $self->authCan('tagmod') && @merge;
- $self->resRedirect("/g$tag", 'post');
- return;
- }
- }
-
- if($tag) {
- $frm->{$_} ||= $t->{$_} for (qw|name meta description state cat|);
- $frm->{alias} ||= join "\n", @{$t->{aliases}};
- $frm->{parents} ||= join ', ', map $_->{name}, @{$t->{parents}};
- }
-
- my $title = $par ? "Add child tag to $par->{name}" : $tag ? "Edit tag: $t->{name}" : 'Add new tag';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('g', $par || $t, 'edit') if $t || $par;
-
- if(!$self->authCan('tagmod')) {
- div class => 'mainbox';
- h1 'Requesting new tag';
- div class => 'notice';
- h2 'Your tag must be approved';
- p;
- txt 'Because all tags have to be approved by moderators, it can take a while before it will show up in the tag list'
- .' or on visual novel pages. You can still vote on tag even if it has not been approved yet, though.';
- br; br;
- txt 'Also, make sure you\'ve read the ';
- a href => '/d10', 'guidelines';
- txt ' so you can predict whether your tag will be accepted or not.';
- end;
- end;
- end;
- }
-
- $self->htmlForm({ frm => $frm, action => $par ? "/g$par->{id}/add" : $tag ? "/g$tag/edit" : '/g/new' }, 'tagedit' => [ $title,
- [ input => short => 'name', name => 'Primary name' ],
- $self->authCan('tagmod') ? (
- $tag ?
- [ static => label => 'Added by', content => fmtuser($t->{addedby}, $t->{username}) ] : (),
- [ select => short => 'state', name => 'State', options => [
- [0, 'Awaiting moderation'], [1, 'Deleted/hidden'], [2, 'Approved'] ] ],
- [ checkbox => short => 'meta', name => 'This is a meta-tag (only to be used as parent for other tags, not for linking to VN entries)' ],
- $tag ?
- [ static => content => 'WARNING: Checking this option or selecting "Deleted" as state will permanently delete all existing VN relations!' ] : (),
- ) : (),
- [ select => short => 'cat', name => 'Category', options => [
- map [$_, $self->{tag_categories}{$_}], keys %{$self->{tag_categories}} ] ],
- $self->authCan('tagmod') && $tag ? (
- [ checkbox => short => 'catrec', name => 'Also edit all child tags to have this category' ],
- [ static => content => 'WARNING: This will overwrite the category field for all child tags, this action can not be reverted!' ],
- ) : (),
- [ textarea => short => 'alias', name => "Aliases\n(separated by newlines)", cols => 30, rows => 4 ],
- [ textarea => short => 'description', name => 'Description' ],
- [ static => content => 'What should the tag be used for? Having a good description helps users choose which tags to link to a VN.' ],
- [ input => short => 'parents', name => 'Parent tags' ],
- [ static => content => 'Comma separated list of tag names to be used as parent for this tag.' ],
- $self->authCan('tagmod') ? (
- [ part => title => 'Merge tags' ],
- [ input => short => 'merge', name => 'Tags to merge' ],
- [ static => content =>
- 'Comma separated list of tag names to merge into this one.'
- .' All votes and aliases/names will be moved over to this tag, and the old tags will be deleted.'
- .' Just leave this field empty if you don\'t intend to do a merge.'
- .'<br />WARNING: this action cannot be undone!' ],
- ) : (),
- ]);
- $self->htmlFooter;
-}
-
-# recursively edit all child tags and set the category field
-# Note: this can be done more efficiently by doing everything in one UPDATE
-# query, but that takes more code and this feature isn't used very often
-# anyway.
-sub _set_childs_cat {
- my($self, $tag, $cat) = @_;
- my %done;
-
- my $e;
- $e = sub {
- my $l = shift;
- for (@$l) {
- $self->dbTagEdit($_->{id}, cat => $cat) if !$done{$_->{id}}++;
- $e->($_->{sub}) if $_->{sub};
- }
- };
-
- my $childs = $self->dbTTTree(tag => $tag, 25);
- $e->($childs);
-}
-
-
-sub taglist {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 's', required => 0, default => 'name', enum => ['added', 'name'] },
- { get => 'o', required => 0, default => 'a', enum => ['a', 'd'] },
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 't', required => 0, default => -1, enum => [ -1..2 ] },
- { get => 'q', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my($t, $np) = $self->dbTagGet(
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- page => $f->{p},
- results => 50,
- state => $f->{t},
- search => $f->{q}
- );
-
- $self->htmlHeader(title => 'Browse tags');
- div class => 'mainbox';
- h1 'Browse tags';
- form action => '/g/list', 'accept-charset' => 'UTF-8', method => 'get';
- input type => 'hidden', name => 't', value => $f->{t};
- $self->htmlSearchBox('g', $f->{q});
- end;
- p class => 'browseopts';
- a href => "/g/list?q=$f->{q};t=-1", $f->{t} == -1 ? (class => 'optselected') : (), 'All';
- a href => "/g/list?q=$f->{q};t=0", $f->{t} == 0 ? (class => 'optselected') : (), 'Awaiting moderation';
- a href => "/g/list?q=$f->{q};t=1", $f->{t} == 1 ? (class => 'optselected') : (), 'Deleted';
- a href => "/g/list?q=$f->{q};t=2", $f->{t} == 2 ? (class => 'optselected') : (), 'Accepted';
- end;
- if(!@$t) {
- p 'No results found';
- }
- end 'div';
- if(@$t) {
- $self->htmlBrowse(
- class => 'taglist',
- options => $f,
- nextpage => $np,
- items => $t,
- pageurl => "/g/list?t=$f->{t};q=$f->{q};s=$f->{s};o=$f->{o}",
- sorturl => "/g/list?t=$f->{t};q=$f->{q}",
- header => [
- [ 'Created', 'added' ],
- [ 'Tag', 'name' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1', fmtage $l->{added};
- td class => 'tc3';
- a href => "/g$l->{id}", $l->{name};
- if($f->{t} == -1) {
- b class => 'grayedout', ' awaiting moderation' if $l->{state} == 0;
- b class => 'grayedout', ' deleted' if $l->{state} == 1;
- }
- end;
- end 'tr';
- }
- );
- }
- $self->htmlFooter;
-}
-
-
-sub taglinks {
- my $self = shift;
-
- 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 tag|] },
- { get => 'v', required => 0, default => 0, template => 'id' },
- { get => 'u', required => 0, default => 0, template => 'id' },
- { get => 't', required => 0, default => 0, template => 'id' },
- );
- return $self->resNotFound if $f->{_err} || $f->{p} > 100;
-
- my($list, $np) = $self->dbTagLinks(
- what => 'details',
- results => 50,
- page => $f->{p},
- sort => $f->{s},
- reverse => $f->{o} eq 'd',
- $f->{v} ? (vid => $f->{v}) : (),
- $f->{u} ? (uid => $f->{u}) : (),
- $f->{t} ? (tag => $f->{t}) : (),
- );
-
- my $url = sub {
- my %f = ((map +($_,$f->{$_}), qw|s o v u t|), @_);
- my $qs = join ';', map $f{$_}?"$_=$f{$_}":(), keys %f;
- return '/g/links'.($qs?"?$qs":'')
- };
-
- $self->htmlHeader(noindex => 1, title => 'Tag link browser');
- div class => 'mainbox';
- h1 'Tag link browser';
-
- div class => 'warning';
- h2 'Spoiler warning';
- p 'This list displays the tag votes of individual users. Spoilery tags are not hidden, and may not even be correctly flagged as such.';
- end;
- br;
-
- if($f->{u} || $f->{t} || $f->{v}) {
- p 'Active filters:';
- ul;
- if($f->{u}) {
- my $o = $self->dbUserGet(uid => $f->{u})->[0];
- li;
- txt '['; a href => $url->(u=>0), 'remove'; txt '] ';
- txt 'User:'; txt ' ';
- a href => "/u$o->{id}", $o->{username};
- end;
- }
- if($f->{t}) {
- my $o = $self->dbTagGet(id => $f->{t})->[0];
- li;
- txt '['; a href => $url->(t=>0), 'remove'; txt '] ';
- txt 'Tag:'; txt ' ';
- a href => "/g$o->{id}", $o->{name};
- end;
- }
- if($f->{v}) {
- my $o = $self->dbVNGet(id => $f->{v})->[0];
- li;
- txt '['; a href => $url->(v=>0), 'remove'; txt '] ';
- txt 'Visual novel:'; txt ' ';
- a href => "/v$o->{id}", $o->{title};
- end;
- }
- end 'ul';
- }
- p 'Click the arrow beside a user, tag or VN to add it as a filter.' unless $f->{v} && $f->{u} && $f->{t};
- end 'div';
-
- $self->htmlBrowse(
- class => 'taglinks',
- options => $f,
- nextpage => $np,
- items => $list,
- pageurl => $url->(),
- sorturl => $url->(s=>0,o=>0),
- header => [
- [ 'Date', 'date' ],
- [ 'User' ],
- [ 'Rating' ],
- [ 'Tag', 'tag' ],
- [ 'Spoiler' ],
- [ 'Visual novel' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1', fmtdate $l->{date};
- td class => 'tc2';
- a href => $url->(u=>$l->{uid}), class => 'setfil', '> ' if !$f->{u};
- a href => "/u$l->{uid}", $l->{username};
- end;
- td class => 'tc3'.($l->{ignore}?' ignored':'');
- tagscore $l->{vote};
- end;
- td class => 'tc4';
- a href => $url->(t=>$l->{tag}), class => 'setfil', '> ' if !$f->{t};
- a href => "/g$l->{tag}", $l->{name};
- end;
- td class => 'tc5', !defined $l->{spoiler} ? ' ' : fmtspoil $l->{spoiler};
- td class => 'tc6';
- a href => $url->(v=>$l->{vid}), class => 'setfil', '> ' if !$f->{v};
- a href => "/v$l->{vid}", shorten $l->{title}, 50;
- end;
- end;
- },
- );
- $self->htmlFooter;
-}
-
-
-sub vntagmod {
- my($self, $vid) = @_;
-
- my $v = $self->dbVNGet(id => $vid)->[0];
- return $self->resNotFound if !$v || $v->{hidden};
-
- return $self->htmlDenied if !$self->authCan('tag');
-
- my $tags = $self->dbTagStats(vid => $vid, results => 9999);
- my $my = $self->dbTagLinks(vid => $vid, uid => $self->authInfo->{id});
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- my $frm = $self->formValidate(
- { post => 'taglinks', required => 0, default => '', maxlength => 10240, regex => [ qr/^[1-9][0-9]*,-?[1-3],-?[0-2]( [1-9][0-9]*,-?[1-3],-?[0-2])*$/, 'meh' ] },
- { post => 'overrule', required => 0, multi => 1, template => 'id' },
- );
- return $self->resNotFound if $frm->{_err};
-
- # convert some data in a more convenient structure for faster lookup
- my %tags = map +($_->{id} => $_), @$tags;
- my %old = map +($_->{tag} => $_), @$my;
- my %new = map { my($tag, $vote, $spoiler) = split /,/; ($tag => [ $vote, $spoiler ]) } split / /, $frm->{taglinks};
- my %over = !$self->authCan('tagmod') || !$frm->{overrule}[0] ? () : (map $new{$_} ? ($_ => 1) : (), @{$frm->{overrule}});
-
- # hashes which need to be filled, indicating what should be changed to the DB
- my %delete; # tag => 1
- my %update; # tag => [ vote, spoiler ] (ignore flag is untouched)
- my %insert; # tag => [ vote, spoiler, ignore ]
- my %overrule; # tag => 0/1
-
- for my $t (keys %old, keys %new) {
- my $prev_over = $old{$t} && !$old{$t}{ignore} && $tags{$t}{overruled};
-
- # overrule checkbox has changed? make sure to (de-)overrule the tag votes
- $overrule{$t} = $over{$t}?1:0 if (!$prev_over && $over{$t}) || ($prev_over && !$over{$t});
-
- # tag deleted?
- if($old{$t} && !$new{$t}) {
- $delete{$t} = 1;
- next;
- }
-
- # and insert or update the vote
- if(!$old{$t} && $new{$t}) {
- # determine whether this vote is going to be ignored or not
- my $ign = $tags{$t}{overruled} && !$prev_over && !$over{$t};
- $insert{$t} = [ $new{$t}[0], $new{$t}[1], $ign ];
- } elsif($old{$t}{vote} != $new{$t}[0] || (defined $old{$t}{spoiler} ? $old{$t}{spoiler} : -1) != $new{$t}[1]) {
- $update{$t} = [ $new{$t}[0], $new{$t}[1] ];
- }
- }
- # remove tags in the deleted state.
- delete $insert{$_->{id}} for(keys %insert ? @{$self->dbTagGet(id => [ keys %insert ], state => 1)} : ());
-
- $self->dbTagLinkEdit($self->authInfo->{id}, $vid, \%insert, \%update, \%delete, \%overrule);
-
- # need to re-fetch the tags and tag links, as these have been modified
- $tags = $self->dbTagStats(vid => $vid, results => 9999);
- $my = $self->dbTagLinks(vid => $vid, uid => $self->authInfo->{id});
- }
-
-
- my $title = "Add/remove tags for $v->{title}";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('v', $v, 'tagmod');
- div class => 'mainbox';
- h1 $title;
- div class => 'notice';
- h2 'Tagging';
- ul;
- li; txt 'Make sure you have read the '; a href => '/d10', 'guidelines'; txt '!'; end;
- li 'Don\'t forget to hit the submit button on the bottom of the page to make your changes permanent.';
- li 'Some tag information on the site is cached, it can take up to an hour for your changes to be visible everywhere.';
- end;
- end;
- end 'div';
- $self->htmlForm({ action => "/v$vid/tagmod", nosubmit => 1 }, tagmod => [ 'Tags',
- [ hidden => short => 'taglinks', value => '' ],
- [ static => nolabel => 1, content => sub {
- table class => 'tgl stripe';
- thead;
- Tr;
- td '';
- td colspan => $self->authCan('tagmod') ? 3 : 2, class => 'tc_you', 'You';
- td colspan => 3, class => 'tc_others', 'Others';
- end;
- Tr;
- td class => 'tc_tagname', 'Tag';
- td class => 'tc_myvote', 'Rating';
- td class => 'tc_myover', 'O' if $self->authCan('tagmod');
- td class => 'tc_myspoil', 'Spoiler';
- td class => 'tc_allvote', 'Rating';
- td class => 'tc_allspoil', 'Spoiler';
- td class => 'tc_allwho', '';
- end;
- end 'thead';
- tfoot; Tr;
- td colspan => 6;
- input type => 'submit', class => 'submit', value => 'Save changes', style => 'float: right';
- input id => 'tagmod_tag', type => 'text', class => 'text', value => '';
- input id => 'tagmod_add', type => 'button', class => 'submit', value => 'Add tag';
- br;
- p;
- txt 'Check the '; a href => '/g', 'tag list'; txt ' to browse all available tags.';
- br;
- txt 'Can\'t find what you\'re looking for? '; a href => '/g/new', 'Request a new tag'; txt '.';
- end;
- end;
- end; end 'tfoot';
- tbody id => 'tagtable';
- _tagmod_list($self, $vid, $tags, $my);
- end 'tbody';
- end 'table';
- } ],
- ]);
- $self->htmlFooter;
-}
-
-sub _tagmod_list {
- my($self, $vid, $tags, $my) = @_;
-
- my %my = map +($_->{tag} => $_), @$my;
-
- for my $cat (keys %{$self->{tag_categories}}) {
- my @tags = grep $_->{cat} eq $cat, @$tags;
- next if !@tags;
- Tr class => 'tagmod_cat';
- td colspan => 7, $self->{tag_categories}{$cat};
- end;
- for my $t (@tags) {
- my $m = $my{$t->{id}};
- Tr id => "tgl_$t->{id}";
- td class => 'tc_tagname'; a href => "/g$t->{id}", $t->{name}; end;
- td class => 'tc_myvote', $m->{vote}||0;
- if($self->authCan('tagmod')) {
- td class => 'tc_myover';
- input type => 'checkbox', name => 'overrule', value => $t->{id},
- $m->{vote} && !$m->{ignore} && $t->{overruled} ? (checked => 'checked') : ()
- if $t->{cnt} > 1;
- end;
- }
- td class => 'tc_myspoil', defined $m->{spoiler} ? $m->{spoiler} : -1;
- td class => 'tc_allvote';
- tagscore $t->{rating};
- i $t->{overruled} ? (class => 'grayedout') : (), " ($t->{cnt})";
- b class => 'standout', style => 'font-weight: bold', title => 'Tag overruled. All votes other than that of the moderator who overruled it will be ignored.', ' !' if $t->{overruled};
- end;
- td class => 'tc_allspoil', sprintf '%.2f', $t->{spoiler};
- td class => 'tc_allwho';
- a href => "/g/links?v=$vid;t=$t->{id}", 'Who?';
- end;
- end;
- }
- }
-}
-
-
-sub tagindex {
- my $self = shift;
-
- $self->htmlHeader(title => 'Tag index');
- div class => 'mainbox';
- a class => 'addnew', href => "/g/new", 'Create new tag' if $self->authCan('tag');
- h1 'Search tags';
- form action => '/g/list', 'accept-charset' => 'UTF-8', method => 'get';
- $self->htmlSearchBox('g', '');
- end;
- end;
-
- my $t = $self->dbTTTree(tag => 0, 2);
- childtags($self, 'Tag tree', 'g', {childs => $t});
-
- table class => 'mainbox threelayout';
- Tr;
-
- # Recently added
- td;
- a class => 'right', href => '/g/list', 'Browse all tags';
- my $r = $self->dbTagGet(sort => 'added', reverse => 1, results => 10, state => 2);
- h1 'Recently added';
- ul;
- for (@$r) {
- li;
- txt fmtage $_->{added};
- txt ' ';
- a href => "/g$_->{id}", $_->{name};
- end;
- }
- end;
- end;
-
- # Popular
- td;
- a class => 'addnew', href => "/g/links", 'Recently tagged';
- $r = $self->dbTagGet(sort => 'items', reverse => 1, meta => 0, results => 10);
- h1 'Popular tags';
- ul;
- for (@$r) {
- li;
- a href => "/g$_->{id}", $_->{name};
- txt " ($_->{c_items})";
- end;
- }
- end;
- end;
-
- # Moderation queue
- td;
- h1 'Awaiting moderation';
- $r = $self->dbTagGet(state => 0, sort => 'added', reverse => 1, results => 10);
- ul;
- li 'Moderation queue empty! yay!' if !@$r;
- for (@$r) {
- li;
- txt fmtage $_->{added};
- txt ' ';
- a href => "/g$_->{id}", $_->{name};
- end;
- }
- li;
- br;
- a href => '/g/list?t=0;o=d;s=added', 'Moderation queue';
- txt ' - ';
- a href => '/g/list?t=1;o=d;s=added', 'Denied tags';
- end;
- end;
- end;
-
- end 'tr';
- end 'table';
- $self->htmlFooter;
-}
-
-
-# non-translatable debug page
-sub fulltree {
- my $self = shift;
- return $self->htmlDenied if !$self->authCan('tagmod');
-
- my $e;
- $e = sub {
- my $lst = shift;
- ul style => 'list-style-type: none; margin-left: 15px';
- for (@$lst) {
- li;
- txt '> ';
- a href => "/g$_->{id}", $_->{name};
- b class => 'grayedout', " ($_->{c_items})" if $_->{c_items};
- end;
- $e->($_->{sub}) if $_->{sub};
- }
- end;
- };
-
- my $tags = $self->dbTTTree(tag => 0, 25);
- $self->htmlHeader(title => '[DEBUG] Tag tree', noindex => 1);
- div class => 'mainbox';
- h1 '[DEBUG] Tag tree';
- $e->($tags);
- end;
- $self->htmlFooter;
-}
-
-
-sub tagxml {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 'q', required => 0, maxlength => 500 },
- { get => 'id', required => 0, multi => 1, template => 'id' },
- );
- return $self->resNotFound if $f->{_err} || (!$f->{q} && !$f->{id} && !$f->{id}[0]);
-
- my($list, $np) = $self->dbTagGet(
- !$f->{q} ? () : $f->{q} =~ /^g([1-9]\d*)/ ? (id => $1) : $f->{q} =~ /^=(.+)$/ ? (name => $1) : (search => $f->{q}, sort => 'search'),
- $f->{id} && $f->{id}[0] ? (id => $f->{id}) : (),
- results => 15,
- page => 1,
- );
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'tags', more => $np ? 'yes' : 'no', $f->{q} ? (query => $f->{q}) : ();
- for(@$list) {
- tag 'item', id => $_->{id}, meta => $_->{meta} ? 'yes' : 'no', state => $_->{state}, $_->{name};
- }
- end;
-}
-
-
-1;
diff --git a/lib/VNDB/Handler/Traits.pm b/lib/VNDB/Handler/Traits.pm
deleted file mode 100644
index 41057c44..00000000
--- a/lib/VNDB/Handler/Traits.pm
+++ /dev/null
@@ -1,432 +0,0 @@
-
-package VNDB::Handler::Traits;
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml', 'html_escape', 'xml_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{i([1-9]\d*)}, \&traitpage,
- qr{i([1-9]\d*)/(edit)}, \&traitedit,
- qr{i([1-9]\d*)/(add)}, \&traitedit,
- qr{i/new}, \&traitedit,
- qr{i/list}, \&traitlist,
- qr{i}, \&traitindex,
- qr{xml/traits\.xml}, \&traitxml,
-);
-
-
-sub traitpage {
- my($self, $trait) = @_;
-
- my $t = $self->dbTraitGet(id => $trait, what => 'parents(0) childs(2)')->[0];
- return $self->resNotFound if !$t;
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'm', required => 0, default => $self->authPref('spoilers')||0, enum => [qw|0 1 2|] },
- { get => 'fil', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my $title = sprintf '%s: %s', $t->{meta} ? 'Meta trait' : 'Trait', $t->{name};
- $self->htmlHeader(title => $title, noindex => $t->{state} != 2);
- $self->htmlMainTabs('i', $t);
-
- if($t->{state} != 2) {
- div class => 'mainbox';
- h1 $title;
- if($t->{state} == 1) {
- div class => 'warning';
- h2 'Trait deleted';
- p;
- txt 'This trait has been removed from the database, and cannot be used or re-added. File a request on the ';
- a href => '/t/db', 'discussion board';
- txt ' if you disagree with this.';
- end;
- end;
- } else {
- div class => 'notice';
- h2 'Waiting for approval';
- p 'This trait is waiting for a moderator to approve it.';
- end;
- }
- end 'div';
- }
-
- div class => 'mainbox';
- a class => 'addnew', href => "/i$trait/add", 'Create child trait' if $self->authCan('edit') && $t->{state} != 1;
- h1 $title;
-
- parenttags($t, 'Traits', 'i');
-
- if($t->{description}) {
- p class => 'description';
- lit bb2html $t->{description};
- end;
- }
- if($t->{sexual}) {
- p class => 'center';
- b 'Sexual content';
- end;
- }
- if($t->{alias}) {
- p class => 'center';
- b 'Aliases';
- br;
- lit html_escape($t->{alias});
- end;
- }
- end 'div';
-
- childtags($self, 'Child traits', 'i', $t) if @{$t->{childs}};
-
- if(!$t->{meta} && $t->{state} == 2) {
- my($chars, $np) = $self->filFetchDB(char => $f->{fil}, {}, {
- trait_inc => $trait,
- tagspoil => $f->{m},
- results => 50,
- page => $f->{p},
- what => 'vns',
- });
-
- form action => "/i$t->{id}", 'accept-charset' => 'UTF-8', method => 'get';
- div class => 'mainbox';
- h1 'Characters';
-
- p class => 'browseopts';
- a href => "/i$trait?m=0", $f->{m} == 0 ? (class => 'optselected') : (), 'Hide spoilers';
- a href => "/i$trait?m=1", $f->{m} == 1 ? (class => 'optselected') : (), 'Show minor spoilers';
- a href => "/i$trait?m=2", $f->{m} == 2 ? (class => 'optselected') : (), 'Spoil me!';
- end;
-
- p class => 'filselect';
- a id => 'filselect', href => '#c';
- lit '<i>&#9656;</i> Filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => 'fil', id => 'fil', value => $f->{fil};
-
- if(!@$chars) {
- p; br; br; txt 'This trait has not been linked to any characters yet, or they were hidden because of your spoiler settings.'; end;
- }
- p; br; txt 'The list below also includes all characters linked to child traits. This list is cached, it can take up to 24 hours after a character has been edited for it to show up on this page.'; end;
- end 'div';
- end 'form';
- @$chars && $self->charBrowseTable($chars, $np, $f, "/i$trait?m=$f->{m};fil=$f->{fil}");
- }
-
- $self->htmlFooter;
-}
-
-
-sub traitedit {
- my($self, $trait, $act) = @_;
-
- my($frm, $par);
- if($act && $act eq 'add') {
- $par = $self->dbTraitGet(id => $trait)->[0];
- return $self->resNotFound if !$par;
- $frm->{parents} = $par->{id};
- $trait = undef;
- }
-
- return $self->htmlDenied if !$self->authCan('edit') || $trait && !$self->authCan('tagmod');
-
- my $t = $trait && $self->dbTraitGet(id => $trait, what => 'parents(1) addedby')->[0];
- return $self->resNotFound if $trait && !$t;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'name', required => 1, maxlength => 250, regex => [ qr/^[^,]+$/, 'A comma is not allowed in trait names' ] },
- { post => 'state', required => 0, default => 0, enum => [ 0..2 ] },
- { post => 'meta', required => 0, default => 0 },
- { post => 'sexual', required => 0, default => 0 },
- { post => 'alias', required => 0, maxlength => 1024, default => '', regex => [ qr/^[^,]+$/s, 'No comma allowed in aliases' ] },
- { post => 'description', required => 0, maxlength => 10240, default => '' },
- { post => 'parents', required => !$self->authCan('tagmod'), default => '', regex => [ qr/^(?:$|(?:[1-9]\d*)(?: +[1-9]\d*)*)$/, 'Parent traits must be a space-separated list of trait IDs' ] },
- { post => 'order', required => 0, default => 0, template => 'uint' },
- );
- my @parents = split /[\t ]+/, $frm->{parents};
- my $group = undef;
- if(!$frm->{_err}) {
- for(@parents) {
- my $c = $self->dbTraitGet(id => $_);
- push @{$frm->{_err}}, "Trait '$_' not found" if !@$c;
- $group //= $c->[0]{group}||$c->[0]{id} if @$c;
- }
- }
- if(!$frm->{_err}) {
- my @dups = @{$self->dbTraitGet(name => $frm->{name}, noid => $trait, group => $group)};
- push @dups, @{$self->dbTraitGet(name => $_, noid => $trait, group => $group)} for split /[\t\s]*\n[\t\s]*/, $frm->{alias};
- push @{$frm->{_err}}, \sprintf 'Trait <a href="/c%d">%s</a> already exists within the same group.', $_->{id}, xml_escape $_->{name} for @dups;
- }
-
- if(!$frm->{_err}) {
- $frm->{state} = $frm->{meta} = 0 if !$self->authCan('tagmod');
- my %opts = (
- name => $frm->{name},
- state => $frm->{state},
- description => $frm->{description},
- meta => $frm->{meta}?1:0,
- sexual => $frm->{sexual}?1:0,
- alias => $frm->{alias},
- order => $frm->{order},
- parents => \@parents,
- group => $group,
- );
- if(!$trait) {
- $trait = $self->dbTraitAdd(%opts);
- } else {
- $self->dbTraitEdit($trait, %opts, upddate => $frm->{state} == 2 && $t->{state} != 2) if $trait;
- _set_childs_group($self, $trait, $group||$trait) if ($group||0) != ($t->{group}||0);
- }
- $self->resRedirect("/i$trait", 'post');
- return;
- }
- }
-
- if($t) {
- $frm->{$_} ||= $t->{$_} for (qw|name meta sexual description state alias order|);
- $frm->{parents} ||= join ' ', map $_->{id}, @{$t->{parents}};
- }
-
- my $title = $par ? "Add child trait to $par->{name}" : $t ? "Edit trait: $t->{name}" : 'Add new trait';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('i', $par || $t, 'edit') if $t || $par;
-
- if(!$self->authCan('tagmod')) {
- div class => 'mainbox';
- h1 'Requesting new trait';
- div class => 'notice';
- h2 'Your trait must be approved';
- p;
- lit 'Because all traits have to be approved by moderators, it can take a while before your trait will show up in the listings or can be used on character entries.';
- end;
- end;
- end;
- }
-
- $self->htmlForm({ frm => $frm, action => $par ? "/i$par->{id}/add" : $t ? "/i$trait/edit" : '/i/new' }, 'traitedit' => [ $title,
- [ input => short => 'name', name => 'Primary name' ],
- $self->authCan('tagmod') ? (
- $t ?
- [ static => label => 'Added by', content => fmtuser($t->{addedby}, $t->{username}) ] : (),
- [ select => short => 'state', name => 'State', options => [
- [0,'Awaiting moderation'], [1,'Deleted/hidden'], [2,'Approved'] ] ],
- [ checkbox => short => 'meta', name => 'This is a meta trait (only to be used as parent for other traits, not for direct use with characters)' ]
- ) : (),
- [ checkbox => short => 'sexual', name => 'Indicates sexual content' ],
- [ textarea => short => 'alias', name => "Aliases\n(Separated by newlines)", cols => 30, rows => 4 ],
- [ textarea => short => 'description', name => 'Description' ],
- [ input => short => 'parents', name => 'Parent traits' ],
- [ static => content => 'List of trait IDs to be used as parent for this trait, separated by a space.' ],
- $self->authCan('tagmod') ? (
- [ input => short => 'order', name => 'Group number', width => 50, post => ' (Only used if this trait is a group. Used for ordering, lowest first)' ],
- ) : (),
- ]);
-
- $self->htmlFooter;
-}
-
-# recursively edit all child traits and set the group field
-sub _set_childs_group {
- my($self, $trait, $group) = @_;
- my %done;
-
- my $e;
- $e = sub {
- my $l = shift;
- for (@$l) {
- $self->dbTraitEdit($_->{id}, group => $group) if !$done{$_->{id}}++;
- $e->($_->{sub}) if $_->{sub};
- }
- };
- $e->($self->dbTTTree(trait => $trait, 25));
-}
-
-
-sub traitlist {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 's', required => 0, default => 'name', enum => ['added', 'name'] },
- { get => 'o', required => 0, default => 'a', enum => ['a', 'd'] },
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 't', required => 0, default => -1, enum => [ -1..2 ] },
- { get => 'q', required => 0, default => '' },
- );
- return $self->resNotFound if $f->{_err};
-
- my($t, $np) = $self->dbTraitGet(
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- page => $f->{p},
- results => 50,
- state => $f->{t},
- search => $f->{q}
- );
-
- $self->htmlHeader(title => 'Browse traits');
- div class => 'mainbox';
- h1 'Browse traits';
- form action => '/i/list', 'accept-charset' => 'UTF-8', method => 'get';
- input type => 'hidden', name => 't', value => $f->{t};
- $self->htmlSearchBox('i', $f->{q});
- end;
- p class => 'browseopts';
- a href => "/i/list?q=$f->{q};t=-1", $f->{t} == -1 ? (class => 'optselected') : (), 'All';
- a href => "/i/list?q=$f->{q};t=0", $f->{t} == 0 ? (class => 'optselected') : (), 'Awaiting moderation';
- a href => "/i/list?q=$f->{q};t=1", $f->{t} == 1 ? (class => 'optselected') : (), 'Deleted';
- a href => "/i/list?q=$f->{q};t=2", $f->{t} == 2 ? (class => 'optselected') : (), 'Accepted';
- end;
- if(!@$t) {
- p 'No results found';
- }
- end 'div';
- if(@$t) {
- $self->htmlBrowse(
- class => 'taglist',
- options => $f,
- nextpage => $np,
- items => $t,
- pageurl => "/i/list?t=$f->{t};q=$f->{q};s=$f->{s};o=$f->{o}",
- sorturl => "/i/list?t=$f->{t};q=$f->{q}",
- header => [
- [ 'Created', 'added' ],
- [ 'Trait', 'name' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1', fmtage $l->{added};
- td class => 'tc3';
- if($l->{group}) {
- b class => 'grayedout', $l->{groupname}.' / ';
- }
- a href => "/i$l->{id}", $l->{name};
- if($f->{t} == -1) {
- b class => 'grayedout', ' awaiting moderation' if $l->{state} == 0;
- b class => 'grayedout', ' deleted' if $l->{state} == 1;
- }
- end;
- end 'tr';
- }
- );
- }
- $self->htmlFooter;
-}
-
-
-sub traitindex {
- my $self = shift;
-
- $self->htmlHeader(title => 'Trait index');
- div class => 'mainbox';
- a class => 'addnew', href => "/i/new", 'Create new trait' if $self->authCan('edit');
- h1 'Search traits';
- form action => '/i/list', 'accept-charset' => 'UTF-8', method => 'get';
- $self->htmlSearchBox('i', '');
- end;
- end;
-
- my $t = $self->dbTTTree(trait => 0, 2);
- childtags($self, 'Trait tree', 'i', {childs => $t}, 'order');
-
- table class => 'mainbox threelayout';
- Tr;
-
- # Recently added
- td;
- a class => 'right', href => '/i/list', 'Browse all traits';
- my $r = $self->dbTraitGet(sort => 'added', reverse => 1, results => 10);
- h1 'Recently added';
- ul;
- for (@$r) {
- li;
- txt fmtage $_->{added};
- txt ' ';
- b class => 'grayedout', $_->{groupname}.' / ' if $_->{group};
- a href => "/i$_->{id}", $_->{name};
- end;
- }
- end;
- end;
-
- # Popular
- td;
- h1 'Popular traits';
- ul;
- $r = $self->dbTraitGet(sort => 'items', reverse => 1, results => 10);
- for (@$r) {
- li;
- b class => 'grayedout', $_->{groupname}.' / ' if $_->{group};
- a href => "/i$_->{id}", $_->{name};
- txt " ($_->{c_items})";
- end;
- }
- end;
- end;
-
- # Moderation queue
- td;
- h1 'Awaiting moderation';
- $r = $self->dbTraitGet(state => 0, sort => 'added', reverse => 1, results => 10);
- ul;
- li 'Moderation queue empty! yay!' if !@$r;
- for (@$r) {
- li;
- txt fmtage $_->{added};
- txt ' ';
- b class => 'grayedout', $_->{groupname}.' / ' if $_->{group};
- a href => "/i$_->{id}", $_->{name};
- end;
- }
- li;
- br;
- a href => '/i/list?t=0;o=d;s=added', 'Moderation queue';
- txt ' - ';
- a href => '/i/list?t=1;o=d;s=added', 'Denied traits';
- end;
- end;
- end;
-
- end 'tr';
- end 'table';
- $self->htmlFooter;
-}
-
-
-sub traitxml {
- my $self = shift;
-
- my $f = $self->formValidate(
- { get => 'q', required => 0, maxlength => 500 },
- { get => 'id', required => 0, multi => 1, template => 'id' },
- { get => 'r', required => 0, default => 15, template => 'uint', min => 1, max => 200 },
- );
- return $self->resNotFound if $f->{_err} || (!$f->{q} && !$f->{id} && !$f->{id}[0]);
-
- my($list, $np) = $self->dbTraitGet(
- results => $f->{r},
- page => 1,
- sort => 'group',
- state => 2,
- !$f->{q} ? () : $f->{q} =~ /^i([1-9]\d*)/ ? (id => $1) : (search => $f->{q}, sort => 'search'),
- $f->{id} && $f->{id}[0] ? (id => $f->{id}) : (),
- );
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'traits', more => $np ? 'yes' : 'no';
- for(@$list) {
- tag 'item', id => $_->{id}, meta => $_->{meta} ? 'yes' : 'no', group => $_->{group}||'', groupname => $_->{groupname}||'', state => $_->{state}, $_->{name};
- }
- end;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/ULists.pm b/lib/VNDB/Handler/ULists.pm
deleted file mode 100644
index f30397b7..00000000
--- a/lib/VNDB/Handler/ULists.pm
+++ /dev/null
@@ -1,522 +0,0 @@
-
-package VNDB::Handler::ULists;
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml';
-use VNDB::Func;
-
-
-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..$#{$self->{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..$#{$self->{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) = @_;
-
- my $rid = $id;
- if(!$rid) {
- my $f = $self->formValidate({ get => 'id', required => 1, template => 'id' });
- return $self->resNotFound if $f->{_err};
- $rid = $f->{id};
- }
-
- my $uid = $self->authInfo->{id};
- return $self->htmlDenied() if !$uid;
-
- return if !$self->authCheckCode;
- my $f = $self->formValidate(
- { get => 'e', required => 1, enum => [ -1..$#{$self->{rlist_status}} ] },
- { get => 'ref', required => 0, default => "/r$rid" }
- );
- return $self->resNotFound if $f->{_err};
-
- $self->dbRListDel($uid, $rid) if $f->{e} == -1;
- $self->dbRListAdd($uid, $rid, $f->{e}) if $f->{e} >= 0;
-
- if($id) {
- $self->resRedirect($f->{ref}, 'temp');
- } else {
- # doesn't really matter what we return, as long as it's XML
- $self->resHeader('Content-type' => 'text/xml');
- xml;
- tag 'done', '';
- }
-}
-
-
-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 => 'batchedit', required => 1, enum => [ -2, -1, 1..10 ] },
- );
- my @vid = grep $_ && $_ > 0, @{$frm->{vid}};
- if(!$frm->{_err} && @vid && $frm->{batchedit} > -2) {
- $self->dbVoteDel($id, \@vid) if $frm->{batchedit} == -1;
- $self->dbVoteAdd(\@vid, $id, $frm->{batchedit}*10) if $frm->{batchedit} > 0;
- }
- }
-
- my($list, $np) = $self->dbVoteGet(
- $type.'id' => $id,
- what => $type eq 'v' ? 'user' : 'vn',
- hide => $type eq 'v',
- 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},
- $f->{c} ne 'all' ? ($type eq 'u' ? 'vn_char' : 'user_char', $f->{c}) : (),
- );
-
- my $title = $type eq 'v' ? "Votes for $obj->{title}" : "Votes by $obj->{username}";
- $self->htmlHeader(noindex => 1, title => $title);
- $self->htmlMainTabs($type => $obj, 'votes');
- div class => 'mainbox';
- h1 $title;
- 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';
- a href => $type eq 'v' ? ("/u$l->{uid}", $l->{username}) : ("/v$l->{vid}", shorten $l->{title}, 100);
- end;
- end;
- },
- $own ? (footer => sub {
- Tr;
- td colspan => 3, class => 'tc1';
- input type => 'checkbox', class => 'checkall', name => 'vid', value => 0;
- txt ' ';
- Select name => 'batchedit', id => 'batchedit';
- option value => -2, '-- with selected --';
- optgroup label => 'Change vote';
- option value => $_, sprintf '%d (%s)', $_, fmtrating $_ for (reverse 1..10);
- 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..$#{$self->{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..$#{$self->{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' : "$u->{username}'s wishlist";
- $self->htmlHeader(title => $title, noindex => 1);
- $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' : $self->{wishlist_status}[$_]
- for (-1..$#{$self->{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', $self->{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 => $_, $self->{wishlist_status}[$_]
- for (0..$#{$self->{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..$#{$self->{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..$#{$self->{vnlist_status}}, 999 ] },
- { post => 'rel', required => 1, enum => [ -2..$#{$self->{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' : "$u->{username}'s visual novel list";
- $self->htmlHeader(title => $title, noindex => 1);
- $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') : (), $self->{vnlist_status}[$_] for 0..$#{$self->{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} ? $self->{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 $_", $self->{languages}{$_} 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} ? $self->{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 => $_, $self->{vnlist_status}[$_]
- for (0..$#{$self->{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 => $_, $self->{rlist_status}[$_]
- for (0..$#{$self->{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/Users.pm b/lib/VNDB/Handler/Users.pm
deleted file mode 100644
index d1f0df93..00000000
--- a/lib/VNDB/Handler/Users.pm
+++ /dev/null
@@ -1,825 +0,0 @@
-
-package VNDB::Handler::Users;
-
-use strict;
-use warnings;
-use TUWF ':html', 'xml_escape';
-use VNDB::Func;
-use POSIX 'floor';
-
-
-TUWF::register(
- qr{u([1-9]\d*)} => \&userpage,
- qr{u/login} => \&login,
- qr{u([1-9]\d*)/logout} => \&logout,
- qr{u/newpass} => \&newpass,
- qr{u/newpass/sent} => \&newpass_sent,
- qr{u([1-9]\d*)/setpass} => \&setpass,
- qr{u/register} => \&register,
- qr{u/register/done} => \&register_done,
- qr{u([1-9]\d*)/edit} => \&edit,
- qr{u([1-9]\d*)/posts} => \&posts,
- qr{u([1-9]\d*)/del(/[od])?} => \&delete,
- qr{u/(all|[0a-z])} => \&list,
- qr{u([1-9]\d*)/notifies} => \&notifies,
- qr{u([1-9]\d*)/notify/([1-9]\d*)} => \&readnotify,
-);
-
-
-sub userpage {
- my($self, $uid) = @_;
-
- my $u = $self->dbUserGet(uid => $uid, what => 'stats hide_list')->[0];
- return $self->resNotFound if !$u->{id};
-
- my $votes = $u->{c_votes} && $self->dbVoteStats(uid => $uid);
- my $list_visible = !$u->{hide_list} || ($self->authInfo->{id}||0) == $u->{id} || $self->authCan('usermod');
-
- my $title = "$u->{username}'s profile";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('u', $u);
- div class => 'mainbox userpage';
- h1 $title;
-
- table class => 'stripe';
-
- Tr;
- td class => 'key', 'Username';
- td;
- txt ucfirst($u->{username}).' (';
- a href => "/u$uid", "u$uid";
- txt ')';
- end;
- end;
-
- Tr;
- td 'Registered';
- td fmtdate $u->{registered};
- end;
-
- Tr;
- td 'Edits';
- td;
- if($u->{c_changes}) {
- a href => "/u$uid/hist", $u->{c_changes};
- } else {
- txt '-';
- }
- end;
- end;
-
- Tr;
- td 'Votes';
- td;
- if(!$list_visible) {
- txt 'hidden';
- } elsif($votes) {
- my($total, $count) = (0, 0);
- for (1..@$votes) {
- $count += $votes->[$_-1][0];
- $total += $votes->[$_-1][1];
- }
- a href => "/u$uid/votes", $count;
- txt sprintf ' (%.2f average)', $total/$count/10;
- } else {
- txt '-';
- }
- end;
- end;
-
- Tr;
- td 'Tags';
- td;
- if(!$u->{c_tags}) {
- txt '-';
- } else {
- txt sprintf '%d vote%s on %d distinct tag%s and %d visual novel%s. ',
- $u->{c_tags}, $u->{c_tags} == 1 ? '' : 's',
- $u->{tagcount}, $u->{tagcount} == 1 ? '' : 's',
- $u->{tagvncount}, $u->{tagvncount} == 1 ? '' : 's';
- a href => "/g/links?u=$uid"; lit 'Browse tags &raquo;'; end;
- }
- end;
- end;
-
- Tr;
- td 'List stats';
- td !$list_visible ? 'hidden' :
- sprintf '%d release%s of %d visual novel%s.',
- $u->{releasecount}, $u->{releasecount} == 1 ? '' : 's',
- $u->{vncount}, $u->{vncount} == 1 ? '' : 's';
- end;
-
- Tr;
- td 'Forum stats';
- td;
- txt sprintf '%d post%s, %d new thread%s. ',
- $u->{postcount}, $u->{postcount} == 1 ? '' : 's',
- $u->{threadcount}, $u->{threadcount} == 1 ? '' : 's';
- if($u->{postcount}) {
- a href => "/u$uid/posts"; lit 'Browse posts &raquo;'; end;
- }
- end;
- end;
- end 'table';
- end 'div';
-
- if($votes && $list_visible) {
- div class => 'mainbox';
- h1 'Vote statistics';
- $self->htmlVoteStats(u => $u, $votes);
- end;
- }
-
- if($u->{c_changes}) {
- my $list = $self->dbRevisionGet(uid => $uid, results => 5);
- h1 class => 'boxtitle';
- a href => "/u$uid/hist", 'Recent changes';
- end;
- $self->htmlBrowseHist($list, { p => 1 }, 0, "/u$uid/hist");
- }
- $self->htmlFooter;
-}
-
-
-sub login {
- my $self = shift;
-
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
-
- my $tm = $self->dbThrottleGet(norm_ip($self->reqIP));
- if($tm-time() > $self->{login_throttle}[1]) {
- $self->htmlHeader(title => 'Login');
- div class => 'mainbox';
- h1 'Login';
- div class => 'warning';
- h2 'Maximum failed login attempts reached.';
- p;
- txt 'Login has been temporarily disabled for your IP address. You can wait a few hours and try again,'
- .' or you can try from a different IP address. If you forgot your password, you can still use the ';
- a href => '/u/newpass', 'password reset';
- txt ' functionality. If you still have trouble logging in, send a mail to ';
- a href => 'mailto:contact@vndb.org', 'contact@vndb.org';
- txt '.';
- end;
- end;
- end 'div';
- $self->htmlFooter;
- return;
- }
-
- my $ref = $self->formValidate({ param => 'ref', required => 0, default => '/'})->{ref};
-
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'usrname', required => 1, minlength => 2, maxlength => 15 },
- { post => 'usrpass', required => 1, minlength => 4, maxlength => 64, template => 'ascii' },
- );
-
- if(!$frm->{_err}) {
- $frm->{usrname} = lc $frm->{usrname};
- return if $self->authLogin($frm->{usrname}, $frm->{usrpass}, $ref);
- $frm->{_err} = [ 'Invalid username or password' ];
- $self->dbThrottleSet(norm_ip($self->reqIP), $tm+$self->{login_throttle}[0]);
- }
- }
-
- $self->htmlHeader(noindex => 1, title => 'Login');
- $self->htmlForm({ frm => $frm, action => '/u/login' }, login => [ 'Login',
- [ hidden => short => 'ref', value => $ref ],
- [ input => short => 'usrname', name => 'Username' ],
- [ static => content => '<a href="/u/register">No account yet?</a>' ],
- [ passwd => short => 'usrpass', name => 'Password' ],
- [ static => content => '<a href="/u/newpass">Forgot your password?</a>' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub logout {
- my $self = shift;
- my $uid = shift;
- return $self->resNotFound if !$self->authInfo->{id} || $self->authInfo->{id} != $uid;
- $self->authLogout;
-}
-
-
-sub newpass {
- my $self = shift;
-
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
-
- my($frm, $uid, $token);
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate({ post => 'mail', template => 'email' });
- if(!$frm->{_err}) {
- ($uid, $token) = $self->authResetPass($frm->{mail});
- $frm->{_err} = [ 'No user found with that email address' ] if !$uid;
- }
- if(!$frm->{_err}) {
- my $u = $self->dbUserGet(uid => $uid)->[0];
- my $body = sprintf
- "Hello %s,\n\nYour VNDB.org login has been disabled, you can now set a new password by following the link below:\n\n"
- ."%s\n\nNow don't forget your password again! :-)\n\nvndb.org",
- $u->{username}, $self->reqBaseURI()."/u$u->{id}/setpass?t=$token";
- $self->mail($body,
- To => $frm->{mail},
- From => 'VNDB <noreply@vndb.org>',
- Subject => "Password reset for $u->{username}",
- );
- return $self->resRedirect('/u/newpass/sent', 'post');
- }
- }
-
- $self->htmlHeader(title => 'Forgot password', noindex => 1);
- div class => 'mainbox';
- h1 'Forgot password';
- p 'Forgot your password and can\'t login to VNDB anymore?'
- .' Don\'t worry! Just give us the email address you used to register on VNDB,'
- .' and we\'ll send you instructions to set a new password within a few minutes!';
- end;
- $self->htmlForm({ frm => $frm, action => '/u/newpass' }, newpass => [ 'Reset password',
- [ input => short => 'mail', name => 'Email' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub newpass_sent {
- my $self = shift;
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
- $self->htmlHeader(title => 'New password', noindex => 1);
- div class => 'mainbox';
- h1 'New password';
- div class => 'notice';
- p 'Your password has been reset and instructions to set a new one should reach your mailbox in a few minutes.';
- end;
- end;
- $self->htmlFooter;
-}
-
-
-sub setpass {
- my($self, $uid) = @_;
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
-
- my $t = $self->formValidate({get => 't', regex => qr/^[a-f0-9]{40}$/i });
- return $self->resNotFound if $t->{_err};
- $t = $t->{t};
-
- my $u = $self->dbUserGet(uid => $uid)->[0];
- return $self->resNotFound if !$u || !$self->authIsValidToken($u->{id}, $t);
-
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode("/u$u->{id}/setpass?t=$t");
- $frm = $self->formValidate(
- { post => 'usrpass', minlength => 4, maxlength => 64, template => 'ascii' },
- { post => 'usrpass2', minlength => 4, maxlength => 64, template => 'ascii' },
- );
- push @{$frm->{_err}}, 'Passwords do not match' if $frm->{usrpass} ne $frm->{usrpass2};
-
- if(!$frm->{_err}) {
- $self->dbUserEdit($uid, email_confirmed => 1);
- return $self->authSetPass($uid, $frm->{usrpass}, "/u$uid", token => $t)
- }
- }
-
- $self->htmlHeader(title => "Set password for $u->{username}", noindex => 1);
- $self->htmlForm({ frm => $frm, action => "/u$u->{id}/setpass?t=$t" }, setpass => [ "Set password for $u->{username}",
- [ static => nolabel => 1, content => 'Now you can set a password for your account.'
- .' You will be logged in automatically after your password has been saved.' ],
- [ passwd => short => 'usrpass', name => 'Password' ],
- [ passwd => short => 'usrpass2', name => 'Confirm password' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub register {
- my $self = shift;
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
-
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'usrname', template => 'uname' },
- { post => 'mail', template => 'email' },
- { post => 'type', enum => [1..3] },
- { post => 'answer', template => 'uint' },
- );
- my $num = $self->{stats}{[qw|vn releases producers|]->[ $frm->{type} - 1 ]};
- push @{$frm->{_err}}, 'Question was not correctly answered. Are you sure you are a human?'
- if !$frm->{_err} && ($frm->{answer} > $num*1.005 || $frm->{answer} < $num*0.995);
- push @{$frm->{_err}}, 'Someone already has this username, please choose another name'
- if $frm->{usrname} eq 'anonymous' || !$frm->{_err} && $self->dbUserGet(username => $frm->{usrname})->[0]{id};
- push @{$frm->{_err}}, 'Someone already registered with that email address'
- if !$frm->{_err} && $self->dbUserEmailExists($frm->{mail});
-
- # Use /32 match for IPv4 and /48 for IPv6. The /48 is fairly broad, so some
- # users may have to wait a bit before they can register...
- my $ip = $self->reqIP;
- push @{$frm->{_err}}, 'You can only register one account from the same IP within 24 hours'
- if !$frm->{_err} && $self->dbUserGet(ip => $ip =~ /:/ ? "$ip/48" : $ip, registered => time-24*3600)->[0]{id};
-
- if(!$frm->{_err}) {
- my $uid = $self->dbUserAdd($frm->{usrname}, $frm->{mail});
- my(undef, $token) = $self->authResetPass($frm->{mail});
- 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",
- $frm->{usrname}, $self->reqBaseURI()."/u$uid/setpass?t=$token";
- $self->mail($body,
- To => $frm->{mail},
- From => 'VNDB <noreply@vndb.org>',
- Subject => "Confirm registration for $frm->{usrname}",
- );
- return $self->resRedirect('/u/register/done', 'post');
- }
- }
-
- $self->htmlHeader(title => 'Create an account', noindex => 1);
-
- my $type = $frm->{type} || floor(rand 3)+1;
- $self->htmlForm({ frm => $frm, action => '/u/register' }, register => [ 'Create an account',
- [ hidden => short => 'type', value => $type ],
- [ input => short => 'usrname', name => 'Username' ],
- [ static => content => 'Preferred username. Must be lowercase and can only consist of alphanumeric characters.' ],
- [ input => short => 'mail', name => 'Email' ],
- [ static => content => 'Your email address will only be used in case you lose your password.'
- .' We will never send spam or newsletters unless you explicitly ask us for it or we get hacked.<br /><br />' ],
- [ static => content => sprintf '<br /><br />How many %s do we have in the database? (Hint: look to your left)',
- ['visual novels', 'releases', 'producers']->[$type-1] ],
- [ input => short => 'answer', name => 'Answer' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub register_done {
- my $self = shift;
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
- $self->htmlHeader(title => 'Account created', noindex => 1);
- div class => 'mainbox';
- h1 'Account created';
- div class => 'notice';
- p 'Your account has been created! In a few minutes, you should receive an email with instructions to set your password.';
- end;
- end;
- $self->htmlFooter;
-}
-
-
-sub edit {
- my($self, $uid) = @_;
-
- # are we allowed to edit this user?
- return $self->htmlDenied if !$self->authInfo->{id} || $self->authInfo->{id} != $uid && !$self->authCan('usermod');
-
- # fetch user info (cached if uid == loggedin uid)
- my $u = $self->authInfo->{id} == $uid ? $self->authInfo : $self->dbUserGet(uid => $uid, what => 'extended prefs')->[0];
- return $self->resNotFound if !$u->{id};
-
- # check POST data
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- $self->authCan('usermod') ? (
- { post => 'usrname', template => 'uname' },
- { post => 'perms', required => 0, multi => 1, enum => [ keys %{$self->{permissions}} ] },
- { post => 'ign_votes', required => 0, default => 0 },
- ) : (),
- { post => 'mail', template => 'email' },
- { post => 'curpass', required => 0, minlength => 4, maxlength => 64, template => 'ascii', default => '' },
- { post => 'usrpass', required => 0, minlength => 4, maxlength => 64, template => 'ascii' },
- { post => 'usrpass2', required => 0, minlength => 4, maxlength => 64, template => 'ascii' },
- { post => 'hide_list', required => 0, default => 0, enum => [0,1] },
- { post => 'show_nsfw', required => 0, default => 0, enum => [0,1] },
- { post => 'traits_sexual', required => 0, default => 0, enum => [0,1] },
- { post => 'tags_all', required => 0, default => 0, enum => [0,1] },
- { post => 'tags_cat', required => 0, multi => 1, enum => [qw|cont ero tech|] },
- { post => 'spoilers', required => 0, default => 0, enum => [0..2] },
- { post => 'skin', required => 0, default => $self->{skin_default}, enum => [ keys %{$self->{skins}} ] },
- { post => 'customcss', required => 0, maxlength => 2000, default => '' },
- );
- push @{$frm->{_err}}, 'Passwords do not match'
- if ($frm->{usrpass} || $frm->{usrpass2}) && (!$frm->{usrpass} || !$frm->{usrpass2} || $frm->{usrpass} ne $frm->{usrpass2});
-
- if(!$frm->{_err}) {
- $frm->{skin} = '' if $frm->{skin} eq $self->{skin_default};
- $self->dbUserPrefSet($uid, $_ => $frm->{$_}) for (qw|skin customcss show_nsfw traits_sexual tags_all hide_list spoilers|);
-
- my $tags_cat = join(',', sort @{$frm->{tags_cat}}) || 'none';
- $self->dbUserPrefSet($uid, tags_cat => $tags_cat eq $self->{default_tags_cat} ? '' : $tags_cat);
-
- my %o;
- if($self->authCan('usermod')) {
- $o{username} = $frm->{usrname} if $frm->{usrname};
- $o{ign_votes} = $frm->{ign_votes} ? 1 : 0;
-
- my $perm = 0;
- $perm |= $self->{permissions}{$_} for(@{ delete $frm->{perms} });
- $self->dbUserSetPerm($u->{id}, $self->authInfo->{id}, $self->authInfo->{token}, $perm);
- }
- $self->dbUserSetMail($u->{id}, $self->authInfo->{id}, $self->authInfo->{token}, $frm->{mail});
- $self->dbUserEdit($uid, %o);
- $self->authAdminSetPass($u->{id}, $frm->{usrpass}) if $frm->{usrpass} && $self->authInfo->{id} != $u->{id};
-
- if($frm->{usrpass} && $self->authInfo->{id} == $u->{id}) {
- # Bit ugly: On incorrect password, all other changes are still saved.
- my $ok = $self->authSetPass($u->{id}, $frm->{usrpass}, "/u$uid/edit?d=1", pass => $frm->{curpass});
- return if $ok;
- push @{$frm->{_err}}, 'Invalid password';
- } else {
- return $self->resRedirect("/u$uid/edit?d=1", 'post');
- }
- }
- }
-
- # fill out default values
- $frm->{usrname} ||= $u->{username};
- $frm->{mail} ||= $self->dbUserGetMail($u->{id}, $self->authInfo->{id}, $self->authInfo->{token});
- $frm->{perms} ||= [ grep $u->{perm} & $self->{permissions}{$_}, keys %{$self->{permissions}} ];
- $frm->{$_} //= $u->{prefs}{$_} for(qw|skin customcss show_nsfw traits_sexual tags_all hide_list spoilers|);
- $frm->{tags_cat} ||= [ split /,/, $u->{prefs}{tags_cat}||$self->{default_tags_cat} ];
- $frm->{ign_votes} = $u->{ign_votes} if !defined $frm->{ign_votes};
- $frm->{skin} ||= $self->{skin_default};
- $frm->{usrpass} = $frm->{usrpass2} = $frm->{curpass} = '';
-
- # create the page
- $self->htmlHeader(title => 'My account', noindex => 1);
- $self->htmlMainTabs('u', $u, 'edit');
- if($self->reqGet('d')) {
- div class => 'mainbox';
- h1 'Settings saved';
- div class => 'notice';
- p 'Settings successfully saved.';
- end;
- end
- }
- $self->htmlForm({ frm => $frm, action => "/u$uid/edit" }, useredit => [ 'My account',
- [ part => title => 'General info' ],
- $self->authCan('usermod') ? (
- [ input => short => 'usrname', name => 'Username' ],
- [ select => short => 'perms', name => 'Permissions', multi => 1, size => (scalar keys %{$self->{permissions}}), options => [
- map [ $_, $_ ], sort keys %{$self->{permissions}} ] ],
- [ check => short => 'ign_votes', name => 'Ignore votes in VN statistics' ],
- ) : (
- [ static => label => 'Username', content => $frm->{usrname} ],
- ),
- [ input => short => 'mail', name => 'Email' ],
-
- [ part => title => 'Change password' ],
- [ static => content => 'Leave blank to keep your current password' ],
- [ passwd => short => 'curpass', name => 'Current Password' ],
- [ passwd => short => 'usrpass', name => 'New Password' ],
- [ passwd => short => 'usrpass2', name => 'Confirm password' ],
-
- [ part => title => 'Options' ],
- [ check => short => 'hide_list', name =>
- qq{Don't allow other people to see my visual novel list (<a href="/u$uid/list">/u$uid/list</a>),
- votes (<a href="/u$uid/votes">/u$uid/votes</a>) and wishlist (<a href="/u$uid/wish">/u$uid/wish</a>).} ],
- [ check => short => 'show_nsfw', name => 'Disable warnings for images that are not safe for work.' ],
- [ check => short => 'traits_sexual', name => 'Show sexual traits by default on character pages.' ],
- [ check => short => 'tags_all', name => 'Show all tags by default on visual novel pages.' ],
- [ select => short => 'tags_cat', name => 'Tag categories', multi => 1, size => 3,
- options => [ map [ $_, $self->{tag_categories}{$_} ], keys %{$self->{tag_categories}} ] ],
- [ select => short => 'spoilers', name => 'Spoiler level', options => [
- [0, 'Hide spoilers'], [1, 'Show only minor spoilers'], [2, 'Show all spoilers'] ]],
- [ select => short => 'skin', name => 'Preferred skin', width => 300, options => [
- map [ $_, $self->{skins}{$_}[0].($self->debug?" [$_]":'') ], sort { $self->{skins}{$a}[0] cmp $self->{skins}{$b}[0] } keys %{$self->{skins}} ] ],
- [ textarea => short => 'customcss', name => 'Additional <a href="http://en.wikipedia.org/wiki/Cascading_Style_Sheets">CSS</a>' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub posts {
- my($self, $uid) = @_;
-
- # fetch user info (cached if uid == loggedin uid)
- my $u = $self->authInfo->{id} && $self->authInfo->{id} == $uid ? $self->authInfo : $self->dbUserGet(uid => $uid, what => 'hide_list')->[0];
- return $self->resNotFound if !$u->{id};
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' }
- );
- return $self->resNotFound if $f->{_err};
-
- my($posts, $np) = $self->dbPostGet(uid => $uid, hide => 1, what => 'thread', page => $f->{p}, sort => 'date', reverse => 1);
-
- my $title = "Posts made by $u->{username}";
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs(u => $u, 'posts');
- div class => 'mainbox';
- h1 $title;
- if(!@$posts) {
- p "$u->{username} hasn't made any posts yet.";
- }
- end;
-
- $self->htmlBrowse(
- items => $posts,
- class => 'uposts',
- options => $f,
- nextpage => $np,
- pageurl => "/u$uid/posts",
- header => [
- [ '' ],
- [ '' ],
- [ 'Date' ],
- [ 'Title' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1'; a href => "/t$l->{tid}.$l->{num}", 't'.$l->{tid}; end;
- td class => 'tc2'; a href => "/t$l->{tid}.$l->{num}", '.'.$l->{num}; end;
- td class => 'tc3', fmtdate $l->{date};
- td class => 'tc4';
- a href => "/t$l->{tid}.$l->{num}", $l->{title};
- b class => 'grayedout'; lit bb2html $l->{msg}, 150; end;
- end;
- end;
- },
- ) if @$posts;
- $self->htmlFooter;
-}
-
-
-sub delete {
- my($self, $uid, $act) = @_;
- return $self->htmlDenied if !$self->authCan('usermod');
-
- # rarely used admin function, won't really need translating
-
- # confirm
- if(!$act) {
- my $code = $self->authGetCode("/u$uid/del/o");
- my $u = $self->dbUserGet(uid => $uid, what => 'hide_list')->[0];
- return $self->resNotFound if !$u->{id};
- $self->htmlHeader(title => 'Delete user', noindex => 1);
- $self->htmlMainTabs('u', $u, 'del');
- div class => 'mainbox';
- div class => 'warning';
- h2 'Delete user';
- p;
- lit qq|Are you sure you want to remove <a href="/u$uid">$u->{username}</a>'s account?<br /><br />|
- .qq|<a href="/u$uid/del/o?formcode=$code">Yes, I'm not kidding!</a>|;
- end;
- end;
- end;
- $self->htmlFooter;
- }
- # delete
- elsif($act eq '/o') {
- return if !$self->authCheckCode;
- $self->dbUserDel($uid);
- $self->resRedirect("/u$uid/del/d", 'post');
- }
- # done
- elsif($act eq '/d') {
- $self->htmlHeader(title => 'Delete user', noindex => 1);
- div class => 'mainbox';
- div class => 'notice';
- p 'User deleted.';
- end;
- end;
- $self->htmlFooter;
- }
-}
-
-
-sub list {
- my($self, $char) = @_;
-
- my $f = $self->formValidate(
- { get => 's', required => 0, default => 'username', enum => [ qw|username registered votes changes tags| ] },
- { get => 'o', required => 0, default => 'a', enum => [ 'a','d' ] },
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'q', required => 0, default => '', maxlength => 50 },
- );
- return $self->resNotFound if $f->{_err};
-
- $self->htmlHeader(noindex => 1, title => 'Browse users');
-
- div class => 'mainbox';
- h1 'Browse users';
- form action => '/u/all', 'accept-charset' => 'UTF-8', method => 'get';
- $self->htmlSearchBox('u', $f->{q});
- end;
- p class => 'browseopts';
- for ('all', 'a'..'z', 0) {
- a href => "/u/$_", $_ eq $char ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#';
- }
- end;
- end;
-
- my($list, $np) = $self->dbUserGet(
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- what => 'hide_list',
- $char ne 'all' ? (
- firstchar => $char ) : (),
- results => 50,
- page => $f->{p},
- search => $f->{q},
- );
-
- $self->htmlBrowse(
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => "/u/$char?o=$f->{o};s=$f->{s};q=$f->{q}",
- sorturl => "/u/$char?q=$f->{q}",
- header => [
- [ 'Username', 'username' ],
- [ 'Registered', 'registered' ],
- [ 'Votes', 'votes' ],
- [ 'Edits', 'changes' ],
- [ 'Tags', 'tags' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- td class => 'tc1';
- a href => '/u'.$l->{id}, $l->{username};
- end;
- td class => 'tc2', fmtdate $l->{registered};
- td class => 'tc3'.($l->{hide_list} && $self->authCan('usermod') ? ' linethrough' : '');
- lit $l->{hide_list} && !$self->authCan('usermod') ? '-' : !$l->{c_votes} ? 0 :
- qq|<a href="/u$l->{id}/votes">$l->{c_votes}</a>|;
- end;
- td class => 'tc4';
- lit !$l->{c_changes} ? 0 : qq|<a href="/u$l->{id}/hist">$l->{c_changes}</a>|;
- end;
- td class => 'tc5';
- lit !$l->{c_tags} ? 0 : qq|<a href="/g/links?u=$l->{id}">$l->{c_tags}</a>|;
- end;
- end 'tr';
- },
- );
- $self->htmlFooter;
-}
-
-
-sub notifies {
- my($self, $uid) = @_;
-
- my $u = $self->authInfo;
- return $self->htmlDenied if !$u->{id} || $uid != $u->{id};
-
- my $f = $self->formValidate(
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'r', required => 0, default => 0, enum => [0,1] },
- );
- return $self->resNotFound if $f->{_err};
-
- # changing the notification settings
- my $saved;
- if($self->reqMethod() eq 'POST' && $self->reqPost('set')) {
- return if !$self->authCheckCode;
- my $frm = $self->formValidate(
- { post => 'notify_nodbedit', required => 0, default => 1, enum => [0,1] },
- { post => 'notify_announce', required => 0, default => 0, enum => [0,1] }
- );
- return $self->resNotFound if $frm->{_err};
- $self->authPref($_, $frm->{$_}) for ('notify_nodbedit', 'notify_announce');
- $saved = 1;
-
- # updating notifications
- } elsif($self->reqMethod() eq 'POST') {
- return if !$self->authCheckCode;
- my $frm = $self->formValidate(
- { post => 'notifysel', multi => 1, required => 0, template => 'id' },
- { post => 'markread', required => 0 },
- { post => 'remove', required => 0 }
- );
- return $self->resNotFound if $frm->{_err};
- my @ids = grep $_, @{$frm->{notifysel}};
- $self->dbNotifyMarkRead(@ids) if @ids && $frm->{markread};
- $self->dbNotifyRemove(@ids) if @ids && $frm->{remove};
- $self->authInfo->{notifycount} = $self->dbUserGet(uid => $uid, what => 'notifycount')->[0]{notifycount};
- }
-
- my($list, $np) = $self->dbNotifyGet(
- uid => $uid,
- page => $f->{p},
- results => 25,
- what => 'titles',
- read => $f->{r} == 1 ? undef : 0,
- reverse => $f->{r} == 1,
- );
-
- $self->htmlHeader(title => 'My notifications', noindex => 1);
- $self->htmlMainTabs(u => $u);
- div class => 'mainbox';
- h1 'My notifications';
- p class => 'browseopts';
- a !$f->{r} ? (class => 'optselected') : (), href => "/u$uid/notifies?r=0", 'Unread notifications';
- a $f->{r} ? (class => 'optselected') : (), href => "/u$uid/notifies?r=1", 'All notifications';
- end;
- p 'No notifications!' if !@$list;
- end;
-
- my $code = $self->authGetCode("/u$uid/notifies");
-
- my %ntypes = (
- pm => 'Private Message',
- dbdel => 'Entry you contributed to has been deleted',
- listdel => 'VN in your (wish)list has been deleted',
- dbedit => 'Entry you contributed to has been edited',
- announce => 'Site announcement',
- );
-
- if(@$list) {
- form action => "/u$uid/notifies?r=$f->{r};formcode=$code", method => 'post', id => 'notifies';
- $self->htmlBrowse(
- items => $list,
- options => $f,
- nextpage => $np,
- class => 'notifies',
- pageurl => "/u$uid/notifies?r=$f->{r}",
- header => [
- [ '' ],
- [ 'Type' ],
- [ 'Age' ],
- [ 'ID' ],
- [ 'Action' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr $l->{read} ? () : (class => 'unread');
- td class => 'tc1';
- input type => 'checkbox', name => 'notifysel', value => "$l->{id}";
- end;
- td class => 'tc2', $ntypes{$l->{ntype}};
- td class => 'tc3', fmtage $l->{date};
- td class => 'tc4';
- a href => "/u$uid/notify/$l->{id}", "$l->{ltype}$l->{iid}".($l->{subid}?".$l->{subid}":'');
- end;
- td class => 'tc5 clickable', id => "notify_$l->{id}";
- lit sprintf
- $l->{ltype} ne 't' ? 'Edit of %s by %s' :
- $l->{subid} == 1 ? 'New thread %s by %s' : 'Reply to %s by %s',
- sprintf('<i>%s</i>', xml_escape $l->{c_title}),
- sprintf('<i>%s</i>', xml_escape $l->{username});
- end;
- end 'tr';
- },
- footer => sub {
- Tr;
- td colspan => 5;
- input type => 'checkbox', class => 'checkall', name => 'notifysel', value => 0;
- txt ' ';
- input type => 'submit', name => 'markread', value => 'mark selected read';
- input type => 'submit', name => 'remove', value => 'remove selected';
- b class => 'grayedout', ' (Read notifications are automatically removed after one month)';
- end;
- end;
- }
- );
- end;
- }
-
- form method => 'post', action => "/u$uid/notifies?formcode=$code";
- div class => 'mainbox';
- h1 'Settings';
- div class => 'notice', 'Settings successfully saved.' if $saved;
- p;
- for('nodbedit', 'announce') {
- my $def = $_ eq 'nodbedit' ? 0 : 1;
- input type => 'checkbox', name => "notify_$_", id => "notify_$_", value => $def,
- ($self->authPref("notify_$_")||0) == $def ? (checked => 'checked') : ();
- label for => "notify_$_", $_ eq 'nodbedit'
- ? ' Notify me about edits of database entries I contributed to.'
- : ' Notify me about site announcements.';
- br;
- }
- input type => 'submit', name => 'set', value => 'Save';
- end;
- end;
- end 'form';
- $self->htmlFooter;
-}
-
-
-sub readnotify {
- my($self, $uid, $nid) = @_;
- return $self->htmlDenied if !$self->authInfo->{id} || $uid != $self->authInfo->{id};
- my $n = $self->dbNotifyGet(uid => $uid, id => $nid)->[0];
- return $self->resNotFound if !$n->{iid};
- $self->dbNotifyMarkRead($n->{id}) if !$n->{read};
- # NOTE: for t+.+ IDs, this will create a double redirect, which is rather awkward...
- $self->resRedirect("/$n->{ltype}$n->{iid}".($n->{subid}?".$n->{subid}":''), 'perm');
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/VNBrowse.pm b/lib/VNDB/Handler/VNBrowse.pm
deleted file mode 100644
index da3f3782..00000000
--- a/lib/VNDB/Handler/VNBrowse.pm
+++ /dev/null
@@ -1,138 +0,0 @@
-
-package VNDB::Handler::VNBrowse;
-
-use strict;
-use warnings;
-use TUWF ':html', 'uri_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{v/([a-z0]|all)} => \&list,
-);
-
-
-sub list {
- my($self, $char) = @_;
-
- my $f = $self->formValidate(
- { get => 's', required => 0, default => 'tagscore', enum => [ qw|title rel pop tagscore rating| ] },
- { get => 'o', required => 0, enum => [ 'a','d' ] },
- { get => 'p', required => 0, default => 1, template => 'page' },
- { get => 'q', required => 0, default => '' },
- { get => 'sq', required => 0, default => '' },
- { get => 'fil',required => 0 },
- { get => 'rfil', 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};
- $f->{fil} //= $self->authPref('filter_vn');
- my %compat = _fil_compat($self);
- my $uid = $self->authInfo->{id};
-
- my $read_write_pref = sub {
- my($type, $pref_name) = @_;
-
- return 0 if !$uid; # no data to display anyway
- return $self->authPref($pref_name)?1:0 if $f->{$type} == 2;
-
- $self->authPref($pref_name => $f->{$type}?1:0) if ($self->authPref($pref_name)?1:0) != $f->{$type};
- return $f->{$type};
- };
-
- $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]+))?$/;
-
- $f->{s} = 'title' if $f->{fil} !~ /tag_inc-/ && $f->{s} eq 'tagscore';
- $f->{o} = $f->{s} eq 'tagscore' ? 'd' : 'a' if !$f->{o};
-
- my $rfil = fil_parse $f->{rfil}, @{$VNDB::Util::Misc::filfields{release}};
- $f->{rfil} = fil_serialize $rfil, @{$VNDB::Util::Misc::filfields{release}};
-
- my($list, $np) = $self->filFetchDB(vn => $f->{fil}, {
- %compat,
- tagspoil => $self->authPref('spoilers')||0,
- }, {
- what => ' rating' .
- ($f->{vnlist} ? ' vnlist' : '').
- ($f->{wish} ? ' wishlist' : ''),
- $char ne 'all' ? ( char => $char ) : (),
- $f->{q} ? ( search => $f->{q} ) : (),
- keys %$rfil ? ( release => $rfil ) : (),
- results => 50,
- page => $f->{p},
- sort => $f->{s}, reverse => $f->{o} eq 'd',
- });
-
- $self->resRedirect('/v'.$list->[0]{id}, 'temp')
- if $f->{q} && @$list == 1 && $f->{p} == 1;
-
- $self->htmlHeader(title => 'Browse visual novels', search => $f->{q});
-
- my $quri = uri_escape($f->{q});
- form action => '/v/all', 'accept-charset' => 'UTF-8', method => 'get';
-
- # url generator
- my $url = sub {
- my($char, $toggle) = @_;
-
- return "/v/$char?q=$quri;fil=$f->{fil};rfil=$f->{rfil};s=$f->{s};o=$f->{o}" .
- ($toggle ? ";$toggle=".($f->{$toggle}?0:1) : '');
- };
-
- div class => 'mainbox';
- h1 'Browse visual novels';
- $self->htmlSearchBox('v', $f->{q});
- p class => 'browseopts';
- for ('all', 'a'..'z', 0) {
- a href => $url->($_), $_ eq $char ? (class => 'optselected') : (), $_ eq 'all' ? 'ALL' : $_ ? uc $_ : '#';
- }
- end;
- 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';
- }
-
- p class => 'filselect';
- a id => 'filselect', href => '#v';
- lit '<i>&#9656;</i> Visual Novel Filters<i></i>';
- end;
- a id => 'rfilselect', href => '#r';
- lit '<i>&#9656;</i> Release filters<i></i>';
- end;
- end;
- input type => 'hidden', class => 'hidden', name => $_, id => $_, value => $f->{$_}
- for (qw{fil rfil s o});
- end;
- end 'form';
-
- $self->htmlBrowseVN($list, $f, $np, "/v/$char?q=$quri;fil=$f->{fil};rfil=$f->{rfil}", $f->{fil} =~ /tag_inc-/);
- $self->htmlFooter(pref_code => 1);
-}
-
-
-sub _fil_compat {
- my $self = shift;
- my %c;
- my $f = $self->formValidate(
- { get => 'ln', required => 0, multi => 1, enum => [ keys %{$self->{languages}} ], default => '' },
- { get => 'pl', required => 0, multi => 1, enum => [ keys %{$self->{platforms}} ], default => '' },
- { get => 'sp', required => 0, default => ($self->reqCookie('tagspoil')||'') =~ /^([0-2])$/ ? $1 : 0, enum => [0..2] },
- );
- return () if $f->{_err};
- $c{lang} //= $f->{ln} if $f->{ln}[0];
- $c{plat} //= $f->{pl} if $f->{pl}[0];
- $c{tagspoil} //= $f->{sp};
- return %c;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/VNEdit.pm b/lib/VNDB/Handler/VNEdit.pm
deleted file mode 100644
index ce10611d..00000000
--- a/lib/VNDB/Handler/VNEdit.pm
+++ /dev/null
@@ -1,545 +0,0 @@
-
-package VNDB::Handler::VNEdit;
-
-use strict;
-use warnings;
-use TUWF ':html', ':xml';
-use Image::Magick;
-use VNDB::Func;
-
-
-TUWF::register(
- qr{v(?:([1-9]\d*)(?:\.([1-9]\d*))?/edit|/new)}
- => \&edit,
- qr{v/add} => \&addform,
- qr{xml/vn\.xml} => \&vnxml,
- qr{xml/screenshots\.xml} => \&scrxml,
-);
-
-
-sub addform {
- my $self = shift;
- return $self->htmlDenied if !$self->authCan('edit');
-
- my $frm;
- my $l = [];
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'title', maxlength => 250 },
- { post => 'original', required => 0, maxlength => 250, default => '' },
- { post => 'alias', required => 0, maxlength => 500, default => '' },
- { post => 'continue_ign',required => 0 },
- );
-
- # look for duplicates
- if(!$frm->{_err} && !$frm->{continue_ign}) {
- $l = $self->dbVNGet(search => $frm->{title}, what => 'changes', results => 50, inc_hidden => 1);
- push @$l, @{$self->dbVNGet(search => $frm->{original}, what => 'changes', results => 50, inc_hidden => 1)} if $frm->{original};
- $_ && push @$l, @{$self->dbVNGet(search => $_, what => 'changes', results => 50, inc_hidden => 1)} for(split /\n/, $frm->{alias});
- my %ids = map +($_->{id}, $_), @$l;
- $l = [ map $ids{$_}, sort { $ids{$a}{title} cmp $ids{$b}{title} } keys %ids ];
- }
-
- return edit($self, undef, undef, 1) if !@$l && !$frm->{_err};
- }
-
- $self->htmlHeader(title => 'Add a new visual novel', noindex => 1);
- if(@$l) {
- div class => 'mainbox';
- h1 'Possible duplicates found';
- div class => 'warning';
- p;
- txt 'The following is a list of visual novels that match the title(s) you gave.'
- .' Please check this list to avoid creating a duplicate visual novel entry.'
- .' Be especially wary of items that have been deleted! To see why an entry has been deleted, click on its title.';
- br; br;
- txt 'To add the visual novel anyway, hit the "Continue and ignore duplicates" button below.';
- end;
- end;
- ul;
- for(@$l) {
- li;
- a href => "/v$_->{id}", title => $_->{original}||$_->{title}, "v$_->{id}: ".shorten($_->{title}, 50);
- b class => 'standout', ' deleted' if $_->{hidden};
- end;
- }
- end;
- end 'div';
- }
-
- $self->htmlForm({ frm => $frm, action => '/v/add', continue => @$l ? 2 : 1 },
- vn_add => [ 'Add a new visual novel',
- [ input => short => 'title', name => 'Title (romaji)', width => 450 ],
- [ input => short => 'original', name => 'Original title', width => 450 ],
- [ static => content => 'The original title of this visual novel, leave blank if it already is in the Latin alphabet.' ],
- [ textarea => short => 'alias', name => 'Aliases', rows => 4 ],
- [ static => content => 'List of alternative titles or abbreviations. One line for each alias.' ],
- ]);
- $self->htmlFooter;
-}
-
-
-sub edit {
- my($self, $vid, $rev, $nosubmit) = @_;
-
- my $v = $vid && $self->dbVNGetRev(id => $vid, what => 'extended screenshots relations anime staff seiyuu changes', $rev ? (rev => $rev) : ())->[0];
- return $self->resNotFound if $vid && !$v->{id};
- $rev = undef if !$vid || $v->{lastrev};
-
- return $self->htmlDenied if !$self->authCan('edit')
- || $vid && (($v->{locked} || $v->{hidden}) && !$self->authCan('dbmod'));
-
- my $r = $v ? $self->dbReleaseGet(vid => $v->{id}) : [];
- my $chars = $v ? $self->dbCharGet(vid => $v->{id}, results => 500) : [];
-
- my %b4 = !$vid ? () : (
- (map { $_ => $v->{$_} } qw|title original desc alias length l_wp l_encubed l_renai image img_nsfw ihid ilock|),
- credits => [
- map { my $c = $_; +{ map { $_ => $c->{$_} } qw|aid role note| } }
- sort { $a->{aid} <=> $b->{aid} || $a->{role} cmp $b->{role} } @{$v->{credits}}
- ],
- seiyuu => [
- map { my $c = $_; +{ map { $_ => $c->{$_} } qw|aid cid note| } }
- sort { $a->{aid} <=> $b->{aid} || $a->{cid} <=> $b->{cid} } @{$v->{seiyuu}}
- ],
- anime => join(' ', sort { $a <=> $b } map $_->{id}, @{$v->{anime}}),
- vnrelations => join('|||', map $_->{relation}.','.$_->{id}.','.($_->{official}?1:0).','.$_->{title}, sort { $a->{id} <=> $b->{id} } @{$v->{relations}}),
- screenshots => [
- map +{ id => $_->{id}, nsfw => $_->{nsfw}?1:0, rid => $_->{rid} },
- sort { $a->{id} <=> $b->{id} } @{$v->{screenshots}}
- ]
- );
-
- my $frm;
- if($self->reqMethod eq 'POST') {
- return if !$nosubmit && !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'title', maxlength => 250 },
- { post => 'original', required => 0, maxlength => 250, default => '' },
- { post => 'alias', required => 0, maxlength => 500, default => '' },
- { post => 'desc', required => 0, default => '', maxlength => 10240 },
- { post => 'length', required => 0, default => 0, enum => [ 0..$#{$self->{vn_lengths}} ] },
- { post => 'l_wp', required => 0, default => '', maxlength => 150 },
- { post => 'l_encubed', required => 0, default => '', maxlength => 100 },
- { post => 'l_renai', required => 0, default => '', maxlength => 100 },
- { post => 'anime', required => 0, default => '' },
- { post => 'image', required => 0, default => 0, template => 'id' },
- { post => 'img_nsfw', required => 0, default => 0 },
- { post => 'credits', required => 0, template => 'json', json_unique => ['aid','role'], json_sort => ['aid','role'], json_fields => [
- { field => 'aid', required => 1, template => 'id' },
- { field => 'role', required => 1, enum => [ keys %{$self->{staff_roles}} ] },
- { field => 'note', required => 0, maxlength => 250, default => '' },
- ]},
- { post => 'seiyuu', required => 0, template => 'json', json_unique => ['aid','cid'], json_sort => ['aid','cid'], json_fields => [
- { field => 'aid', required => 1, template => 'id' },
- { field => 'cid', required => 1, template => 'id' },
- { field => 'note', required => 0, maxlength => 250, default => '' },
- ]},
- { post => 'vnrelations', required => 0, default => '', maxlength => 5000 },
- { post => 'screenshots', required => 0, template => 'json', json_maxitems => 10, json_unique => 'id', json_sort => 'id', json_fields => [
- { field => 'id', required => 1, template => 'id' },
- { field => 'rid', required => 1, template => 'id' },
- { field => 'nsfw', required => 1, template => 'uint', enum => [0,1] },
- ]},
- { post => 'editsum', required => !$nosubmit, template => 'editsum' },
- { post => 'ihid', required => 0 },
- { post => 'ilock', required => 0 },
- );
- # handle image upload
- $frm->{image} = _uploadimage($self, $frm) if !$nosubmit;
-
- if(!$nosubmit && !$frm->{_err}) {
- # normalize aliases
- $frm->{alias} = join "\n", map { s/^ +//g; s/ +$//g; $_?($_):() } split /\n/, $frm->{alias};
- # throw error on duplicate/existing aliases
- my %alias = map +(lc($_),1), $frm->{title}, $frm->{original}, map +($_->{title}, $_->{original}), @$r;
- my @e = map $alias{ lc($_) }++ ? "Duplicate alias '$_', or the alias is already used as a release title" : (), split /\n/, $frm->{alias};
- $frm->{_err} = \@e if @e;
- }
- if(!$nosubmit && !$frm->{_err}) {
- # parse and re-sort fields that have multiple representations of the same information
- my $anime = { map +($_=>1), grep /^[0-9]+$/, split /[ ,]+/, $frm->{anime} };
- my $relations = [ map { /^([a-z]+),([0-9]+),([01]),(.+)$/ && (!$vid || $2 != $vid) ? [ $1, $2, $3, $4 ] : () } split /\|\|\|/, $frm->{vnrelations} ];
-
- # Ensure submitted alias / character IDs exist within database
- my @alist = map $_->{aid}, @{$frm->{credits}}, @{$frm->{seiyuu}};
- my %staff = @alist ? map +($_->{aid}, 1), @{$self->dbStaffGet(aid => \@alist, results => 200)} : ();
- my %vn_chars = map +($_->{id} => 1), @$chars;
- $frm->{credits} = [ grep $staff{$_->{aid}}, @{$frm->{credits}} ];
- $frm->{seiyuu} = [ grep $staff{$_->{aid}} && $vn_chars{$_->{cid}}, @$chars ? @{$frm->{seiyuu}} : () ];
-
- $frm->{ihid} = $frm->{ihid}?1:0;
- $frm->{ilock} = $frm->{ilock}?1:0;
- $frm->{desc} = $self->bbSubstLinks($frm->{desc});
- $relations = [] if $frm->{ihid};
- $frm->{anime} = join ' ', sort { $a <=> $b } keys %$anime;
- $frm->{vnrelations} = join '|||', map $_->[0].','.$_->[1].','.($_->[2]?1:0).','.$_->[3], sort { $a->[1] <=> $b->[1]} @{$relations};
- $frm->{img_nsfw} = $frm->{img_nsfw} ? 1 : 0;
- $frm->{screenshots} = [ sort { $a->{id} <=> $b->{id} } @{$frm->{screenshots}} ];
-
- # nothing changed? just redirect
- return $self->resRedirect("/v$vid", 'post') if $vid && !form_compare(\%b4, $frm);
-
- # perform the edit/add
- my $nrev = $self->dbItemEdit(v => $vid ? ($v->{id}, $v->{rev}) : (undef, undef),
- (map { $_ => $frm->{$_} } qw|title original image alias desc length l_wp l_encubed l_renai editsum img_nsfw ihid ilock credits seiyuu screenshots|),
- anime => [ keys %$anime ],
- relations => $relations,
- );
-
- # update reverse relations & relation graph
- if(!$vid && $#$relations >= 0 || $vid && $frm->{vnrelations} ne $b4{vnrelations}) {
- my %old = $vid ? (map +($_->{id} => [ $_->{relation}, $_->{official} ]), @{$v->{relations}}) : ();
- my %new = map +($_->[1] => [ $_->[0], $_->[2] ]), @$relations;
- _updreverse($self, \%old, \%new, $nrev->{itemid}, $nrev->{rev});
- }
-
- return $self->resRedirect("/v$nrev->{itemid}.$nrev->{rev}", 'post');
- }
- }
-
- !exists $frm->{$_} && ($frm->{$_} = $b4{$_}) for (keys %b4);
- $frm->{editsum} = sprintf 'Reverted to revision v%d.%d', $vid, $rev if $rev && !defined $frm->{editsum};
-
- my $title = $vid ? "Edit $v->{title}" : 'Add a new visual novel';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('v', $v, 'edit') if $vid;
- $self->htmlEditMessage('v', $v, $title);
- _form($self, $v, $frm, $r, $chars);
- $self->htmlFooter;
-}
-
-
-sub _uploadimage {
- my($self, $frm) = @_;
-
- if($frm->{_err} || !$self->reqPost('img')) {
- return 0 if !$frm->{image};
- push @{$frm->{_err}}, 'No image with that ID' if !-s imgpath(cv => $frm->{image});
- return $frm->{image};
- }
-
- # perform some elementary checks
- my $imgdata = $self->reqUploadRaw('img');
- $frm->{_err} = [ 'Image must be in JPEG or PNG format' ] if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG headers
- $frm->{_err} = [ 'Image is too large, only 5MB allowed' ] if length($imgdata) > 5*1024*1024;
- return undef if $frm->{_err};
-
- # resize/compress
- my $im = Image::Magick->new;
- $im->BlobToImage($imgdata);
- $im->Set(magick => 'JPEG');
- my($ow, $oh) = ($im->Get('width'), $im->Get('height'));
- my($nw, $nh) = imgsize($ow, $oh, @{$self->{cv_size}});
- $im->Set(background => '#ffffff');
- $im->Set(alpha => 'Remove');
- 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);
- }
- $im->Set(quality => 90);
-
- # Get ID and save
- my $imgid = $self->dbVNImageId;
- my $fn = imgpath(cv => $imgid);
- $im->Write($fn);
- chmod 0666, $fn;
-
- return $imgid;
-}
-
-
-sub _form {
- my($self, $v, $frm, $r, $chars) = @_;
- my $import = @$chars ? $self->dbVNImportSeiyuu($v->{id}, [ map $_->{id}, @$chars ]) : [];
- $self->htmlForm({ frm => $frm, action => $v ? "/v$v->{id}/edit" : '/v/new', editsum => 1, upload => 1 },
- vn_geninfo => [ 'General info',
- [ input => short => 'title', name => 'Title (romaji)', width => 450 ],
- [ input => short => 'original', name => 'Original title', width => 450 ],
- [ static => content => 'The original title of this visual novel, leave blank if it already is in the Latin alphabet.' ],
- [ textarea => short => 'alias', name => 'Aliases', rows => 4 ],
- [ static => content =>
- 'List of alternative titles or abbreviations. One line for each alias.'
- .' Can include both official (japanese/english) titles and unofficial titles used around net.<br />'
- .' Titles that are listed in the releases should not be added here!' ],
- [ textarea => short => 'desc', name => 'Description<br /><b class="standout">English please!</b>', rows => 10 ],
- [ static => content =>
- 'Short description of the main story. Please do not include spoilers, and don\'t forget to list'
- .' the source in case you didn\'t write the description yourself. Formatting codes are allowed.' ],
- [ select => short => 'length', name => 'Length', width => 450, options =>
- [ map [ $_ => fmtvnlen $_, 2 ], 0..$#{$self->{vn_lengths}} ] ],
-
- [ input => short => 'l_wp', name => 'External links', pre => 'http://en.wikipedia.org/wiki/' ],
- [ input => short => 'l_encubed', pre => 'http://novelnews.net/tag/', post => '/' ],
- [ input => short => 'l_renai', pre => 'http://renai.us/game/', post => '.shtml' ],
-
- [ input => short => 'anime', name => 'Anime' ],
- [ static => content =>
- 'Whitespace separated list of <a href="http://anidb.net/">AniDB</a> anime IDs.'
- .' E.g. "1015 3348" will add <a href="http://anidb.net/a1015">Shingetsutan Tsukihime</a>'
- .' and <a href="http://anidb.net/a3348">Fate/stay night</a> as related anime.<br />'
- .' Note: It can take a few minutes for the anime titles to appear on the VN page.' ],
- ],
-
- vn_img => [ 'Image', [ static => nolabel => 1, content => sub {
- div class => 'img';
- p 'No image uploaded yet' if !$frm->{image};
- img src => imgurl(cv => $frm->{image}) if $frm->{image};
- end;
-
- div;
- h2 'Image ID';
- input type => 'text', class => 'text', name => 'image', id => 'image', value => $frm->{image}||'';
- p 'Use a VN image that is already on the server. Set to \'0\' to remove the current image.';
- br; br;
-
- h2 'Upload new image';
- input type => 'file', class => 'text', name => 'img', id => 'img';
- p 'Preferably the cover of the CD/DVD/package. Image must be in JPEG or PNG format'
- .' and at most 5MB. Images larger than 256x400 will automatically be resized.';
- br; br; br;
-
- h2 'NSFW';
- input type => 'checkbox', class => 'checkbox', id => 'img_nsfw', name => 'img_nsfw',
- $frm->{img_nsfw} ? (checked => 'checked') : ();
- label class => 'checkbox', for => 'img_nsfw', 'Not Safe For Work';
- p 'Please check this option if the image contains nudity, gore, or is otherwise not safe in a work-friendly environment.';
- end 'div';
- }]],
-
- vn_staff => [ 'Staff',
- [ json => short => 'credits' ],
- [ static => nolabel => 1, content => sub {
- # propagate staff ids and names to javascript
- my @alist = map $_->{aid}, @{$frm->{credits}}, @{$frm->{seiyuu}};
- script_json staffdata => {
- map +($_->{aid}, {id => $_->{id}, aid => $_->{aid}, name => $_->{name}}),
- @alist ? @{$self->dbStaffGet(aid => \@alist, results => 200)} : ()
- };
- div class => 'warning';
- lit 'Please check the <a href="/d2.3">staff editing guidelines</a>. You can'
- .' <a href="/s/new">create a new staff entry</a> if it is not in the database yet,'
- .' but please <a href="/s/all">check for aliasses first</a>.';
- end;
- br;
- table; tbody id => 'credits_tbl';
- Tr id => 'credits_loading'; td colspan => '4', 'Loading...'; end;
- end; end;
- h2 'Add staff';
- table; Tr;
- td class => 'tc_staff';
- input id => 'credit_input', type => 'text', class => 'text', style => 'width: 300px'; end;
- td colspan => 3, '';
- end; end;
- }]],
-
- # Cast tab is only shown for VNs with some characters listed.
- # There's no way to add voice actors in new VN edits since character list
- # would be empty anyway.
- @{$chars} ? (vn_cast => [ 'Cast',
- [ json => short => 'seiyuu' ],
- [ static => nolabel => 1, content => sub {
- if (@$import) {
- script_json castimpdata => [
- map { my $c = $_; +{ map { $_ => $c->{$_} } qw|cid sid aid name| } } @$import
- ];
- div id => 'cast_import';
- a href => '#', title => 'Import character cast from related visual novels', 'Import cast';
- end;
- }
- table; tbody id => 'cast_tbl';
- Tr id => 'cast_loading'; td colspan => '4', 'Loading...'; end;
- end; end;
- h2 'Add cast';
- table; Tr;
- td class => 'tc_char';
- Select id =>'cast_chars';
- option value => '', 'Select character';
- for my $i (0..$#$chars) {
- my($name, $id) = @{$chars->[$i]}{qw|name id|};
- # append character IDs to coinciding names
- # (assume dbCharGet sorted characters by name)
- $name .= ' - c'.$id if $name eq ($chars->[$i+1]{name}//'')
- .. $name ne ($chars->[$i+1]{name}//'');
- option value => $id, $name;
- }
- end;
- txt ' voiced by';
- end;
- td class => 'tc_staff';
- input id => 'cast_input', type => 'text', class => 'text', style => 'width: 300px';
- end;
- td colspan => 2, '';
- end; end;
- }]]) : (),
-
- vn_rel => [ 'Relations',
- [ hidden => short => 'vnrelations' ],
- [ static => nolabel => 1, content => sub {
- h2 'Selected relations';
- table;
- tbody id => 'relation_tbl';
- # to be filled using javascript
- end;
- end;
-
- h2 'Add relation';
- table;
- Tr id => 'relation_new';
- td class => 'tc_vn';
- input type => 'text', class => 'text';
- end;
- td class => 'tc_rel';
- txt 'is an ';
- input type => 'checkbox', id => 'official', checked => 'checked';
- label for => 'official', 'official';
- Select;
- option value => $_, $self->{vn_relations}{$_}[1]
- for (keys %{$self->{vn_relations}});
- end;
- txt ' of';
- end;
- td class => 'tc_title', $v ? $v->{title} : '';
- td class => 'tc_add';
- a href => '#', 'add';
- end;
- end;
- end 'table';
- }],
- ],
-
- vn_scr => [ 'Screenshots', !@$r ? (
- [ static => nolabel => 1, content => 'No releases in the database yet. Screenshots can only be uploaded after a release has been added.' ],
- ) : (
- [ json => short => 'screenshots' ],
- [ static => nolabel => 1, content => sub {
- my @scr = map $_->{id}, @{$frm->{screenshots}};
- my %scr = map +($_->{id}, [ $_->{width}, $_->{height}]), @scr ? @{$self->dbScreenshotGet(\@scr)} : ();
- my @rels = map [ $_->{id}, sprintf '[%s] %s (r%d)', join(',', @{$_->{languages}}), $_->{title}, $_->{id} ], @$r;
- script_json screendata => {
- size => \%scr,
- rel => \@rels,
- staticurl => $self->{url_static},
- };
- div class => 'warning';
- lit 'Please keep the following in mind when uploading screenshots:<br />'
- .'- Screenshots have to be in the native resolution of the game,<br />'
- .'- Remove any window borders and make sure the image is unmarked,<br />'
- .'- Don\'t only upload event CGs.<br />'
- .'Please read the <a href="/d2#6">guidelines</a> for more information.<br />'
- .'Make sure to submit the form after the upload has finished!';
- end;
- br;
- table class => 'stripe';
- tbody id => 'scr_table', '';
- end;
- }],
- )]
-
- );
-}
-
-
-# Update reverse relations and regenerate relation graph
-# Arguments: %old. %new, vid, rev
-# %old,%new -> { vid => [ relation, official ], .. }
-# from the perspective of vid
-# rev is of the related edit
-sub _updreverse {
- my($self, $old, $new, $vid, $rev) = @_;
- my %upd;
-
- # compare %old and %new
- for (keys %$old, keys %$new) {
- if(exists $$old{$_} and !exists $$new{$_}) {
- $upd{$_} = undef;
- } elsif((!exists $$old{$_} and exists $$new{$_}) || ($$old{$_}[0] ne $$new{$_}[0] || !$$old{$_}[1] != !$$new{$_}[1])) {
- $upd{$_} = [ $self->{vn_relations}{ $$new{$_}[0] }[0], $$new{$_}[1] ];
- }
- }
- return if !keys %upd;
-
- # edit all related VNs
- for my $i (keys %upd) {
- my $r = $self->dbVNGetRev(id => $i, what => 'relations')->[0];
- my @newrel = map $_->{id} != $vid ? [ $_->{relation}, $_->{id}, $_->{official} ] : (), @{$r->{relations}};
- push @newrel, [ $upd{$i}[0], $vid, $upd{$i}[1] ] if $upd{$i};
- $self->dbItemEdit(v => $r->{id}, $r->{rev},
- relations => \@newrel,
- editsum => "Reverse relation update caused by revision v$vid.$rev",
- uid => 1, # Multi
- );
- }
-}
-
-
-# peforms a (simple) search and returns the results in XML format
-sub vnxml {
- my $self = shift;
-
- my $q = $self->formValidate({ get => 'q', maxlength => 500 });
- return $self->resNotFound if $q->{_err};
- $q = $q->{q};
-
- my($list, $np) = $self->dbVNGet(
- $q =~ /^v([1-9]\d*)/ ? (id => $1) : (search => $q),
- results => 10,
- page => 1,
- );
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'vns', more => $np ? 'yes' : 'no', query => $q;
- for(@$list) {
- tag 'item', id => $_->{id}, $_->{title};
- }
- end;
-}
-
-
-# handles uploading screenshots and fetching information about them
-sub scrxml {
- my $self = shift;
- return $self->htmlDenied if !$self->authCan('edit') || $self->reqMethod ne 'POST';
-
- # upload new screenshot
- my $id = 0;
- my $imgdata = $self->reqUploadRaw('file');
- $id = -2 if !$imgdata;
- $id = -1 if !$id && $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG headers
-
- # no error? process it
- my($ow, $oh);
- if(!$id) {
- my $im = Image::Magick->new;
- $im->BlobToImage($imgdata);
- $im->Set(background => '#000000');
- $im->Set(alpha => 'Remove');
- $im->Set(magick => 'JPEG');
- $im->Set(quality => 90);
- ($ow, $oh) = ($im->Get('width'), $im->Get('height'));
-
- $id = $self->dbScreenshotAdd($ow, $oh);
- my $fn = imgpath(sf => $id);
- $im->Write($fn);
- chmod 0666, $fn;
-
- # thumbnail
- my($nw, $nh) = imgsize($ow, $oh, @{$self->{scr_size}});
- $im->Thumbnail(width => $nw, height => $nh);
- $im->Set(quality => 90);
- $fn = imgpath(st => $id);
- $im->Write($fn);
- chmod 0666, $fn;
- }
-
- $self->resHeader('Content-type' => 'text/xml; charset=UTF-8');
- xml;
- tag 'image', id => $id, $id > 0 ? (width => $ow, height => $oh) : (), undef;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Handler/VNPage.pm b/lib/VNDB/Handler/VNPage.pm
deleted file mode 100644
index 5f335019..00000000
--- a/lib/VNDB/Handler/VNPage.pm
+++ /dev/null
@@ -1,982 +0,0 @@
-
-package VNDB::Handler::VNPage;
-
-use strict;
-use warnings;
-use TUWF ':html', 'xml_escape';
-use VNDB::Func;
-
-
-TUWF::register(
- qr{v/rand} => \&rand,
- qr{v([1-9]\d*)/rg} => \&rg,
- qr{v([1-9]\d*)/releases} => \&releases,
- qr{v([1-9]\d*)/(chars)} => \&page,
- qr{v([1-9]\d*)/staff} => sub { $_[0]->resRedirect("/v$_[1]#staff") },
- qr{v([1-9]\d*)(?:\.([1-9]\d*))?} => \&page,
-);
-
-
-sub rand {
- my $self = shift;
- $self->resRedirect('/v'.$self->filFetchDB(vn => undef, undef, {results => 1, sort => 'rand'})->[0]{id}, 'temp');
-}
-
-
-sub rg {
- my($self, $vid) = @_;
-
- my $v = $self->dbVNGet(id => $vid, what => 'relgraph')->[0];
- return $self->resNotFound if !$v->{id} || !$v->{rgraph};
-
- my $title = "Relation graph for $v->{title}";
- return if $self->htmlRGHeader($title, 'v', $v);
-
- $v->{svg} =~ s/id="node_v$vid"/id="graph_current"/;
-
- div class => 'mainbox';
- h1 $title;
- p 'Note: Unofficial relations are excluded if the graph would otherwise be too large.';
- p class => 'center';
- lit $v->{svg};
- end;
- end;
- $self->htmlFooter;
-}
-
-
-# Description of each column, field:
-# id: Identifier used in URLs
-# sort_field: Name of the field when sorting
-# what: Required dbReleaseGet 'what' flag
-# column_string: String to use as column header
-# column_width: Maximum width (in pixels) of the column in 'restricted width' mode
-# button_string: String to use for the hide/unhide button
-# na_for_patch: When the field is N/A for patch releases
-# default: Set when it's visible by default
-# has_data: Subroutine called with a release object, should return true if the release has data for the column
-# draw: Subroutine called with a release object, should draw its column contents
-my @rel_cols = (
- { # Title
- id => 'tit',
- sort_field => 'title',
- column_string => 'Title',
- draw => sub { a href => "/r$_[0]{id}", shorten $_[0]{title}, 60 },
- }, { # Type
- id => 'typ',
- sort_field => 'type',
- button_string => 'Type',
- default => 1,
- draw => sub { cssicon "rt$_[0]{type}", $_[0]{type}; txt '(patch)' if $_[0]{patch} },
- }, { # Languages
- id => 'lan',
- button_string => 'Language',
- default => 1,
- has_data => sub { !!@{$_[0]{languages}} },
- draw => sub {
- for(@{$_[0]{languages}}) {
- cssicon "lang $_", $TUWF::OBJ->{languages}{$_};
- br if $_ ne $_[0]{languages}[$#{$_[0]{languages}}];
- }
- },
- }, { # Publication
- id => 'pub',
- sort_field => 'publication',
- column_string => 'Publication',
- column_width => 70,
- button_string => 'Publication',
- default => 1,
- what => 'extended',
- draw => sub { txt join ', ', $_[0]{freeware} ? 'Freeware' : 'Non-free', $_[0]{patch} ? () : ($_[0]{doujin} ? 'doujin' : 'commercial') },
- }, { # Platforms
- id => 'pla',
- button_string => 'Platforms',
- default => 1,
- what => 'platforms',
- has_data => sub { !!@{$_[0]{platforms}} },
- draw => sub {
- for(@{$_[0]{platforms}}) {
- cssicon $_, $TUWF::OBJ->{platforms}{$_};
- br if $_ ne $_[0]{platforms}[$#{$_[0]{platforms}}];
- }
- txt 'Unknown' if !@{$_[0]{platforms}};
- },
- }, { # Media
- id => 'med',
- column_string => 'Media',
- button_string => 'Media',
- what => 'media',
- has_data => sub { !!@{$_[0]{media}} },
- draw => sub {
- for(@{$_[0]{media}}) {
- txt fmtmedia($_->{medium}, $_->{qty});
- br if $_ ne $_[0]{media}[$#{$_[0]{media}}];
- }
- txt 'Unknown' if !@{$_[0]{media}};
- },
- }, { # Resolution
- id => 'res',
- sort_field => 'resolution',
- column_string => 'Resolution',
- button_string => 'Resolution',
- na_for_patch => 1,
- default => 1,
- what => 'extended',
- has_data => sub { !!$_[0]{resolution} },
- draw => sub {
- if($_[0]{resolution}) {
- txt $TUWF::OBJ->{resolutions}[$_[0]{resolution}][0];
- } else {
- txt 'Unknown';
- }
- },
- }, { # Voiced
- id => 'voi',
- sort_field => 'voiced',
- column_string => 'Voiced',
- column_width => 70,
- button_string => 'Voiced',
- na_for_patch => 1,
- default => 1,
- what => 'extended',
- has_data => sub { !!$_[0]{voiced} },
- draw => sub { txt $TUWF::OBJ->{voiced}[$_[0]{voiced}] },
- }, { # Animation
- id => 'ani',
- sort_field => 'ani_ero',
- column_string => 'Animation',
- column_width => 110,
- button_string => 'Animation',
- na_for_patch => '1',
- what => 'extended',
- has_data => sub { !!($_[0]{ani_story} || $_[0]{ani_ero}) },
- draw => sub {
- txt join ', ',
- $_[0]{ani_story} ? "Story: $TUWF::OBJ->{animated}[$_[0]{ani_story}]" :(),
- $_[0]{ani_ero} ? "Ero scenes: $TUWF::OBJ->{animated}[$_[0]{ani_ero}]":();
- txt 'Unknown' if !$_[0]{ani_story} && !$_[0]{ani_ero};
- },
- }, { # Released
- id => 'rel',
- sort_field => 'released',
- column_string => 'Released',
- button_string => 'Released',
- default => 1,
- draw => sub { lit fmtdatestr $_[0]{released} },
- }, { # Age rating
- id => 'min',
- sort_field => 'minage',
- button_string => 'Age rating',
- default => 1,
- has_data => sub { $_[0]{minage} != -1 },
- draw => sub { txt minage $_[0]{minage} },
- }, { # Notes
- id => 'not',
- sort_field => 'notes',
- column_string => 'Notes',
- column_width => 400,
- button_string => 'Notes',
- default => 1,
- what => 'extended',
- has_data => sub { !!$_[0]{notes} },
- draw => sub { lit bb2html $_[0]{notes} },
- }
-);
-
-
-sub releases {
- my($self, $vid) = @_;
-
- my $v = $self->dbVNGet(id => $vid)->[0];
- return $self->resNotFound if !$v->{id};
-
- my $title = "Releases for $v->{title}";
- $self->htmlHeader(title => $title);
- $self->htmlMainTabs('v', $v, 'releases');
-
- my $f = $self->formValidate(
- map({ get => $_->{id}, required => 0, default => $_->{default}||0, enum => [0,1] }, grep $_->{button_string}, @rel_cols),
- { get => 'cw', required => 0, default => 0, enum => [0,1] },
- { get => 'o', required => 0, default => 0, enum => [0,1] },
- { get => 's', required => 0, default => 'released', enum => [ map $_->{sort_field}, grep $_->{sort_field}, @rel_cols ]},
- { get => 'os', required => 0, default => 'all', enum => [ 'all', keys %{$self->{platforms}} ] },
- { get => 'lang', required => 0, default => 'all', enum => [ 'all', keys %{$self->{languages}} ] },
- );
- return $self->resNotFound if $f->{_err};
-
- # Get the release info
- my %what = map +($_->{what}, 1), grep $_->{what} && $f->{$_->{id}}, @rel_cols;
- my $r = $self->dbReleaseGet(vid => $vid, what => join(' ', keys %what), sort => $f->{s}, reverse => $f->{o}, results => 200);
-
- # url generator
- my $url = sub {
- my %u = (%$f, @_);
- return "/v$vid/releases?".join(';', map "$_=$u{$_}", sort keys %u);
- };
-
- div class => 'mainbox releases_compare';
- h1 $title;
-
- if(!@$r) {
- td 'We don\'t have any information about releases of this visual novel yet...';
- } else {
- _releases_buttons($self, $f, $url, $r);
- }
- end 'div';
-
- _releases_table($self, $f, $url, $r) if @$r;
- $self->htmlFooter;
-}
-
-
-sub _releases_buttons {
- my($self, $f, $url, $r) = @_;
-
- # Column visibility
- p class => 'browseopts';
- a href => $url->($_->{id}, $f->{$_->{id}} ? 0 : 1), $f->{$_->{id}} ? (class => 'optselected') : (), $_->{button_string}
- for (grep $_->{button_string}, @rel_cols);
- end;
-
- # Misc options
- my $all_selected = !grep $_->{button_string} && !$f->{$_->{id}}, @rel_cols;
- my $all_unselected = !grep $_->{button_string} && $f->{$_->{id}}, @rel_cols;
- my $all_url = sub { $url->(map +($_->{id},$_[0]), grep $_->{button_string}, @rel_cols); };
- p class => 'browseopts';
- a href => $all_url->(1), $all_selected ? (class => 'optselected') : (), 'All on';
- a href => $all_url->(0), $all_unselected ? (class => 'optselected') : (), 'All off';
- a href => $url->('cw', $f->{cw} ? 0 : 1), $f->{cw} ? (class => 'optselected') : (), 'Restrict column width';
- end;
-
- # Platform/language filters
- my $plat_lang_draw = sub {
- my($row, $option, $txt, $csscat) = @_;
- my %opts = map +($_,1), map @{$_->{$row}}, @$r;
- return if !keys %opts;
- p class => 'browseopts';
- for('all', sort keys %opts) {
- a href => $url->($option, $_), $_ eq $f->{$option} ? (class => 'optselected') : ();
- $_ eq 'all' ? txt 'All' : cssicon "$csscat $_", $txt->{$_};
- end 'a';
- }
- end 'p';
- };
- $plat_lang_draw->('platforms', 'os', $self->{platforms}, '') if $f->{pla};
- $plat_lang_draw->('languages', 'lang',$self->{languages}, 'lang') if $f->{lan};
-}
-
-
-sub _releases_table {
- my($self, $f, $url, $r) = @_;
-
- # Apply language and platform filters
- my @r = grep +
- ($f->{os} eq 'all' || ($_->{platforms} && grep $_ eq $f->{os}, @{$_->{platforms}})) &&
- ($f->{lang} eq 'all' || ($_->{languages} && grep $_ eq $f->{lang}, @{$_->{languages}})), @$r;
-
- # Figure out which columns to display
- my @col;
- for my $c (@rel_cols) {
- next if $c->{button_string} && !$f->{$c->{id}}; # Hidden by settings
- push @col, $c if !@r || !$c->{has_data} || grep $c->{has_data}->($_), @r; # Must have relevant data
- }
-
- div class => 'mainbox releases_compare';
- table;
-
- thead;
- Tr;
- for my $c (@col) {
- td class => 'key';
- txt $c->{column_string} if $c->{column_string};
- for($c->{sort_field} ? (0,1) : ()) {
- my $active = $f->{s} eq $c->{sort_field} && !$f->{o} == !$_;
- a href => $url->(o => $_, s => $c->{sort_field}) if !$active;
- lit $_ ? "\x{25BE}" : "\x{25B4}";
- end 'a' if !$active;
- }
- end 'td';
- }
- end 'tr';
- end 'thead';
-
- for my $r (@r) {
- Tr;
- # Combine "N/A for patches" columns
- my $cspan = 1;
- for my $c (0..$#col) {
- if($r->{patch} && $col[$c]{na_for_patch} && $c < $#col && $col[$c+1]{na_for_patch}) {
- $cspan++;
- next;
- }
- td $cspan > 1 ? (colspan => $cspan) : (),
- $col[$c]{column_width} && $f->{cw} ? (style => "max-width: $col[$c]{column_width}px") : ();
- if($r->{patch} && $col[$c]{na_for_patch}) {
- txt 'NA for patches';
- } else {
- $col[$c]{draw}->($r);
- }
- end;
- $cspan = 1;
- }
- end;
- }
- end 'table';
- end 'div';
-}
-
-
-sub page {
- my($self, $vid, $rev) = @_;
-
- my $char = $rev && $rev eq 'chars';
- $rev = undef if $char;
-
- my $method = $rev ? 'dbVNGetRev' : 'dbVNGet';
- my $v = $self->$method(
- id => $vid,
- what => 'extended anime relations screenshots rating ranking staff'.($rev ? ' seiyuu' : ''),
- $rev ? (rev => $rev) : (),
- )->[0];
- return $self->resNotFound if !$v->{id};
-
- my $r = $self->dbReleaseGet(vid => $vid, what => 'producers platforms', results => 200);
-
- my $metadata = {
- 'og:title' => $v->{title},
- 'og:description' => $v->{desc},
- };
-
- if($v->{image} && !$v->{img_nsfw}) {
- $metadata->{'og:image'} = imgurl(cv => $v->{image});
- } elsif(my ($ss) = grep !$_->{nsfw}, @{$v->{screenshots}}) {
- $metadata->{'og:image'} = imgurl(st => $ss->{id});
- }
-
- $self->htmlHeader(title => $v->{title}, noindex => $rev, metadata => $metadata);
- $self->htmlMainTabs('v', $v);
- return if $self->htmlHiddenMessage('v', $v);
-
- _revision($self, $v, $rev);
-
- div class => 'mainbox';
- $self->htmlItemMessage('v', $v);
- h1 $v->{title};
- h2 class => 'alttitle', $v->{original} if $v->{original};
-
- div class => 'vndetails';
-
- # image
- div class => 'vnimg';
- if(!$v->{image}) {
- p 'No image uploaded yet';
- } else {
- p $v->{img_nsfw} ? (id => 'nsfw_hid', $self->authPref('show_nsfw') ? () : (class => 'hidden')) : ();
- img src => imgurl(cv => $v->{image}), alt => $v->{title};
- i 'Flagged as NSFW' if $v->{img_nsfw};
- end;
- if($v->{img_nsfw}) {
- p id => 'nsfw_show', $self->authPref('show_nsfw') ? (class => 'hidden') : ();
- txt 'This image has been flagged as Not Safe For Work.';
- br; br;
- a href => '#', 'Show me anyway';
- br; br;
- txt '(This warning can be disabled in your account)';
- end;
- }
- }
- end 'div'; # /vnimg
-
- # general info
- table class => 'stripe';
- Tr;
- td class => 'key', 'Title';
- td $v->{title};
- end;
- if($v->{original}) {
- Tr;
- td 'Original title';
- td $v->{original};
- end;
- }
- if($v->{alias}) {
- $v->{alias} =~ s/\n/, /g;
- Tr;
- td 'Aliases';
- td $v->{alias};
- end;
- }
- if($v->{length}) {
- Tr;
- td 'Length';
- td fmtvnlen $v->{length}, 1;
- end;
- }
- my @links = (
- $v->{l_wp} ? [ 'Wikipedia', 'http://en.wikipedia.org/wiki/%s', $v->{l_wp} ] : (),
- $v->{l_encubed} ? [ 'Encubed', 'http://novelnews.net/tag/%s/', $v->{l_encubed} ] : (),
- $v->{l_renai} ? [ 'Renai.us', 'http://renai.us/game/%s.shtml', $v->{l_renai} ] : (),
- );
- if(@links) {
- Tr;
- td 'Links';
- td;
- for(@links) {
- a href => sprintf($_->[1], $_->[2]), $_->[0];
- txt ', ' if $_ ne $links[$#links];
- }
- end;
- end;
- }
-
- _producers($self, $r);
- _relations($self, $v) if @{$v->{relations}};
- _anime($self, $v) if @{$v->{anime}};
- _useroptions($self, $v) if $self->authInfo->{id};
- _affiliate_links($self, $r);
-
- Tr class => 'nostripe';
- td class => 'vndesc', colspan => 2;
- h2 'Description';
- p;
- lit $v->{desc} ? bb2html $v->{desc} : '-';
- end;
- end;
- end;
-
- end 'table';
- end 'div';
- div class => 'clearfloat', style => 'height: 5px', ''; # otherwise the tabs below aren't positioned correctly
-
- # tags
- my $t = $self->dbTagStats(vid => $v->{id}, sort => 'rating', reverse => 1, minrating => 0, results => 999);
- if(@$t) {
- div id => 'tagops';
- # NOTE: order of these links is hardcoded in JS
- my $tags_cat = $self->authPref('tags_cat') || $self->{default_tags_cat};
- a href => "#$_", $tags_cat =~ /\Q$_/ ? (class => 'tsel') : (), lc $self->{tag_categories}{$_} for keys %{$self->{tag_categories}};
- my $spoiler = $self->authPref('spoilers') || 0;
- a href => '#', class => 'sec'.($spoiler == 0 ? ' tsel' : ''), lc 'Hide spoilers';
- a href => '#', $spoiler == 1 ? (class => 'tsel') : (), lc 'Show minor spoilers';
- a href => '#', $spoiler == 2 ? (class => 'tsel') : (), lc 'Spoil me!';
- a href => '#', class => 'sec'.($self->authPref('tags_all') ? '': ' tsel'), 'summary';
- a href => '#', $self->authPref('tags_all') ? (class => 'tsel') : (), 'all';
- end;
- div id => 'vntags';
- for (@$t) {
- span class => sprintf 'tagspl%.0f cat_%s %s', $_->{spoiler}, $_->{cat}, $_->{spoiler} > 0 ? 'hidden' : '';
- a href => "/g$_->{id}", style => sprintf('font-size: %dpx', $_->{rating}*3.5+6), $_->{name};
- b class => 'grayedout', sprintf ' %.1f', $_->{rating};
- end;
- txt ' ';
- }
- end;
- }
- end 'div'; # /mainbox
-
- my $chars = $self->dbCharGet(vid => $v->{id}, what => "seiyuu vns($v->{id})".($char ? ' extended traits' : ''), results => 500);
- if(@$chars || $self->authCan('edit')) {
- clearfloat; # fix tabs placement when tags are hidden
- ul class => 'maintabs notfirst';
- if(@$chars) {
- li class => 'left '.(!$char ? ' tabselected' : ''); a href => "/v$v->{id}#main", name => 'main', 'main'; end;
- li class => 'left '.($char ? ' tabselected' : ''); a href => "/v$v->{id}/chars#chars", name => 'chars', 'characters'; end;
- }
- if($self->authCan('edit')) {
- li; a href => "/c/new?vid=$v->{id}", 'add character'; end;
- li; a href => "/v$v->{id}/add", 'add release'; end;
- }
- end;
- }
-
- if($char) {
- _chars($self, $chars, $v);
- } else {
- _releases($self, $v, $r);
- _staff($self, $v);
- _charsum($self, $chars, $v);
- _stats($self, $v);
- _screenshots($self, $v, $r) if @{$v->{screenshots}};
- }
-
- $self->htmlFooter;
-}
-
-
-sub _revision {
- my($self, $v, $rev) = @_;
- return if !$rev;
-
- my $prev = $rev && $rev > 1 && $self->dbVNGetRev(
- id => $v->{id}, rev => $rev-1, what => 'extended anime relations screenshots staff seiyuu'
- )->[0];
-
- $self->htmlRevision('v', $prev, $v,
- [ title => 'Title (romaji)', diff => 1 ],
- [ original => 'Original title', diff => 1 ],
- [ alias => 'Alias', diff => qr/[ ,\n\.]/ ],
- [ desc => 'Description', diff => qr/[ ,\n\.]/ ],
- [ length => 'Length', serialize => sub { fmtvnlen $_[0] } ],
- [ l_wp => 'Wikipedia link', htmlize => sub {
- $_[0] ? sprintf '<a href="http://en.wikipedia.org/wiki/%s">%1$s</a>', xml_escape $_[0] : '[empty]'
- }],
- [ l_encubed => 'Encubed tag', htmlize => sub {
- $_[0] ? sprintf '<a href="http://novelnews.net/tag/%s/">%1$s</a>', xml_escape $_[0] : '[empty]'
- }],
- [ l_renai => 'Renai.us link', htmlize => sub {
- $_[0] ? sprintf '<a href="http://renai.us/game/%s.shtml">%1$s</a>', xml_escape $_[0] : '[empty]'
- }],
- [ credits => 'Credits', join => '<br />', split => sub {
- my @r = map sprintf('<a href="/s%d" title="%s">%s</a> [%s]%s', $_->{id},
- xml_escape($_->{original}||$_->{name}), xml_escape($_->{name}), xml_escape($self->{staff_roles}{$_->{role}}),
- $_->{note} ? ' ['.xml_escape($_->{note}).']' : ''),
- sort { $a->{id} <=> $b->{id} || $a->{role} cmp $b->{role} } @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- [ seiyuu => 'Seiyuu', join => '<br />', split => sub {
- my @r = map sprintf('<a href="/s%d" title="%s">%s</a> as %s%s',
- $_->{id}, xml_escape($_->{original}||$_->{name}), xml_escape($_->{name}), xml_escape($_->{cname}),
- $_->{note} ? ' ['.xml_escape($_->{note}).']' : ''),
- sort { $a->{id} <=> $b->{id} || $a->{cid} <=> $b->{cid} || $a->{note} cmp $b->{note} } @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- [ relations => 'Relations', join => '<br />', split => sub {
- my @r = map sprintf('[%s] %s: <a href="/v%d" title="%s">%s</a>',
- $_->{official} ? 'official' : 'unofficial', $self->{vn_relations}{$_->{relation}}[1],
- $_->{id}, xml_escape($_->{original}||$_->{title}), xml_escape shorten $_->{title}, 40
- ), sort { $a->{id} <=> $b->{id} } @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- [ anime => 'Anime', join => ', ', split => sub {
- my @r = map sprintf('<a href="http://anidb.net/a%d">a%1$d</a>', $_->{id}), sort { $a->{id} <=> $b->{id} } @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- [ screenshots => 'Screenshots', join => '<br />', split => sub {
- my @r = map sprintf('[%s] <a href="%s" data-iv="%dx%d">%d</a> (%s)',
- $_->{rid} ? qq|<a href="/r$_->{rid}">r$_->{rid}</a>| : 'no release',
- imgurl(sf => $_->{id}), $_->{width}, $_->{height}, $_->{id},
- $_->{nsfw} ? 'Not safe' : 'Safe'
- ), @{$_[0]};
- return @r ? @r : ('[empty]');
- }],
- [ image => 'Image', htmlize => sub {
- my $url = imgurl(cv => $_[0]);
- if($_[0]) {
- return $_[1]->{img_nsfw} && !$self->authPref('show_nsfw') ? "<a href=\"$url\">(NSFW)</a>" : "<img src=\"$url\" />";
- } else {
- return 'No image';
- }
- }],
- [ img_nsfw => 'Image NSFW', serialize => sub { $_[0] ? 'Not safe' : 'Safe' } ],
- );
-}
-
-
-sub _producers {
- my($self, $r) = @_;
-
- my %lang;
- my @lang = grep !$lang{$_}++, map @{$_->{languages}}, @$r;
-
- if(grep $_->{developer}, map @{$_->{producers}}, @$r) {
- my %dev = map $_->{developer} ? ($_->{id} => $_) : (), map @{$_->{producers}}, @$r;
- my @dev = values %dev;
- Tr;
- td 'Developer';
- td;
- for (@dev) {
- a href => "/p$_->{id}", title => $_->{original}||$_->{name}, shorten $_->{name}, 30;
- txt ' & ' if $_ != $dev[$#dev];
- }
- end;
- end;
- }
-
- if(grep $_->{publisher}, map @{$_->{producers}}, @$r) {
- Tr;
- td 'Publishers';
- td;
- for my $l (@lang) {
- my %p = map $_->{publisher} ? ($_->{id} => $_) : (), map @{$_->{producers}}, grep grep($_ eq $l, @{$_->{languages}}), @$r;
- my @p = values %p;
- next if !@p;
- cssicon "lang $l", $self->{languages}{$l};
- for (@p) {
- a href => "/p$_->{id}", title => $_->{original}||$_->{name}, shorten $_->{name}, 30;
- txt ' & ' if $_ != $p[$#p];
- }
- br;
- }
- end;
- end 'tr';
- }
-}
-
-
-sub _relations {
- my($self, $v) = @_;
-
- my %rel;
- push @{$rel{$_->{relation}}}, $_
- for (sort { $a->{title} cmp $b->{title} } @{$v->{relations}});
-
-
- Tr;
- td 'Relations';
- td class => 'relations';
- dl;
- for(sort keys %rel) {
- dt $self->{vn_relations}{$_}[1];
- dd;
- for (@{$rel{$_}}) {
- b class => 'grayedout', '[unofficial] ' if !$_->{official};
- a href => "/v$_->{id}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40;
- br;
- }
- end;
- }
- end;
- end;
- end 'tr';
-}
-
-
-sub _anime {
- my($self, $v) = @_;
-
- Tr;
- td 'Related anime';
- td class => 'anime';
- for (sort { ($a->{year}||9999) <=> ($b->{year}||9999) } @{$v->{anime}}) {
- if(!$_->{lastfetch} || !$_->{year} || !$_->{title_romaji}) {
- b;
- lit sprintf '[no information available at this time: <a href="http://anidb.net/a%d">%1$d</a>]', $_->{id};
- end;
- } else {
- b;
- txt '[';
- a href => "http://anidb.net/a$_->{id}", title => 'AniDB', 'DB';
- # AnimeNFO links seem to be broken at the moment. TODO: Completely remove?
- #if($_->{nfo_id}) {
- # txt '-';
- # a href => "http://animenfo.com/animetitle,$_->{nfo_id},a.html", title => 'AnimeNFO', 'NFO';
- #}
- if($_->{ann_id}) {
- txt '-';
- a href => "http://www.animenewsnetwork.com/encyclopedia/anime.php?id=$_->{ann_id}", title => 'Anime News Network', 'ANN';
- }
- txt '] ';
- end;
- abbr title => $_->{title_kanji}||$_->{title_romaji}, shorten $_->{title_romaji}, 50;
- b ' ('.(defined $_->{type} ? $self->{anime_types}{$_->{type}}.', ' : '').$_->{year}.')';
- br;
- }
- }
- end;
- end 'tr';
-}
-
-
-sub _useroptions {
- my($self, $v) = @_;
-
- 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];
-
- Tr;
- td 'User options';
- td;
- if($vote || !$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: $self->{vnlist_status}[$list->{status}]" : 'not on your VN list';
- optgroup label => $list ? 'Change status' : 'Add to VN list';
- option value => $_, $self->{vnlist_status}[$_] for (0..$#{$self->{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: $self->{wishlist_status}[$wish->{wstat}]" : 'not on your wishlist';
- optgroup label => $wish ? 'Change status' : 'Add to wishlist';
- option value => $_, $self->{wishlist_status}[$_] for (0..$#{$self->{wishlist_status}});
- end;
- option value => -1, 'remove from wishlist' if $wish;
- end;
- }
- end;
- end 'tr';
-}
-
-
-sub _affiliate_links {
- my($self, $r) = @_;
- return if !keys @$r;
- my %r = map +($_->{id}, $_), @$r;
- my $links = $self->dbAffiliateGet(rids => [ keys %r ], hidden => 0);
- return if !@$links;
-
- $links = [ sort { $b->{priority}||$self->{affiliates}[$b->{affiliate}]{default_prio} <=> $a->{priority}||$self->{affiliates}[$a->{affiliate}]{default_prio} } @$links ];
-
- Tr id => 'buynow';
- td 'Available at';
- td;
- for my $link (@$links) {
- my $f = $self->{affiliates}[$link->{affiliate}];
- my $rel = $r{$link->{rid}};
- my $plat = join(' and ', map $self->{platforms}{$_}, @{$rel->{platforms}});
- my $version = join(' and ', map $self->{languages}{$_}, @{$rel->{languages}}).' '.$plat.' version';
-
- a rel => 'nofollow', href => $f->{link_format} ? $f->{link_format}->($link->{url}) : $link->{url};
- use utf8;
- txt $link->{version}
- || ($f->{default_version} && $f->{default_version}->($self, $link, $rel))
- || $version;
- txt " at $f->{name}";
- abbr class => 'pricenote', title =>
- $link->{lastfetch} ? sprintf('Last updated: %s.', fmtage($link->{lastfetch})) : '', " for $link->{price}"
- if $link->{price};
- txt ' »';
- end;
- br;
- }
- end;
- end;
-}
-
-
-sub _releases {
- my($self, $v, $r) = @_;
-
- div class => 'mainbox releases';
- h1 'Releases';
- if(!@$r) {
- p 'We don\'t have any information about releases of this visual novel yet...';
- end;
- return;
- }
-
- if($self->authInfo->{id}) {
- my $l = $self->dbRListGet(uid => $self->authInfo->{id}, rid => [map $_->{id}, @$r]);
- for my $i (@$l) {
- [grep $i->{rid} == $_->{id}, @$r]->[0]{ulist} = $i;
- }
- div id => 'vnrlist_code', class => 'hidden', $self->authGetCode('/xml/rlist.xml');
- }
-
- my %lang;
- my @lang = grep !$lang{$_}++, map @{$_->{languages}}, @$r;
-
- table;
- for my $l (@lang) {
- Tr class => 'lang';
- td colspan => 6;
- cssicon "lang $l", $self->{languages}{$l};
- txt $self->{languages}{$l};
- end;
- end;
- for my $rel (grep grep($_ eq $l, @{$_->{languages}}), @$r) {
- Tr;
- td class => 'tc1'; lit fmtdatestr $rel->{released}; end;
- td class => 'tc2', $rel->{minage} < 0 ? '' : minage $rel->{minage};
- td class => 'tc3';
- for (sort @{$rel->{platforms}}) {
- next if $_ eq 'oth';
- cssicon $_, $self->{platforms}{$_};
- }
- cssicon "rt$rel->{type}", $rel->{type};
- end;
- td class => 'tc4';
- a href => "/r$rel->{id}", title => $rel->{original}||$rel->{title}, $rel->{title};
- b class => 'grayedout', ' (patch)' if $rel->{patch};
- end;
- td class => 'tc5';
- if($self->authInfo->{id}) {
- a href => "/r$rel->{id}", id => "rlsel_$rel->{id}", class => 'vnrlsel',
- $rel->{ulist} ? $self->{rlist_status}[ $rel->{ulist}{status} ] : '--';
- } else {
- txt ' ';
- }
- end;
- td class => 'tc6';
- a href => "/affiliates/new?rid=$rel->{id}", 'a' if $self->authCan('affiliate');
- if($rel->{website}) {
- a href => $rel->{website}, rel => 'nofollow';
- cssicon 'external', 'External link';
- end;
- } else {
- txt ' ';
- }
- end;
- end 'tr';
- }
- }
- end 'table';
- end 'div';
-}
-
-
-sub _screenshots {
- my($self, $v, $r) = @_;
- div class => 'mainbox', id => 'screenshots';
-
- if(grep $_->{nsfw}, @{$v->{screenshots}}) {
- p class => 'nsfwtoggle';
- txt 'Showing ';
- i id => 'nsfwshown', $self->authPref('show_nsfw') ? scalar @{$v->{screenshots}} : scalar grep(!$_->{nsfw}, @{$v->{screenshots}});
- txt sprintf ' out of %d screenshot%s. ', scalar @{$v->{screenshots}}, @{$v->{screenshots}} == 1 ? '' : 's';
- a href => '#', id => "nsfwhide", 'show/hide NSFW';
- end;
- }
-
- h1 'Screenshots';
-
- for my $rel (@$r) {
- my @scr = grep $_->{rid} && $rel->{id} == $_->{rid}, @{$v->{screenshots}};
- next if !@scr;
- p class => 'rel';
- cssicon "lang $_", $self->{languages}{$_} for (@{$rel->{languages}});
- a href => "/r$rel->{id}", $rel->{title};
- end;
- div class => 'scr';
- for (@scr) {
- my($w, $h) = imgsize($_->{width}, $_->{height}, @{$self->{scr_size}});
- a href => imgurl(sf => $_->{id}),
- class => sprintf('scrlnk%s%s', $_->{nsfw} ? ' nsfw':'', $_->{nsfw}&&!$self->authPref('show_nsfw')?' hidden':''),
- 'data-iv' => "$_->{width}x$_->{height}:scr";
- img src => imgurl(st => $_->{id}),
- width => $w, height => $h, alt => "Screenshot #$_->{id}";
- end;
- }
- end;
- }
- end 'div';
-}
-
-
-sub _stats {
- my($self, $v) = @_;
-
- my $stats = $self->dbVoteStats(vid => $v->{id}, 1);
- div class => 'mainbox';
- h1 'User stats';
- if(!grep $_->[0] > 0, @$stats) {
- p 'Nobody has voted on this visual novel yet...';
- } else {
- $self->htmlVoteStats(v => $v, $stats);
- }
- end;
-}
-
-
-sub _charspoillvl {
- my($vid, $c) = @_;
- my $minspoil = 5;
- $minspoil = $_->{vid} == $vid && $_->{spoil} < $minspoil ? $_->{spoil} : $minspoil
- for(@{$c->{vns}});
- return $minspoil;
-}
-
-
-sub _chars {
- my($self, $l, $v) = @_;
- return if !@$l;
- my %done;
- my %rol;
- for my $r (keys %{$self->{char_roles}}) {
- $rol{$r} = [ grep grep($_->{role} eq $r, @{$_->{vns}}) && !$done{$_->{id}}++, @$l ];
- }
- my $first = 0;
- for my $r (keys %{$self->{char_roles}}) {
- next if !@{$rol{$r}};
- div class => 'mainbox';
- $self->charOps(1) if !$first++;
- h1 $self->{char_roles}{$r}[ @{$rol{$r}} > 1 ? 1 : 0 ];
- $self->charTable($_, 1, $_ != $rol{$r}[0], 1, _charspoillvl $v->{id}, $_) for (@{$rol{$r}});
- end;
- }
-}
-
-
-sub _charsum {
- my($self, $l, $v) = @_;
- return if !@$l;
-
- my(@l, %done, $has_spoilers);
- for my $r (keys %{$self->{char_roles}}) {
- last if $r eq 'appears';
- for (grep grep($_->{role} eq $r, @{$_->{vns}}) && !$done{$_->{id}}++, @$l) {
- $_->{role} = $r;
- $has_spoilers = $has_spoilers || _charspoillvl $v->{id}, $_;
- push @l, $_;
- }
- }
-
- div class => 'mainbox charsum summarize';
- $self->charOps(0) if $has_spoilers;
- h1 'Character summary';
- div class => 'charsum_list';
- for my $c (@l) {
- div class => 'charsum_bubble'.($has_spoilers ? ' '.charspoil(_charspoillvl $v->{id}, $c) : '');
- div class => 'name';
- i $self->{char_roles}{$c->{role}}[0];
- cssicon "gen $c->{gender}", $self->{genders}{$c->{gender}} if $c->{gender} ne 'unknown';
- a href => "/c$c->{id}", title => $c->{original}||$c->{name}, $c->{name};
- end;
- if(@{$c->{seiyuu}}) {
- div class => 'actor';
- txt 'Voiced by';
- @{$c->{seiyuu}} > 1 ? br : txt ' ';
- for my $s (sort { $a->{name} cmp $b->{name} } @{$c->{seiyuu}}) {
- a href => "/s$s->{sid}", title => $s->{original}||$s->{name}, $s->{name};
- b class => 'grayedout', $s->{note} if $s->{note};
- br;
- }
- end;
- }
- end;
- }
- end;
- end;
-}
-
-
-sub _staff {
- my ($self, $v) = @_;
- return if !@{$v->{credits}};
-
- div class => 'mainbox staff summarize', 'data-summarize-height' => 100, id => 'staff';
- h1 'Staff';
- for my $r (keys %{$self->{staff_roles}}) {
- my @s = grep $_->{role} eq $r, @{$v->{credits}};
- next if !@s;
- ul;
- li; b $self->{staff_roles}{$r}; end;
- for(@s) {
- li;
- a href => "/s$_->{id}", title => $_->{original}||$_->{name}, $_->{name};
- b class => 'grayedout', $_->{note} if $_->{note};
- end;
- }
- end;
- }
- clearfloat;
- end;
-}
-
-
-1;
-
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm
deleted file mode 100644
index e3ee20eb..00000000
--- a/lib/VNDB/Util/Auth.pm
+++ /dev/null
@@ -1,227 +0,0 @@
-
-package VNDB::Util::Auth;
-
-
-use strict;
-use warnings;
-use Exporter 'import';
-use Digest::SHA qw|sha1 sha1_hex|;
-use Crypt::URandom 'urandom';
-use Crypt::ScryptKDF 'scrypt_raw';
-use Encode 'encode_utf8';
-use TUWF ':html';
-use VNDB::Func;
-
-
-our @EXPORT = qw|
- authInit authLogin authLogout authInfo authCan authSetPass authAdminSetPass
- authResetPass authIsValidToken authGetCode authCheckCode authPref
-|;
-
-
-sub randomascii {
- return join '', map chr($_%92+33), unpack 'C*', urandom shift;
-}
-
-
-# Fetches and parses the auth cookie.
-# Returns (uid, encrypted_token) on success, (0, '') on failure.
-sub parsecookie {
- # Earlier versions of the auth cookie didn't have the dot separator, so that's optional.
- return ($_[0]->reqCookie('auth')||'') =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1 pack 'H*', $1) : (0, '');
-}
-
-
-# initializes authentication information and checks the vndb_auth cookie
-sub authInit {
- my $self = shift;
-
- my($uid, $token_e) = parsecookie($self);
- $self->{_auth} = $uid && $self->dbUserGet(uid => $uid, session => $token_e, what => 'extended notifycount prefs')->[0];
- $self->{_auth}{token} = $token_e if $self->{_auth};
-
- # update the sessions.lastused column if lastused < now()-'6 hours'
- $self->dbUserUpdateLastUsed($uid, $token_e) if $self->{_auth} && $self->{_auth}{session_lastused} < time()-6*3600;
-
- # Drop the cookie if it's not valid
- $self->resCookie(auth => undef) if !$self->{_auth} && $self->reqCookie('auth');
-}
-
-
-# login, arguments: user, password, url-to-redirect-to-on-success
-# returns 1 on success (redirected), 0 otherwise (no reply sent)
-sub authLogin {
- my($self, $user, $pass, $to) = @_;
-
- return 0 if !$user || !$pass;
-
- my $d = $self->dbUserGet(username => $user, what => 'scryptargs extended prefs notifycount')->[0];
- return 0 if !$d->{id} || !$d->{scryptargs} || length($d->{scryptargs}) != 14;
-
- my($N, $r, $p, $salt) = unpack 'NCCa8', $d->{scryptargs};
- my $encpass = _preparepass($self, $pass, $salt, $N, $r, $p);
-
- return _createsession($self, $d->{id}, $encpass, $to);
-}
-
-
-# Prepares a plaintext password for database storage
-# Arguments: pass, optionally: salt, N, r, p
-# Returns: encrypted password (as a binary string)
-sub _preparepass {
- my($self, $pass, $salt, $N, $r, $p) = @_;
- ($N, $r, $p) = @{$self->{scrypt_args}} if !$N;
- $salt ||= urandom(8);
- return pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw($pass, $self->{scrypt_salt} . $salt, $N, $r, $p, 32);
-}
-
-
-# self, uid, encpass, url-to-redirect-to
-sub _createsession {
- my($self, $uid, $encpass, $url) = @_;
-
- my $token = urandom(20);
- return 0 if !$self->dbUserLogin($uid, $encpass, sha1 $token);
-
- $self->resRedirect($url, 'post');
- $self->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000); # keep the cookie for 1 year
- return 1;
-}
-
-
-# clears authentication cookie and redirects to /
-sub authLogout {
- my $self = shift;
-
- my($uid, $token_e) = parsecookie($self);
- $self->dbUserLogout($uid, $token_e) if $uid;
-
- $self->resRedirect('/', 'temp');
- $self->resCookie(auth => undef);
-}
-
-
-# Replaces the user's password with a random token that can be used to reset the password.
-sub authResetPass {
- my $self = shift;
- my $mail = shift;
- my $token = unpack 'H*', urandom(20);
- my $id = $self->dbUserResetPass($mail, sha1(lc($token)));
- return $id ? ($id, $token) : ();
-}
-
-
-# uid, token
-sub authIsValidToken {
- $_[0]->dbUserIsValidToken($_[1], sha1(lc($_[2])))
-}
-
-
-# uid, new_pass, url_to_redir_to, 'token'|'pass', $token_or_pass
-# Changes the user's password, invalidates all existing sessions, creates a new
-# session and redirects.
-sub authSetPass {
- my($self, $uid, $pass, $redir, $oldtype, $oldpass) = @_;
-
- if($oldtype eq 'token') {
- $oldpass = sha1(lc($oldpass));
-
- } elsif($oldtype eq 'pass') {
- my $u = $self->dbUserGet(uid => $uid, what => 'scryptargs')->[0];
- return 0 if !$u->{id} || !$u->{scryptargs} || length($u->{scryptargs}) != 14;
- my($N, $r, $p, $salt) = unpack 'NCCa8', $u->{scryptargs};
- $oldpass = _preparepass($self, $oldpass, $salt, $N, $r, $p);
- }
-
- $pass = _preparepass($self, $pass);
- return 0 if !$self->dbUserSetPass($uid, $oldpass, $pass);
- return _createsession($self, $uid, $pass, $redir);
-}
-
-
-sub authAdminSetPass {
- my($self, $uid, $pass) = @_;
- $pass = _preparepass($self, $pass);
- $self->dbUserAdminSetPass($uid, $self->authInfo->{id}, $self->authInfo->{token}, $pass);
-}
-
-
-# returns a hashref with information about the current loggedin user
-# the hash is identical to the hash returned by dbUserGet
-# returns empty hash if no user is logged in.
-sub authInfo {
- return shift->{_auth} || {};
-}
-
-
-# returns whether the currently loggedin or anonymous user can perform
-# a certain action. Argument is the action name as defined in global.pl
-sub authCan {
- my($self, $act) = @_;
- return $self->{_auth} ? $self->{_auth}{perm} & $self->{permissions}{$act} : 0;
-}
-
-
-# Generate a code to be used later on to validate that the form was indeed
-# submitted from our site and by the same user/visitor. Not limited to
-# logged-in users.
-# Arguments:
-# form-id (string, can be empty, but makes the validation stronger)
-# time (optional, time() to encode in the code)
-sub authGetCode {
- my $self = shift;
- my $id = shift;
- my $time = (shift || time)/3600; # accuracy of an hour
- my $uid = encode_utf8($self->{_auth} ? $self->{_auth}{id} : norm_ip($self->reqIP()));
- return lc substr sha1_hex($self->{form_salt} . $uid . encode_utf8($id||'') . pack('N', int $time)), 0, 16;
-}
-
-
-# Validates the correctness of the returned code, creates an error page and
-# returns false if it's invalid, returns true otherwise. Codes are valid for at
-# least two and at most three hours.
-# Arguments:
-# [ form-id, [ code ] ]
-# If the code is not given, uses the 'formcode' form parameter instead. If
-# form-id is not given, the path of the current requests is used.
-sub authCheckCode {
- my $self = shift;
- my $id = shift || $self->reqPath();
- my $code = shift || $self->reqParam('formcode');
- return _incorrectcode($self) if !$code || $code !~ qr/^[0-9a-f]{16}$/;
- my $time = time;
- return 1 if $self->authGetCode($id, $time) eq $code;
- return 1 if $self->authGetCode($id, $time-3600) eq $code;
- return 1 if $self->authGetCode($id, $time-2*3600) eq $code;
- return _incorrectcode($self);
-}
-
-
-sub _incorrectcode {
- my $self = shift;
- $self->resInit;
- $self->htmlHeader(title => 'Validation code expired', noindex => 1);
-
- div class => 'mainbox';
- h1 'Validation code expired';
- div class => 'warning';
- p 'Please hit the back-button of your browser, refresh the page and try again.';
- end;
- end;
-
- $self->htmlFooter;
- return 0;
-}
-
-
-sub authPref {
- my($self, $key, $val) = @_;
- my $nfo = $self->authInfo;
- return '' if !$nfo->{id};
- return $nfo->{prefs}{$key}||'' if @_ == 2;
- $nfo->{prefs}{$key} = $val;
- $self->dbUserPrefSet($nfo->{id}, $key, $val);
-}
-
-1;
-
diff --git a/lib/VNDB/Util/BrowseHTML.pm b/lib/VNDB/Util/BrowseHTML.pm
deleted file mode 100644
index c3115017..00000000
--- a/lib/VNDB/Util/BrowseHTML.pm
+++ /dev/null
@@ -1,223 +0,0 @@
-
-package VNDB::Util::BrowseHTML;
-
-use strict;
-use warnings;
-use TUWF ':html', 'xml_escape';
-use Exporter 'import';
-use VNDB::Func;
-use POSIX 'ceil';
-
-
-our @EXPORT = qw| htmlBrowse htmlBrowseNavigate htmlBrowseHist htmlBrowseVN |;
-
-
-# generates a browse box, arguments:
-# items => arrayref with the list items
-# options => hashref containing at least the keys s (sort key), o (order) and p (page)
-# nextpage => whether there's a next page or not
-# sorturl => base URL to append the sort options to (if there are any sortable columns)
-# pageurl => base URL to append the page option to
-# class => classname of the mainbox
-# header =>
-# can be either an arrayref or subroutine reference,
-# in the case of a subroutine, it will be called when the header should be written,
-# in the case of an arrayref, the array should contain the header items. Each item
-# can again be either an arrayref or subroutine ref. The arrayref would consist of
-# two elements: the name of the header, and the name of the sorting column if it can
-# be sorted
-# row => subroutine ref, which is called for each item in $list, arguments will be
-# $self, $item_number (starting from 0), $item_value
-# footer => subroutine ref, called after all rows have been processed
-sub htmlBrowse {
- my($self, %opt) = @_;
-
- $opt{sorturl} .= $opt{sorturl} =~ /\?/ ? ';' : '?' if $opt{sorturl};
-
- # top navigation
- $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 't') if $opt{pageurl};
-
- div class => 'mainbox browse'.($opt{class} ? ' '.$opt{class} : '');
- table class => 'stripe';
-
- # header
- thead;
- Tr;
- if(ref $opt{header} eq 'CODE') {
- $opt{header}->($self);
- } else {
- for(0..$#{$opt{header}}) {
- if(ref $opt{header}[$_] eq 'CODE') {
- $opt{header}[$_]->($self, $_+1);
- } else {
- td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : ();
- lit $opt{header}[$_][0];
- if($opt{header}[$_][1]) {
- lit ' ';
- $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'a' ? lit "\x{25B4}" : a href => "$opt{sorturl}o=a;s=$opt{header}[$_][1]", "\x{25B4}";
- $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'd' ? lit "\x{25BE}" : a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]", "\x{25BE}";
- }
- end;
- }
- }
- }
- end;
- end 'thead';
-
- # footer
- if($opt{footer}) {
- tfoot;
- $opt{footer}->($self);
- end;
- }
-
- # rows
- $opt{row}->($self, $_+1, $opt{items}[$_])
- for 0..$#{$opt{items}};
-
- end 'table';
- end 'div';
-
- # bottom navigation
- $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 'b') if $opt{pageurl};
-}
-
-
-# creates next/previous buttons (tabs), if needed
-# Arguments: page url, current page (1..n), nextpage (0/1 or [$total, $perpage]), alignment (t/b), noappend (0/1)
-sub htmlBrowseNavigate {
- my($self, $url, $p, $np, $al, $na) = @_;
- my($cnt, $pp) = ref($np) ? @$np : ($p+$np, 1);
- return if $p == 1 && $cnt <= $pp;
-
- $url .= $url =~ /\?/ ? ';p=' : '?p=' unless $na;
-
- my $tab = sub {
- my($left, $page, $label) = @_;
- li $left ? (class => 'left') : ();
- a href => $url.$page; lit $label; end;
- end;
- };
- my $ell = sub {
- use utf8;
- li class => 'ellipsis'.(shift() ? ' left' : '');
- b '⋯';
- end;
- };
- my $nc = 5; # max. number of buttons on each side
-
- ul class => 'maintabs browsetabs ' . ($al eq 't' ? 'notfirst' : 'bottom');
- $p > 2 and ref $np and $tab->(1, 1, '&laquo; first');
- $p > $nc+1 and ref $np and $ell->(1);
- $p > $_ and ref $np and $tab->(1, $p-$_, $p-$_) for (reverse 2..($nc>$p-2?$p-2:$nc-1));
- $p > 1 and $tab->(1, $p-1, '&lsaquo; previous');
-
- my $l = ceil($cnt/$pp)-$p+1;
- $l > 2 and $tab->(0, $l+$p-1, 'last &raquo;');
- $l > $nc+1 and $ell->(0);
- $l > $_ and $tab->(0, $p+$_, $p+$_) for (reverse 2..($nc>$l-2?$l-2:$nc-1));
- $l > 1 and $tab->(0, $p+1, 'next &rsaquo;');
- end 'ul';
-}
-
-
-sub htmlBrowseHist {
- my($self, $list, $f, $np, $url) = @_;
- $self->htmlBrowse(
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => $url,
- class => 'history',
- header => [
- sub { td class => 'tc1_1', 'Rev.'; td class => 'tc1_2', ''; },
- [ 'Date' ],
- [ 'User' ],
- [ 'Page' ],
- ],
- row => sub {
- my($s, $n, $i) = @_;
- my $revurl = "/$i->{type}$i->{itemid}.$i->{rev}";
-
- Tr;
- td class => 'tc1_1';
- a href => $revurl, "$i->{type}$i->{itemid}";
- end;
- td class => 'tc1_2';
- a href => $revurl, ".$i->{rev}";
- end;
- td class => 'tc2', fmtdate $i->{added}, 'full';
- td class => 'tc3';
- lit fmtuser $i;
- end;
- td class => 'tc4';
- a href => $revurl, title => $i->{ioriginal}, shorten $i->{ititle}, 80;
- b class => 'grayedout'; lit bb2html $i->{comments}, 150; end;
- end;
- end 'tr';
- },
- );
-}
-
-
-sub htmlBrowseVN {
- my($self, $list, $f, $np, $url, $tagscore) = @_;
- $self->htmlBrowse(
- class => 'vnbrowse',
- items => $list,
- options => $f,
- nextpage => $np,
- pageurl => "$url;o=$f->{o};s=$f->{s}",
- sorturl => $url,
- header => [
- $tagscore ? [ 'Score', 'tagscore', undef, 'tc_s' ] : (),
- [ 'Title', 'title', undef, $tagscore ? 'tc_t' : 'tc1' ],
- $f->{vnlist} ? [ '', 0, undef, 'tc7' ] : (),
- $f->{wish} ? [ '', 0, undef, 'tc8' ] : (),
- [ '', 0, undef, 'tc2' ],
- [ '', 0, undef, 'tc3' ],
- [ 'Released', 'rel', undef, 'tc4' ],
- [ 'Popularity', 'pop', undef, 'tc5' ],
- [ 'Rating', 'rating', undef, 'tc6' ],
- ],
- row => sub {
- my($s, $n, $l) = @_;
- Tr;
- if($tagscore) {
- td class => 'tc_s';
- tagscore $l->{tagscore}, 0;
- end;
- }
- td class => $tagscore ? 'tc_t' : 'tc1';
- a href => '/v'.$l->{id}, title => $l->{original}||$l->{title}, shorten $l->{title}, 100;
- end;
- 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};
- end 'td';
- }
- td class => 'tc8', defined($l->{wstat}) ? $self->{wishlist_status}[$l->{wstat}] : '' if $f->{wish};
- td class => 'tc2';
- $_ ne 'oth' && cssicon $_, $self->{platforms}{$_}
- for (sort @{$l->{c_platforms}});
- end;
- td class => 'tc3';
- cssicon "lang $_", $self->{languages}{$_}
- for (reverse sort @{$l->{c_languages}});
- end;
- td class => 'tc4';
- lit fmtdatestr $l->{c_released};
- end;
- td class => 'tc5', sprintf '%.2f', ($l->{c_popularity}||0)*100;
- td class => 'tc6';
- txt sprintf '%.2f', ($l->{c_rating}||0)/10;
- b class => 'grayedout', sprintf ' (%d)', $l->{c_votecount};
- end;
- end 'tr';
- },
- );
-}
-
-
-1;
-
diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm
deleted file mode 100644
index e8561e3c..00000000
--- a/lib/VNDB/Util/CommonHTML.pm
+++ /dev/null
@@ -1,477 +0,0 @@
-
-package VNDB::Util::CommonHTML;
-
-use strict;
-use warnings;
-use TUWF ':html', 'xml_escape', 'html_escape';
-use Exporter 'import';
-use Algorithm::Diff::XS 'compact_diff';
-use Encode 'encode_utf8', 'decode_utf8';
-use VNDB::Func;
-use POSIX 'ceil';
-
-our @EXPORT = qw|
- htmlMainTabs htmlDenied htmlHiddenMessage htmlRevision
- htmlEditMessage htmlItemMessage htmlVoteStats htmlSearchBox htmlRGHeader
-|;
-
-
-# generates the "main tabs". These are the commonly used tabs for
-# 'objects', i.e. VN/producer/release entries and users
-# Arguments: u/v/r/p/g/i/c, object, currently selected item (empty=main)
-sub htmlMainTabs {
- my($self, $type, $obj, $sel) = @_;
- $sel ||= '';
- my $id = $type.$obj->{id};
-
- return if $type eq 'g' && !$self->authCan('tagmod');
-
- ul class => 'maintabs';
- if($type =~ /[uvrpcs]/) {
- li $sel eq 'hist' ? (class => 'tabselected') : ();
- a href => "/$id/hist", 'history';
- end;
- }
-
- if($type =~ /[uvp]/) {
- my $cnt = $self->dbThreadCount($type, $obj->{id});
- li $sel eq 'disc' ? (class => 'tabselected') : ();
- a href => "/t/$id", "discussions ($cnt)";
- end;
- }
-
- if($type eq 'u') {
- li $sel eq 'posts' ? (class => 'tabselected') : ();
- a href => "/$id/posts", 'posts';
- end;
- }
-
- if($type eq 'u' && (!($obj->{hide_list} || $obj->{prefs}{hide_list}) || ($self->authInfo->{id} && $self->authInfo->{id} == $obj->{id}) || $self->authCan('usermod'))) {
- li $sel eq 'wish' ? (class => 'tabselected') : ();
- a href => "/$id/wish", 'wishlist';
- end;
-
- li $sel eq 'votes' ? (class => 'tabselected') : ();
- a href => "/$id/votes", 'votes';
- end;
-
- li $sel eq 'list' ? (class => 'tabselected') : ();
- a href => "/$id/list", 'list';
- end;
- }
-
- if($type eq 'v' && $self->authCan('tag') && !$obj->{hidden}) {
- li $sel eq 'tagmod' ? (class => 'tabselected') : ();
- a href => "/$id/tagmod", 'modify tags';
- end;
- }
-
- if(($type =~ /[rc]/ && $self->authCan('edit')) && $self->authInfo->{c_changes} > 0) {
- li $sel eq 'copy' ? (class => 'tabselected') : ();
- a href => "/$id/copy", 'copy';
- end;
- }
-
- if( $type eq 'u' && ($self->authInfo->{id} && $obj->{id} == $self->authInfo->{id} || $self->authCan('usermod'))
- || $type =~ /[vrpcs]/ && $self->authCan('edit') && ((!$obj->{locked} && !$obj->{hidden}) || $self->authCan('dbmod'))
- || $type =~ /[gi]/ && $self->authCan('tagmod')
- ) {
- li $sel eq 'edit' ? (class => 'tabselected') : ();
- a href => "/$id/edit", 'edit';
- end;
- }
-
- if($type eq 'u' && $self->authCan('usermod')) {
- li $sel eq 'del' ? (class => 'tabselected') : ();
- a href => "/$id/del", 'remove';
- end;
- }
-
- if($type eq 'v') {
- li $sel eq 'releases' ? (class => 'tabselected') : ();
- a href => "/$id/releases", 'releases';
- end;
- }
-
- if($type =~ /[vp]/ && $obj->{rgraph}) {
- li $sel eq 'rg' ? (class => 'tabselected') : ();
- a href => "/$id/rg", 'relations';
- end;
- }
-
- li !$sel ? (class => 'tabselected') : ();
- a href => "/$id", $id;
- end;
- end 'ul';
-}
-
-
-# generates a full error page, including header and footer
-sub htmlDenied {
- my $self = shift;
- $self->htmlHeader(title => 'Access Denied');
- div class => 'mainbox';
- h1 'Access Denied';
- div class => 'warning';
- if(!$self->authInfo->{id}) {
- h2 'You need to be logged in to perform this action.';
- p; lit 'Please <a href="/u/login">login</a>, or <a href="/u/register">create an account</a> if you don\'t have one yet.'; end;
- } else {
- h2 'You are not allowed to perform this action.';
- p 'It seems you don\'t have the proper rights to perform the action you wanted to perform...';
- }
- end;
- end 'div';
- $self->htmlFooter;
-}
-
-
-# Generates message saying that the current item has been deleted,
-# Arguments: [pvrc], obj
-# Returns 1 if the use doesn't have access to the page, 0 otherwise
-sub htmlHiddenMessage {
- my($self, $type, $obj) = @_;
- return 0 if !$obj->{hidden};
- my $board = $type =~ /[cs]/ ? 'db' : $type eq 'r' ? 'v'.$obj->{vn}[0]{vid} : $type.$obj->{id};
- # fetch edit summary (not present in $obj, requires the db*GetRev() methods)
- my $editsum = $type eq 'v' ? $self->dbVNGetRev(id => $obj->{id})->[0]{comments}
- : $type eq 'r' ? $self->dbReleaseGetRev(id => $obj->{id})->[0]{comments}
- : $type eq 'c' ? $self->dbCharGetRev(id => $obj->{id})->[0]{comments}
- : $type eq 's' ? $self->dbStaffGetRev(id => $obj->{id})->[0]{comments}
- : $self->dbProducerGetRev(id => $obj->{id})->[0]{comments};
- div class => 'mainbox';
- h1 $obj->{title}||$obj->{name};
- div class => 'warning';
- h2 'Item deleted';
- p;
- lit 'This item has been deleted from the database. File a request on the <a href="/t/'.$board.'">discussion board</a> to undelete this page.';
- br; br;
- lit bb2html $editsum;
- end;
- end;
- end 'div';
- return $self->htmlFooter() || 1 if !$self->authCan('dbmod');
- return 0;
-}
-
-
-# Shows a revision, including diff if there is a previous revision.
-# Arguments: v|p|r|c, old revision, new revision, @fields
-# Where @fields is a list of fields as arrayrefs with:
-# [ shortname, displayname, %options ],
-# Where %options:
-# diff => 1/0/regex, whether to show a diff on this field, and what to split it with (1 = character-level diff)
-# serialize => coderef, should convert the field into a readable string, no HTML allowed
-# htmlize => same as serialize, but HTML is allowed and this can't be diff'ed
-# split => coderef, should return an array of HTML strings that can be diff'ed. (implies diff => 1)
-# join => used in combination with split, specifies the string used for joining the HTML strings
-sub htmlRevision {
- my($self, $type, $old, $new, @fields) = @_;
- div class => 'mainbox revision';
- h1 "Revision $new->{rev}";
-
- # character information may be rather spoilerous
- if($type eq 'c') {
- div class => 'warning';
- h2 'SPOILER WARNING!';
- lit 'This revision page may contain major spoilers. You may want to view the <a href="/c'.$new->{id}.'">final page</a> instead.';
- end;
- br;br;
- }
-
- # previous/next revision links
- a class => 'prev', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}-1), '<- earlier revision' if $new->{rev} > 1;
- a class => 'next', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}+1), 'later revision ->' if !$new->{lastrev};
- p class => 'center';
- a href => "/$type$new->{id}", "$type$new->{id}";
- end;
-
- # no previous revision, just show info about the revision itself
- if(!$old) {
- div class => 'rev';
- revheader($self, $type, $new);
- br;
- b 'Edit summary';
- br; br;
- lit bb2html($new->{comments})||'-';
- end;
- }
-
- # otherwise, compare the two revisions
- else {
- table class => 'stripe';
- thead;
- Tr;
- td; lit '&#xa0;'; end;
- td; revheader($self, $type, $old); end;
- td; revheader($self, $type, $new); end;
- end;
- Tr;
- td; lit '&#xa0;'; end;
- td colspan => 2;
- b "Edit summary of revision $new->{rev}:";
- br; br;
- lit bb2html($new->{comments})||'-';
- end;
- end;
- end;
- revdiff($type, $old, $new, @$_) for (
- [ ihid => 'Deleted', serialize => sub { $_[0] ? 'Yes' : 'No' } ],
- [ ilock => 'Locked', serialize => sub { $_[0] ? 'Yes' : 'No' } ],
- @fields
- );
- end 'table';
- }
- end 'div';
-}
-
-sub revheader { # type, obj
- my($self, $type, $obj) = @_;
- b "Revision $obj->{rev}";
- txt ' (';
- a href => "/$type$obj->{id}.$obj->{rev}/edit", 'edit';
- txt ')';
- br;
- txt 'By ';
- lit fmtuser $obj;
- txt ' on ';
- txt fmtdate $obj->{added}, 'full';
-}
-
-sub revdiff {
- my($type, $old, $new, $short, $display, %o) = @_;
-
- $o{serialize} ||= $o{htmlize};
- $o{diff} = 1 if $o{split};
- $o{join} ||= '';
-
- my $ser1 = $o{serialize} ? $o{serialize}->($old->{$short}, $old) : $old->{$short};
- my $ser2 = $o{serialize} ? $o{serialize}->($new->{$short}, $new) : $new->{$short};
- return if $ser1 eq $ser2;
-
- if($o{diff} && $ser1 && $ser2) {
- my $sep = ref $o{diff} ? qr/($o{diff})/ : qr//;
- my @ser1 = map encode_utf8($_), $o{split} ? $o{split}->($ser1) : map html_escape($_), split $sep, $ser1;
- my @ser2 = map encode_utf8($_), $o{split} ? $o{split}->($ser2) : map html_escape($_), split $sep, $ser2;
- return if $o{split} && $#ser1 == $#ser2 && !grep $ser1[$_] ne $ser2[$_], 0..$#ser1;
-
- $ser1 = $ser2 = '';
- my @d = compact_diff(\@ser1, \@ser2);
- for my $i (0..($#d-2)/2) {
- # $i % 2 == 0 -> equal, otherwise it's different
- my $a = join($o{join}, @ser1[ $d[$i*2] .. $d[$i*2+2]-1 ]);
- my $b = join($o{join}, @ser2[ $d[$i*2+1] .. $d[$i*2+3]-1 ]);
- $ser1 .= ($ser1?$o{join}:'').($i % 2 ? qq|<b class="diff_del">$a</b>| : $a) if $a ne '';
- $ser2 .= ($ser2?$o{join}:'').($i % 2 ? qq|<b class="diff_add">$b</b>| : $b) if $b ne '';
- }
- $ser1 = decode_utf8($ser1);
- $ser2 = decode_utf8($ser2);
- } elsif(!$o{htmlize}) {
- $ser1 = html_escape $ser1;
- $ser2 = html_escape $ser2;
- }
-
- $ser1 = '[empty]' if !$ser1 && $ser1 ne '0';
- $ser2 = '[empty]' if !$ser2 && $ser2 ne '0';
-
- Tr;
- td $display;
- td class => 'tcval'; lit $ser1; end;
- td class => 'tcval'; lit $ser2; end;
- end;
-}
-
-
-# Generates a generic message to show as the header of the edit forms
-# Arguments: v/r/p, obj
-sub htmlEditMessage {
- my($self, $type, $obj, $title, $copy) = @_;
- my $typename = {v => 'visual novel', r => 'release', p => 'producer', c => 'character', s => 'person'}->{$type};
- my $guidelines = {v => 2, r => 3, p => 4, c => 12, 's' => 16}->{$type};
-
- div class => 'mainbox';
- h1 $title;
- if($copy) {
- div class => 'warning';
- h2 'You\'re not editing an entry!';
- p;
- txt 'You\'re about to insert a new entry into the database with information based on ';
- a href => "/$type$obj->{id}", $obj->{title}||$obj->{name};
- txt '.';
- br;
- txt 'Hit the \'edit\' tab on the right-top if you intended to edit the entry instead of creating a new one.';
- end;
- end;
- }
- div class => 'notice';
- h2 'Before editing:';
- ul;
- li;
- txt "Read the ";
- a href=> "/d$guidelines", 'guidelines';
- txt '!';
- end;
- if($obj) {
- li;
- txt 'Check for any existing discussions on the ';
- a href => $type =~ /[cs]/ ? '/t/db' : $type eq 'r' ? "/t/v$obj->{vn}[0]{vid}" : "/t/$type$obj->{id}", 'discussion board';
- end;
- li;
- txt 'Browse the ';
- a href => "/$type$obj->{id}/hist", 'edit history';
- txt ' for any recent changes related to what you want to change.';
- end;
- } elsif($type ne 'r') {
- li;
- a href => "/$type/all", 'Search the database';
- txt " to see if we already have information about this $typename.";
- end;
- }
- end;
- end;
- if($obj && !$obj->{lastrev}) {
- div class => 'warning';
- h2 'Reverting';
- p "You are editing an old revision of this $typename. If you save it, all changes made after this revision will be reverted!";
- end;
- }
- end 'div';
-}
-
-
-# Generates a small message when the user can't edit the item,
-# or the item is locked.
-# Arguments: v/r/p/c, obj
-sub htmlItemMessage {
- my($self, $type, $obj) = @_;
- # $type isn't being used at all... oh well.
-
- if($obj->{locked}) {
- p class => 'locked', 'Locked for editing';
- } elsif($self->authInfo->{id} && !$self->authCan('edit')) {
- p class => 'locked', 'You are not allowed to edit this page';
- }
-}
-
-
-# generates two tables, one with a vote graph, other with recent votes
-sub htmlVoteStats {
- my($self, $type, $obj, $stats) = @_;
-
- my($max, $count, $total) = (0, 0, 0);
- for (0..$#$stats) {
- $max = $stats->[$_][0] if $stats->[$_][0] > $max;
- $count += $stats->[$_][0];
- $total += $stats->[$_][1];
- }
- div class => 'votestats';
- table class => 'votegraph';
- thead; Tr;
- td colspan => 2, 'Vote stats';
- end; end;
- tfoot; Tr;
- td colspan => 2, sprintf '%d vote%s total, average %.2f%s', $count, $count == 1 ? '' : 's', $total/$count/10,
- $type eq 'v' ? ' ('.fmtrating(ceil($total/$count/10-1)||1).')' : '';
- end; end;
- for (reverse 0..$#$stats) {
- Tr;
- td class => 'number', $_+1;
- td class => 'graph';
- div style => 'width: '.($stats->[$_][0]/$max*250).'px', ' ';
- txt $stats->[$_][0];
- end;
- end;
- }
- end 'table';
-
- my $recent = $self->dbVoteGet(
- $type.'id' => $obj->{id},
- results => 8,
- what => $type eq 'v' ? 'user' : 'vn',
- hide => $type eq 'v',
- hide_ign => $type eq 'v',
- );
- if(@$recent) {
- table class => 'recentvotes stripe';
- thead; Tr;
- td colspan => 3;
- txt 'Recent votes';
- b;
- txt '(';
- a href => "/$type$obj->{id}/votes", 'show all';
- txt ')';
- end;
- end;
- end; end;
- for (@$recent) {
- Tr;
- td;
- if($type eq 'u') {
- a href => "/v$_->{vid}", title => $_->{original}||$_->{title}, shorten $_->{title}, 40;
- } else {
- a href => "/u$_->{uid}", $_->{username};
- }
- end;
- td fmtvote $_->{vote};
- td fmtdate $_->{date};
- end;
- }
- end 'table';
- }
-
- clearfloat;
- if($type eq 'v' && $obj->{c_votecount}) {
- div;
- h3 'Ranking';
- p sprintf 'Popularity: ranked #%d with a score of %.2f', $obj->{p_ranking}, ($obj->{c_popularity}||0)*100;
- p sprintf 'Bayesian rating: ranked #%d with a rating of %.2f', $obj->{r_ranking}, $obj->{c_rating}/10;
- end;
- }
- end 'div';
-}
-
-
-sub htmlSearchBox {
- my($self, $sel, $v) = @_;
-
- fieldset class => 'search';
- p id => 'searchtabs';
- a href => '/v/all', $sel eq 'v' ? (class => 'sel') : (), 'Visual novels';
- a href => '/r', $sel eq 'r' ? (class => 'sel') : (), 'Releases';
- a href => '/p/all', $sel eq 'p' ? (class => 'sel') : (), 'Producers';
- a href => '/s/all', $sel eq 's' ? (class => 'sel') : (), 'Staff';
- a href => '/c/all', $sel eq 'c' ? (class => 'sel') : (), 'Characters';
- a href => '/g', $sel eq 'g' ? (class => 'sel') : (), 'Tags';
- a href => '/i', $sel eq 'i' ? (class => 'sel') : (), 'Traits';
- a href => '/u/all', $sel eq 'u' ? (class => 'sel') : (), 'Users';
- end;
- input type => 'text', name => 'q', id => 'q', class => 'text', value => $v;
- input type => 'submit', class => 'submit', value => 'Search!';
- end 'fieldset';
-}
-
-
-sub htmlRGHeader {
- my($self, $title, $type, $obj) = @_;
-
- # This used to be a good test for inline SVG support, but I'm not sure it is nowadays.
- if(($self->reqHeader('Accept')||'') !~ /application\/xhtml\+xml/) {
- $self->htmlHeader(title => $title);
- $self->htmlMainTabs($type, $obj, 'rg');
- div class => 'mainbox';
- h1 $title;
- div class => 'warning';
- h2 'Not supported';
- p 'Your browser sucks, it doesn\'t have the functionality to render our nice relation graphs.';
- end;
- end;
- $self->htmlFooter;
- return 1;
- }
- $self->htmlHeader(title => $title);
- $self->htmlMainTabs($type, $obj, 'rg');
- return 0;
-}
-
-
-1;
diff --git a/lib/VNDB/Util/FormHTML.pm b/lib/VNDB/Util/FormHTML.pm
deleted file mode 100644
index a522599e..00000000
--- a/lib/VNDB/Util/FormHTML.pm
+++ /dev/null
@@ -1,277 +0,0 @@
-
-package VNDB::Util::FormHTML;
-
-use strict;
-use warnings;
-use TUWF ':html';
-use Exporter 'import';
-use POSIX 'strftime';
-use VNDB::Func;
-
-our @EXPORT = qw| htmlFormError htmlFormPart htmlForm |;
-
-
-# Displays friendly error message when form validation failed
-# Argument is the return value of formValidate, and an optional
-# argument indicating whether we should create a special mainbox
-# for the errors.
-sub htmlFormError {
- my($self, $frm, $mainbox) = @_;
- return if !$frm->{_err};
- if($mainbox) {
- div class => 'mainbox';
- h1 'Error';
- }
- div class => 'warning';
- h2 'Form could not be sent:';
- ul;
- for my $e (@{$frm->{_err}}) {
- if(!ref $e) {
- li $e;
- next;
- }
- if(ref $e eq 'SCALAR') {
- li; lit $$e; end;
- next;
- }
- my($field, $type, $rule) = @$e;
- ($type, $rule) = ('template', 'editsum') if $type eq 'required' && $field eq 'editsum';
-
- li "$field is a required field" if $type eq 'required';;
- li "$field: minimum number of values is $rule" if $type eq 'mincount';
- li "$field: maximum number of values is $rule" if $type eq 'maxcount';
- li "$field: should have at least $rule characters" if $type eq 'minlength';
- li "$field: only $rule characters allowed" if $type eq 'maxlength';
- li "$field must be one of the following: ".join(', ', @$rule) if $type eq 'enum';
- li $rule->[1] if $type eq 'func' || $type eq 'regex';
- if($type eq 'template') {
- li "$field: Invalid number" if $rule eq 'int' || $rule eq 'num' || $rule eq 'uint' || $rule eq 'page' || $rule eq 'id';
- li "$field: Invalid URL" if $rule eq 'weburl';
- li "$field: only ASCII characters allowed" if $rule eq 'ascii';
- li "Invalid email address" if $rule eq 'email';
- li "$field may only contain lowercase alphanumeric characters and a hyphen" if $rule eq 'uname';
- li 'Invalid JAN/UPC/EAN' if $rule eq 'gtin';
- li "$field: Malformed data or invalid input" if $rule eq 'json';
- li 'Invalid release date' if $rule eq 'rdate';
- if($rule eq 'editsum') {
- li; lit 'Please read <a href="/d5.4">the guidelines</a> on how to use the edit summary.'; end;
- }
- }
- }
- end;
- end 'div';
- end if $mainbox;
-}
-
-
-# Generates a form part.
-# A form part is a arrayref, with the first element being the type of the part,
-# and all other elements forming a hash with options specific to that type.
-# Type Options
-# hidden short, (value)
-# json short, (value) # Same as hidden, but value is passed through json_encode()
-# input short, name, (width, pre, post)
-# passwd short, name
-# static content, (label, nolabel)
-# check name, short, (value)
-# select name, short, options, (width, multi, size)
-# radio name, short, options
-# text name, short, (rows, cols)
-# date name, short
-# part title
-sub htmlFormPart {
- my($self, $frm, $fp) = @_;
- my($type, %o) = @$fp;
- local $_ = $type;
-
- if(/hidden/ || /json/) {
- Tr class => 'hidden';
- td colspan => 2;
- my $val = $o{value}||$frm->{$o{short}};
- input type => 'hidden', id => $o{short}, name => $o{short}, value => /json/ ? json_encode($val||[]) : $val||'';
- end;
- end;
- return
- }
-
- if(/part/) {
- Tr class => 'newpart';
- td colspan => 2, $o{title};
- end;
- return;
- }
-
- if(/check/) {
- Tr class => 'newfield';
- td class => 'label';
- lit '&#xa0;';
- end;
- td class => 'field';
- input type => 'checkbox', name => $o{short}, id => $o{short}, tabindex => 10,
- value => $o{value}||1, ($frm->{$o{short}}||0) eq ($o{value}||1) ? ( checked => 'checked' ) : ();
- label for => $o{short};
- lit $o{name};
- end;
- end;
- end;
- return;
- }
-
- Tr $o{name}||$o{label} ? (class => 'newfield') : ();
- if(!$o{nolabel}) {
- td class => 'label';
- if($o{short} && $o{name}) {
- label for => $o{short};
- lit $o{name};
- end;
- } elsif($o{label}) {
- txt $o{label};
- } else {
- lit '&#xa0;';
- }
- end;
- }
- td class => 'field', $o{nolabel} ? (colspan => 2) : ();
- if(/input/) {
- lit $o{pre} if $o{pre};
- input type => 'text', class => 'text', name => $o{short}, id => $o{short}, tabindex => 10,
- value => $frm->{$o{short}}||'', $o{width} ? (style => "width: $o{width}px") : ();
- lit $o{post} if $o{post};
- }
- if(/passwd/) {
- input type => 'password', class => 'text', name => $o{short}, id => $o{short}, tabindex => 10,
- value => $frm->{$o{short}}||'';
- }
- if(/static/) {
- lit ref $o{content} eq 'CODE' ? $o{content}->($self, \%o) : $o{content};
- }
- if(/select/) {
- my $l='';
- Select name => $o{short}, id => $o{short}, tabindex => 10,
- $o{width} ? (style => "width: $o{width}px") : (), $o{multi} ? (multiple => 'multiple', size => $o{size}||5) : ();
- for my $p (@{$o{options}}) {
- if($p->[2] && $l ne $p->[2]) {
- end if $l;
- $l = $p->[2];
- optgroup label => $l;
- }
- my $sel = defined $frm->{$o{short}} && ($frm->{$o{short}} eq $p->[0] || ref($frm->{$o{short}}) eq 'ARRAY' && grep $_ eq $p->[0], @{$frm->{$o{short}}});
- option value => $p->[0], $sel ? (selected => 'selected') : (), $p->[1];
- }
- end if $l;
- end;
- }
- if(/radio/) {
- for my $p (@{$o{options}}) {
- input type => 'radio', id => "$o{short}_$p->[0]", name => $o{short}, value => $p->[0], tabindex => 10,
- defined $frm->{$o{short}} && $frm->{$o{short}} eq $p->[0] ? (checked => 'checked') : ();
- label for => "$o{short}_$p->[0]", $p->[1];
- }
- }
- if(/date/) {
- input type => 'hidden', id => $o{short}, name => $o{short}, value => $frm->{$o{short}}||'', class => 'dateinput';
- }
- if(/text/) {
- textarea name => $o{short}, id => $o{short}, rows => $o{rows}||5, cols => $o{cols}||60, tabindex => 10, $frm->{$o{short}}||'';
- }
- end;
- end 'tr';
-}
-
-
-# Generates a form, first argument is a hashref with global options, keys:
-# frm => the $frm as returned by formValidate,
-# action => The location the form should POST to (also used as form id)
-# method => post/get
-# upload => 1/0, adds an enctype.
-# nosubmit => 1/0, hides the submit button
-# editsum => 1/0, adds an edit summary field before the submit button
-# continue => 2/1/0, replace submit button with continue buttons
-# noformcode=> 1/0, remove the formcode field
-# The other arguments are a list of subforms in the form
-# of (subform-name => [form parts]). Each subform is shown as a
-# (JavaScript-powered) tab, and has it's own 'mainbox'. This function
-# automatically calls htmlFormError and adds a 'formcode' field.
-sub htmlForm {
- my($self, $options, @subs) = @_;
- form action => '/nospam?'.$options->{action}, method => $options->{method}||'post', 'accept-charset' => 'utf-8',
- $options->{upload} ? (enctype => 'multipart/form-data') : ();
-
- if(!$options->{noformcode}) {
- div class => 'hidden';
- input type => 'hidden', name => 'formcode', value => $self->authGetCode($options->{action});
- end;
- }
-
- $self->htmlFormError($options->{frm}, 1);
-
- # tabs
- if(@subs > 2) {
- ul class => 'maintabs notfirst', id => 'jt_select';
- for (0..$#subs/2) {
- li class => 'left';
- a href => "#$subs[$_*2]", id => "jt_sel_$subs[$_*2]", $subs[$_*2+1][0];
- end;
- }
- li class => 'left';
- a href => '#all', id => 'jt_sel_all', 'All items';
- end;
- end 'ul';
- }
-
- # form subs
- while(my($short, $parts) = (shift(@subs), shift(@subs))) {
- last if !$short || !$parts;
- my $name = shift @$parts;
- div class => 'mainbox', id => 'jt_box_'.$short;
- h1 $name;
- fieldset;
- legend $name;
- table class => 'formtable';
- $self->htmlFormPart($options->{frm}, $_) for @$parts;
- end;
- end;
- end 'div';
- }
-
- # db mod / edit summary / submit button
- if(!$options->{nosubmit}) {
- div class => 'mainbox';
- fieldset class => 'submit';
- if($options->{editsum}) {
- # hidden / locked checkbox
- if($self->authCan('dbmod')) {
- input type => 'checkbox', name => 'ihid', id => 'ihid', value => 1,
- tabindex => 10, $options->{frm}{ihid} ? (checked => 'checked') : ();
- label for => 'ihid', 'Deleted';
- input type => 'checkbox', name => 'ilock', id => 'ilock', value => 1,
- tabindex => 10, $options->{frm}{ilock} ? (checked => 'checked') : ();
- label for => 'ilock', 'Locked';
- br; txt 'Note: edit summary of the last edit should indicate the reason for the deletion.'; br;
- }
-
- # edit summary
- h2;
- txt 'Edit summary';
- b class => 'standout', ' (English please!)';
- end;
- textarea name => 'editsum', id => 'editsum', rows => 4, cols => 50, tabindex => 10, $options->{frm}{editsum}||'';
- br;
- }
- if(!$options->{continue}) {
- input type => 'submit', value => 'Submit', class => 'submit', tabindex => 10;
- } else {
- input type => 'submit', value => 'Continue', class => 'submit', tabindex => 10;
- input type => 'submit', name => 'continue_ign', value => 'Continue and ignore duplicates',
- class => 'submit', style => 'width: auto', tabindex => 10 if $options->{continue} == 2;
- }
- end;
- end 'div';
- }
-
- end 'form';
-}
-
-
-1;
-
diff --git a/lib/VNDB/Util/LayoutHTML.pm b/lib/VNDB/Util/LayoutHTML.pm
deleted file mode 100644
index 5cb266f4..00000000
--- a/lib/VNDB/Util/LayoutHTML.pm
+++ /dev/null
@@ -1,204 +0,0 @@
-
-package VNDB::Util::LayoutHTML;
-
-use strict;
-use warnings;
-use TUWF ':html', 'uri_escape';
-use Exporter 'import';
-use Encode 'decode_utf8';
-use VNDB::Func;
-
-our @EXPORT = qw|htmlHeader htmlFooter|;
-
-
-sub htmlHeader { # %options->{ title, noindex, search, feeds, svg, metadata }
- my($self, %o) = @_;
- my $skin = $self->reqGet('skin') || $self->authPref('skin') || $self->{skin_default};
- $skin = $self->{skin_default} if !$self->{skins}{$skin} || !-d "$VNDB::ROOT/static/s/$skin";
-
- # heading
- lit '<!DOCTYPE HTML>';
- tag 'html', lang => 'en';
- head prefix => 'og: http://ogp.me/ns#';
- title $o{title};
- Link rel => 'shortcut icon', href => '/favicon.ico', type => 'image/x-icon';
- Link rel => 'stylesheet', href => $self->{url_static}.'/s/'.$skin.'/style.css?'.$self->{version}, type => 'text/css', media => 'all';
- Link rel => 'search', type => 'application/opensearchdescription+xml', title => 'VNDB VN Search', href => $self->reqBaseURI().'/opensearch.xml';
- if($self->authPref('customcss')) {
- (my $css = $self->authPref('customcss')) =~ s/\n/ /g;
- style type => 'text/css', $css;
- }
- Link rel => 'alternate', type => 'application/atom+xml', href => "/feeds/$_.atom", title => $self->{atom_feeds}{$_}[1]
- for ($o{feeds} ? @{$o{feeds}} : ());
-
- if(exists $o{metadata}) {
- # Required fields as per http://op.me/#metadata: og:title, og:type, og:image, og:url
- if(exists $o{metadata}{'og:title'}) {
- $o{metadata}{'og:site_name'} = 'The Visual Novel Database';
- $o{metadata}{'og:type'} ||= 'object';
- $o{metadata}{'og:image'} ||= $self->{placeholder_img};
- $o{metadata}{'og:url'} ||= $self->reqURI();
- }
-
- for my $k (keys %{$o{metadata}}) {
- next if !$o{metadata}{$k} and $o{metadata}{$k} ne '0';
- $o{metadata}{$k} =~ s/\R/ /g;
-
- meta property => "$k", content => $o{metadata}->{$k}, undef;
- }
- }
-
- meta name => 'robots', content => 'noindex, follow', undef if $o{noindex};
- end;
- body;
- div id => 'bgright', ' ';
- div id => 'header';
- h1;
- a href => '/', 'the visual novel database';
- end;
- end;
-
- _menu($self, %o);
-
- div id => 'maincontent';
-}
-
-
-sub _menu {
- my($self, %o) = @_;
-
- div id => 'menulist';
-
- div class => 'menubox';
- h2;
- txt 'Menu';
- end;
- div;
- a href => '/', 'Home'; br;
- a href => '/v/all', 'Visual novels'; br;
- b class => 'grayedout', '> '; a href => '/g', 'Tags'; br;
- a href => '/r', 'Releases'; br;
- a href => '/p/all', 'Producers'; br;
- a href => '/s/all', 'Staff'; br;
- a href => '/c/all', 'Characters'; br;
- b class => 'grayedout', '> '; a href => '/i', 'Traits'; br;
- a href => '/u/all', 'Users'; br;
- a href => '/hist', 'Recent changes'; br;
- a href => '/t', 'Discussion board'; br;
- a href => '/d6', 'FAQ'; br;
- a href => '/v/rand','Random visual novel';
- end;
- form action => '/v/all', method => 'get', id => 'search';
- fieldset;
- legend 'Search';
- input type => 'text', class => 'text', id => 'sq', name => 'sq', value => $o{search}||'', placeholder => 'search';
- input type => 'submit', class => 'submit', value => 'Search';
- end;
- end;
- end 'div'; # /menubox
-
- div class => 'menubox';
- if($self->authInfo->{id}) {
- my $uid = sprintf '/u%d', $self->authInfo->{id};
- my $nc = $self->authInfo->{notifycount};
- h2;
- a href => $uid, ucfirst $self->authInfo->{username};
- end;
- div;
- a href => "$uid/edit", 'My Profile'; 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/notifies", $nc ? (class => 'notifyget') : (), 'My Notifications'.($nc?" ($nc)":''); br;
- a href => "$uid/hist", 'My Recent Changes'; br;
- a href => '/g/links?u='.$self->authInfo->{id}, 'My Tags'; br;
- br;
- if($self->authCan('edit')) {
- a href => '/v/add', 'Add Visual Novel'; br;
- a href => '/p/add', 'Add Producer'; br;
- a href => '/s/new', 'Add Staff'; br;
- a href => '/c/new', 'Add Character'; br;
- }
- br;
- a href => "$uid/logout", 'Logout';
- end;
- } else {
- h2 'User menu';
- div;
- my $ref = uri_escape $self->reqPath().$self->reqQuery();
- a href => "/u/login?ref=$ref", 'Login'; br;
- a href => '/u/newpass', 'Password reset'; br;
- a href => '/u/register', 'Register'; br;
- end;
- }
- end 'div'; # /menubox
-
- div class => 'menubox';
- h2 'Database Statistics';
- div;
- dl;
- dt 'Visual Novels'; dd $self->{stats}{vn};
- dt 'Releases'; dd $self->{stats}{releases};
- dt 'Producers'; dd $self->{stats}{producers};
- dt 'Characters'; dd $self->{stats}{chars};
- dt 'Staff'; dd $self->{stats}{staff};
- dt 'VN Tags'; dd $self->{stats}{tags};
- dt 'Character Traits';dd $self->{stats}{traits};
- dt 'Users'; dd $self->{stats}{users};
- dt 'Threads'; dd $self->{stats}{threads};
- dt 'Posts'; dd $self->{stats}{posts};
- end;
- clearfloat;
- end;
- end;
- end 'div'; # /menulist
-}
-
-
-sub htmlFooter { # %options => { pref_code => 1 }
- my($self, %o) = @_;
- div id => 'footer';
-
- my $q = $self->dbRandomQuote;
- if($q && $q->{vid}) {
- lit '"';
- a href => "/v$q->{vid}", style => 'text-decoration: none', $q->{quote};
- txt '"';
- br;
- }
-
- txt "vndb $self->{version} | ";
- a href => '/d7', 'about us';
- txt ' | ';
- a href => 'irc://irc.synirc.net/vndb', '#vndb';
- txt ' | ';
- a href => "mailto:$self->{admin_email}", $self->{admin_email};
- txt ' | ';
- a href => $self->{source_url}, 'source';
- end;
- end 'div'; # /maincontent
-
- # Abuse an empty noscript tag for the formcode to update a preference setting, if the page requires one.
- 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}, '';
- end 'body';
- end 'html';
-
- # write the SQL queries as a HTML comment when debugging is enabled
- if($self->debug) {
- lit "\n<!--\n SQL Queries:\n";
- for (@{$self->{_TUWF}{DB}{queries}}) {
- my($sql, $params, $time) = @$_;
- lit sprintf " [%6.2fms] %s | %s\n", $time*1000, $sql,
- join ', ',
- map "$_:".DBI::neat($params->{$_}),
- sort { $a =~ /^[0-9]+$/ && $b =~ /^[0-9]+$/ ? $a <=> $b : $a cmp $b }
- keys %$params
- }
- lit "-->\n";
- }
-}
-
-
-1;
diff --git a/lib/VNDB/Util/Misc.pm b/lib/VNDB/Util/Misc.pm
deleted file mode 100644
index 6a6496b3..00000000
--- a/lib/VNDB/Util/Misc.pm
+++ /dev/null
@@ -1,175 +0,0 @@
-
-package VNDB::Util::Misc;
-
-use strict;
-use warnings;
-use Exporter 'import';
-use TUWF ':html';
-use VNDB::Func;
-
-our @EXPORT = qw|filFetchDB bbSubstLinks|;
-
-
-our %filfields = (
- vn => [qw|date_before date_after released length hasani hasshot tag_inc tag_exc taginc tagexc tagspoil lang olang plat ul_notblack ul_onwish ul_voted ul_onlist|],
- release => [qw|type patch freeware doujin date_before date_after released minage lang olang resolution plat med voiced ani_story ani_ero|],
- char => [qw|gender bloodt bust_min bust_max waist_min waist_max hip_min hip_max height_min height_max weight_min weight_max trait_inc trait_exc tagspoil role|],
- staff => [qw|gender role truename lang|],
-);
-
-
-# Arguments:
-# type ('vn', 'release' or 'char'),
-# filter overwrite (string or undef),
-# when defined, these filters will be used instead of the preferences,
-# must point to a variable, will be modified in-place with the actually used filters
-# options to pass to db*Get() before the filters (hashref or undef)
-# these options can be overwritten by the filters or the next option
-# options to pass to db*Get() after the filters (hashref or undef)
-# these options overwrite all other options (pre-options and filters)
-
-sub filFetchDB {
- my($self, $type, $overwrite, $pre, $post) = @_;
- $pre = {} if !$pre;
- $post = {} if !$post;
- my $dbfunc = $self->can($type eq 'vn' ? 'dbVNGet' : $type eq 'release' ? 'dbReleaseGet' : $type eq 'char' ? 'dbCharGet' : 'dbStaffGet');
- my $prefname = 'filter_'.$type;
- my $pref = $self->authPref($prefname);
-
- my $filters = fil_parse $overwrite // $pref, @{$filfields{$type}};
-
- # compatibility
- $self->authPref($prefname => fil_serialize $filters)
- if $type eq 'vn' && _fil_vn_compat($self, $filters) && !defined $overwrite;
-
- # write the definite filter string in $overwrite
- $_[2] = fil_serialize({map +(
- exists($post->{$_}) ? ($_ => $post->{$_}) :
- exists($filters->{$_}) ? ($_ => $filters->{$_}) :
- exists($pre->{$_}) ? ($_ => $pre->{$_}) : (),
- ), @{$filfields{$type}}}) if defined $overwrite;
-
- return $dbfunc->($self, %$pre, %$filters, %$post) if defined $overwrite or !keys %$filters;;
-
- # since incorrect filters can throw a database error, we have to special-case
- # filters that originate from a preference setting, so that in case these are
- # the cause of an error, they are removed. Not doing this will result in VNDB
- # throwing 500's even for non-browse pages. We have to do some low-level
- # PostgreSQL stuff with savepoints to ensure that an error won't affect our
- # existing transaction.
- my $dbh = $self->dbh;
- $dbh->pg_savepoint('filter');
- my($r, $np);
- my $OK = eval {
- ($r, $np) = $dbfunc->($self, %$pre, %$filters, %$post);
- 1;
- };
- $dbh->pg_rollback_to('filter') if !$OK;
- $dbh->pg_release('filter');
-
- # error occured, let's try again without filters. if that succeeds we know
- # it's the fault of the filter preference, and we should remove it.
- if(!$OK) {
- ($r, $np) = $dbfunc->($self, %$pre, %$post);
- # if we're here, it means the previous function didn't die() (duh!)
- $self->authPref($prefname => '');
- warn sprintf "Reset filter preference for userid %d. Old: %s\n", $self->authInfo->{id}||0, $pref;
- }
- return wantarray ? ($r, $np) : $r;
-}
-
-
-sub _fil_vn_compat {
- my($self, $fil) = @_;
-
- # older tag specification (by name rather than ID)
- if($fil->{taginc} || $fil->{tagexc}) {
- my $tagfind = sub {
- return map {
- my $i = $self->dbTagGet(name => $_)->[0];
- $i && !$i->{meta} ? $i->{id} : ();
- } grep $_, ref $_[0] ? @{$_[0]} : ($_[0]||'')
- };
- $fil->{tag_inc} //= [ $tagfind->(delete $fil->{taginc}) ] if $fil->{taginc};
- $fil->{tag_exc} //= [ $tagfind->(delete $fil->{tagexc}) ] if $fil->{tagexc};
- return 1;
- }
-
- return 0;
-}
-
-
-sub bbSubstLinks {
- my ($self, $msg) = @_;
-
- # pre-parse vndb links within message body
- my (%lookup, %links);
- while ($msg =~ m/(?:^|\s)\K([vcpgis])([1-9][0-9]*)\b/g) {
- $lookup{$1}{$2} = 1;
- }
- return $msg unless %lookup;
- my @opt = (results => 50);
- # lookup parsed links
- if ($lookup{v}) {
- $links{"v$_->{id}"} = $_->{title} for (@{$self->dbVNGet(id => [keys %{$lookup{v}}], @opt)});
- }
- if ($lookup{c}) {
- $links{"c$_->{id}"} = $_->{name} for (@{$self->dbCharGet(id => [keys %{$lookup{c}}], @opt)});
- }
- if ($lookup{p}) {
- $links{"p$_->{id}"} = $_->{name} for (@{$self->dbProducerGet(id => [keys %{$lookup{p}}], @opt)});
- }
- if ($lookup{g}) {
- $links{"g$_->{id}"} = $_->{name} for (@{$self->dbTagGet(id => [keys %{$lookup{g}}], @opt)});
- }
- if ($lookup{i}) {
- $links{"i$_->{id}"} = $_->{name} for (@{$self->dbTraitGet(id => [keys %{$lookup{i}}], @opt)});
- }
- if ($lookup{s}) {
- $links{"s$_->{id}"} = $_->{name} for (@{$self->dbStaffGet(id => [keys %{$lookup{s}}], @opt)});
- }
- return $msg unless %links;
- my($result, @open) = ('', 'first');
-
- while($msg =~ m{
- (?:\b([tdvprcugis][1-9]\d*)(?:\.[1-9]\d*)?\b) | # 1. id
- (\[[^\s\]]+\]) | # 2. tag
- ((?:https?|ftp)://[^><"\n\s\]\[]+[\d\w=/-]) # 3. url
- }x) {
- my($match, $id, $tag) = ($&, $1, $2);
- $result .= $`;
- $msg = $';
-
- if($open[$#open] ne 'raw' && $open[$#open] ne 'code') {
- # handle tags
- if($tag) {
- $tag = lc $tag;
- if($tag eq '[raw]') {
- push @open, 'raw';
- } elsif($tag eq '[quote]') {
- push @open, 'quote';
- } elsif($tag eq '[code]') {
- push @open, 'code';
- } elsif($tag eq '[/quote]' && $open[$#open] eq 'quote') {
- pop @open;
- } elsif($match =~ m{\[url=((https?://|/)[^\]>]+)\]}i) {
- push @open, 'url';
- } elsif($tag eq '[/url]' && $open[$#open] eq 'url') {
- pop @open;
- }
- } elsif($id && !grep(/^(?:quote|url)/, @open) && $links{$id}) {
- $match = sprintf '[url=/%s]%s[/url]', $match, $links{$id};
- }
- }
- pop @open if($tag && $open[$#open] eq 'raw' && lc$tag eq '[/raw]');
- pop @open if($tag && $open[$#open] eq 'code' && lc$tag eq '[/code]');
-
- $result .= $match;
- }
- $result .= $msg;
-
- return $result;
-}
-
-1;
-
diff --git a/lib/VNDB/Util/ValidateTemplates.pm b/lib/VNDB/Util/ValidateTemplates.pm
deleted file mode 100644
index e7ff3102..00000000
--- a/lib/VNDB/Util/ValidateTemplates.pm
+++ /dev/null
@@ -1,103 +0,0 @@
-# This module implements various templates for formValidate()
-
-package VNDB::Util::ValidateTemplates;
-
-use strict;
-use warnings;
-use TUWF 'kv_validate';
-use VNDB::Func 'json_decode';
-use VNDBUtil 'gtintype';
-use Time::Local 'timegm';
-
-
-TUWF::set(
- validate_templates => {
- id => { template => 'uint', max => 1<<40 },
- page => { template => 'uint', max => 1000 },
- uname => { regex => qr/^[a-z0-9-]*$/, minlength => 2, maxlength => 15 },
- gtin => { func => \&gtintype },
- editsum => { maxlength => 5000, minlength => 2 },
- json => { func => \&json_validate, inherit => ['json_fields','json_maxitems','json_unique','json_sort'], default => [] },
- rdate => { template => 'uint', min => 0, max => 99999999, func => \&rdate_validate, default => 0 },
- }
-);
-
-
-# Figure out if a field is treated as a number in kv_validate().
-sub json_validate_is_num {
- my $opts = shift;
- return 0 if !$opts->{template};
- return 1 if $opts->{template} eq 'num' || $opts->{template} eq 'int' || $opts->{template} eq 'uint';
- my $t = TUWF::set('validate_templates')->{$opts->{template}};
- return $t && json_validate_is_num($t);
-}
-
-
-sub json_validate_sort {
- my($sort, $fields, $data) = @_;
-
- # Figure out which fields need to use number comparison
- my %nums;
- for my $k (@$sort) {
- my $f = (grep $_->{field} eq $k, @$fields)[0];
- $nums{$k}++ if json_validate_is_num($f);
- }
-
- # Sort
- return [sort {
- for(@$sort) {
- my $r = $nums{$_} ? $a->{$_} <=> $b->{$_} : $a->{$_} cmp $b->{$_};
- return $r if $r;
- }
- 0
- } @$data];
-}
-
-# Special validation function for simple JSON structures as form fields. It can
-# only validate arrays of key-value objects. The key-value objects are then
-# validated using kv_validate.
-# TODO: json_unique implies json_sort on the same fields? These options tend to be the same.
-sub json_validate {
- my($val, $opts) = @_;
- my $fields = $opts->{json_fields};
- my $maxitems = $opts->{json_maxitems};
- my $unique = $opts->{json_unique};
- my $sort = $opts->{json_sort};
- $unique = [$unique] if $unique && !ref $unique;
- $sort = [$sort] if $sort && !ref $sort;
-
- my $data = eval { json_decode $val };
- $_[0] = $@ ? [] : $data;
- return 0 if $@ || ref $data ne 'ARRAY';
- return 0 if defined($maxitems) && @$data > $maxitems;
-
- my %known_fields = map +($_->{field},1), @$fields;
- my %unique;
-
- for my $i (0..$#$data) {
- return 0 if ref $data->[$i] ne 'HASH';
- # Require that all keys are known and have a scalar value.
- return 0 if grep !$known_fields{$_} || ref($data->[$i]{$_}), keys %{$data->[$i]};
- $data->[$i] = kv_validate({ field => sub { $data->[$i]{shift()} } }, $TUWF::OBJ->{_TUWF}{validate_templates}, $fields);
- return 0 if $data->[$i]{_err};
- return 0 if $unique && $unique{ join '|||', map $data->[$i]{$_}, @$unique }++;
- }
-
- $_[0] = json_validate_sort($sort, $fields, $data) if $sort;
- return 1;
-}
-
-
-sub rdate_validate {
- return 0 if $_[0] ne 0 && $_[0] !~ /^(\d{4})(\d{2})(\d{2})$/;
- my($y, $m, $d) = defined $1 ? ($1, $2, $3) : (0,0,0);
-
- # Normalization ought to be done in JS, but do it here again because we can't trust browsers
- ($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 && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) };
- return 1;
-}
diff --git a/lib/VNDB/VN/Page.pm b/lib/VNDB/VN/Page.pm
new file mode 100644
index 00000000..59ea0ddb
--- /dev/null
+++ b/lib/VNDB/VN/Page.pm
@@ -0,0 +1,57 @@
+package VNDB::VN::Page;
+
+use strict;
+use warnings;
+use TUWF ':Html5';
+use VNDB::Auth;
+use VNDB::VN::DB;
+
+my $VID_RE = qr{v(?<vid>[1-9][0-9]*)};
+
+sub header {
+ Div class => 'header', sub {
+ Div class => 'header__nav', sub {
+ Div class => 'header__logo', 'vndb';
+ Div class => 'header__menu', 'Games';
+ };
+ Div class => 'header__user', auth->username || 'not logged in';
+ };
+}
+
+sub framework {
+ my $body = shift;
+ Html sub {
+ Head sub {
+ Meta name => 'viewport', content => 'width=device-width, initial-scale=1, shrink-to-fit=no';
+ Title 'VNDBv3 test';
+ Link rel => 'stylesheet', href => '/f/style.css';
+ };
+ Body sub {
+ Div class => 'container', sub {
+ header;
+ };
+ $body->();
+ };
+ };
+ Pre style => 'font-size: 8px', sub {
+ tuwf->dbCommit; # Hack to measure the commit time
+ Txt "SQL Queries:\n";
+ for (@{ tuwf->{_TUWF}{DB}{queries} }) {
+ my($sql, undef, $time) = @$_;
+ Txt sprintf " [%6.2fms] %s\n", $time*1000, $sql;
+ }
+ } if tuwf->debug;
+}
+
+
+
+
+
+TUWF::get qr{/$VID_RE}, sub {
+ framework sub {
+ Txt tuwf->capture('vid');
+ use Data::Dumper 'Dumper';
+ #Pre Dumper [ VNDB::VN::DB::get(undef, {hidden => 1}) ];
+ Pre Dumper [ VNDB::DB::entry(v => 1) ];
+ };
+};
diff --git a/static/f/style.css b/static/f/style.css
new file mode 100644
index 00000000..07f85ae1
--- /dev/null
+++ b/static/f/style.css
@@ -0,0 +1,268 @@
+* {
+ box-sizing: border-box;
+}
+
+html {
+ min-height: 100%;
+ background: #f3f3f3;
+ background-image: linear-gradient(#b5bec1, #f3f3f3);
+ background-size: 600px;
+ background-repeat: repeat-x;
+}
+
+body {
+ margin: 0;
+ color: #171717;
+ /* font-family: "Helvetica Neue", sans-serif; */
+ font-family: -apple-system,BlinkMacSystemFont,"Segoe UI",Roboto,"Helvetica Neue",Arial,sans-serif,"Apple Color Emoji","Segoe UI Emoji","Segoe UI Symbol";
+ font-size: 1rem;
+ line-height: 1.5;
+}
+
+dt {
+ font-weight: 600;
+}
+
+dd {
+ margin: 0 0 .7em 0;
+}
+
+.img--fit {
+ width: 100%;
+ height: auto;
+}
+
+.img--rounded {
+ border-radius: 4px;
+}
+.elevation-1 {
+ box-shadow: 0 15px 35px rgba(50,50,93,.2), 0 5px 15px rgba(0,0,0,.2);
+}
+
+.container {
+ padding: 0 15px;
+ margin: 0 auto;
+}
+
+.row {
+ margin: 0 -15px;
+ display: flex;
+ flex-wrap: wrap;
+}
+
+.col, .col-lg, .col-xl {
+ padding-left: 15px;
+ padding-right: 15px;
+}
+
+.col {
+ flex: 1;
+}
+
+.d-none { display: none; }
+.d-block { display: block; }
+
+@media (min-width: 576px) {
+ .container {
+ max-width: 540px;
+ }
+}
+@media (min-width: 768px) {
+ .container {
+ max-width: 720px;
+ }
+}
+@media (min-width: 992px) {
+ .container {
+ max-width: 960px;
+ }
+ .col-lg {
+ flex: 1;
+ padding-left: 15px;
+ padding-right: 15px;
+ }
+ .col-lg--2 { flex: 2; }
+ .col-lg--3 { flex: 3; }
+ .col-lg--4 { flex: 4; }
+ .d-lg-block { display: block; }
+ .d-lg-none { display: none; }
+}
+@media (min-width: 1200px) {
+ .container {
+ max-width: 1140px;
+ }
+ .col-xl {
+ flex: 1;
+ padding-left: 15px;
+ padding-right: 15px;
+ }
+ .col-xl--2 { flex: 2; }
+ .col-xl--3 { flex: 3; }
+ .col-xl--4 { flex: 4; }
+ .d-xl-block { display: block; }
+ .d-xl-none { display: none; }
+}
+@media (min-width: 1360px) {
+ .container {
+ max-width: 1300px;
+ }
+}
+
+
+
+.header {
+ display: flex;
+ align-items: center;
+ height: 64px;
+}
+
+.header__nav {
+ flex: 1;
+ display: flex;
+ align-items: center;
+}
+
+.header__logo {
+ font-weight: 500;
+ font-size: 18px;
+}
+
+.header__menu {
+ margin-left: 40px;
+ font-weight: 500;
+}
+
+.vn-header {
+ padding: 60px 0 80px 0;
+}
+
+.vn-header__title {
+ font-size: 40px;
+ font-weight: 500;
+}
+
+.vn-header__details {
+ margin-top: 8px;
+ font-weight: 500;
+}
+
+.sidebar__item {
+ position: relative;
+ display: flex;
+ align-items: center;
+ height: 30px;
+ font-size: 12px;
+ font-weight: 500;
+ color: #555;
+}
+
+.sidebar__item--active::before {
+ display: block;
+ content: '';
+ position: absolute;
+ left: -20px;
+ width: 6px;
+ height: 6px;
+ border-radius: 6px;
+ background: #555;
+}
+
+.vn-page {
+ padding-bottom: 100px; /* tmp */
+}
+
+.vn-page__top {
+ display: flex;
+}
+
+.vn-page__top-main {
+ flex: 1;
+}
+
+.vn-page__top-details {
+ padding: 15px;
+ padding-top: 65px;
+}
+
+@media (min-width: 992px) {
+ .vn-page__top-details {
+ width: 230px;
+ margin-left: 40px;
+ margin-right: 15px;
+ padding: 0;
+ padding-top: 65px;
+ }
+}
+
+.vn-page__top-body {
+ display: flex;
+}
+
+.vn-page__nav {
+ width: 230px;
+}
+
+.vn-page__description {
+ font-family: serif;
+ line-height: 1.3;
+ font-size: 1.2em;
+}
+
+.vn-page__sidebar {
+ width: 230px;
+ padding: 0 15px;
+}
+
+.section__title {
+ font-weight: 500;
+}
+
+.vn-page__top-details > * {
+ margin-bottom: 25px;
+}
+
+.vn-page__dl {
+ font-size: 0.9em;
+ margin-top: 35px;
+}
+
+.section {
+ margin-top: 4em;
+}
+
+.section__title {
+ margin: 0 0 0.5em 0;
+}
+
+.add-to-list {
+ background: white;
+ border-radius: 4px;
+ padding: 0.8em 1em;
+}
+
+.spoiler {
+ background-color: #ccc;
+ color: #ccc;
+}
+
+.spoiler:hover {
+ background-color: rgba(0, 0, 0, 0.05);
+ color: inherit;
+}
+
+.gallery {
+ display: flex;
+ flex-wrap: wrap;
+ margin: -7px;
+}
+
+.gallery__image {
+ margin: 7px;
+}
+
+.fake-img {
+ width: 200px;
+ height: 120px;
+ background-color: #aaa;
+ border-radius: 4px;
+}
diff --git a/util/vndb.pl b/util/vndb.pl
index c0af72e1..efdc5e25 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -1,97 +1,42 @@
#!/usr/bin/perl
-
-package VNDB;
-
use strict;
use warnings;
-
+use TUWF;
use Cwd 'abs_path';
-our $ROOT;
+my $ROOT;
BEGIN { ($ROOT = abs_path $0) =~ s{/util/vndb\.pl$}{}; }
-
-$|=1; # Disable buffering on STDOUT, otherwise vndb-dev-server.pl won't pick up our readyness notification.
-
use lib $ROOT.'/lib';
+$|=1; # Disable buffering on STDOUT, otherwise vndb-dev-server.pl won't pick up our readyness notification.
-use TUWF ':html';
-use SkinFile;
-
-
-our(%O, %S);
-
-
-# load the skins
-# NOTE: $S{skins} can be modified in data/config.pl, allowing deletion of skins or forcing only one skin
-my $skin = SkinFile->new("$ROOT/static/s");
-$S{skins} = { map +($_ => [ $skin->get($_, 'name'), $skin->get($_, 'userid') ]), $skin->list };
-
-
-# load settings from global.pl
-require $ROOT.'/data/global.pl';
-
-
-# automatically regenerate the skins and script.js and whatever else should be done
-system "make -sC $ROOT" if $S{regen_static};
-
-
-$TUWF::OBJ->{$_} = $S{$_} for (keys %S);
-TUWF::set(
- %O,
- pre_request_handler => \&reqinit,
- error_404_handler => \&handle404,
- log_format => \&logformat,
-);
-TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler');
-TUWF::run();
+my $conf = require $ROOT.'/data/config3.pl';
-sub reqinit {
- my $self = shift;
+# Make the configuration available as tuwf->conf
+sub TUWF::Object::conf { $conf }
- # If we're running standalone, serve www/ and static/ too.
- if($TUWF::OBJ->{_TUWF}{http}) {
- if($self->resFile("$ROOT/www", $self->reqPath) || $self->resFile("$ROOT/static", $self->reqPath)) {
- $self->resHeader('Cache-Control' => 'max-age=31536000');
- return 0;
- }
- }
- # check authentication cookies
- $self->authInit;
+# Make our root path available as tuwf->root
+# Optionally accepts other path components to assemble a file path:
+# tuwf->root('static/sf/01/1.jpg')
+sub TUWF::Object::root { shift; join '/', $ROOT, @_ }
- # load some stats (used for about all pageviews, anyway)
- $self->{stats} = $self->dbStats;
- return 1;
-}
+TUWF::set %{ $conf->{tuwf} || {} };
-sub handle404 {
- my $self = shift;
- $self->resStatus(404);
- $self->htmlHeader(title => 'Page Not Found');
- div class => 'mainbox';
- h1 'Page not found';
- div class => 'warning';
- h2 'Oops!';
- p;
- txt 'It seems the page you were looking for does not exist,';
- br;
- txt 'you may want to try using the menu on your left to find what you are looking for.';
- end;
- end;
- end;
- $self->htmlFooter;
-}
+# If we're running standalone, serve www/ and static/ too.
+TUWF::hook before => sub {
+ my $static = tuwf->{_TUWF}{http} &&
+ ( tuwf->resFile(tuwf->root('www'), tuwf->reqPath)
+ || tuwf->resFile(tuwf->root('static'), tuwf->reqPath)
+ );
+ tuwf->resHeader('Cache-Control' => 'max-age=31536000') if $static;
+ !$static;
+};
-# log user IDs (necessary for determining performance issues, user preferences
-# have a lot of influence in this)
-sub logformat {
- my($self, $uri, $msg) = @_;
- sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri,
- $self->authInfo->{id} ? 'u'.$self->authInfo->{id} : '-', $msg;
-}
+TUWF::load_recursive 'VNDB';
+TUWF::run;