diff options
Diffstat (limited to 'lib/VNDB/Util/DB.pm')
-rw-r--r-- | lib/VNDB/Util/DB.pm | 1582 |
1 files changed, 0 insertions, 1582 deletions
diff --git a/lib/VNDB/Util/DB.pm b/lib/VNDB/Util/DB.pm deleted file mode 100644 index dac01a52..00000000 --- a/lib/VNDB/Util/DB.pm +++ /dev/null @@ -1,1582 +0,0 @@ - -package VNDB::Util::DB; - -use strict; -use warnings; -use DBI; -use Exporter 'import'; - -use vars ('$VERSION', '@EXPORT'); -$VERSION = $VNDB::VERSION; - -@EXPORT = qw| - DBInit DBCheck DBCommit DBRollBack DBExit - DBLanguageCount DBCategoryCount DBTableCount DBGetHist DBLockItem DBIncId DBAddScreenshot DBGetScreenshot - DBGetUser DBAddUser DBUpdateUser DBDelUser - DBGetVotes DBVoteStats DBAddVote DBDelVote - DBGetVNList DBDelVNList - DBGetWishList DBEditWishList DBDelWishList - DBGetRList DBGetRLists DBEditRList DBDelRList - DBGetVN DBAddVN DBEditVN DBHideVN DBVNCache - DBGetRelease DBAddRelease DBEditRelease DBHideRelease - DBGetProducer DBGetProducerVN DBAddProducer DBEditProducer DBHideProducer - DBGetThreads DBGetPosts DBAddPost DBEditPost DBEditThread DBAddThread - DBExec DBRow DBAll -|; - - - - - -#-----------------------------------------------------------------------------# -# I M P O R T A N T S T U F F # -#-----------------------------------------------------------------------------# - - -sub new { - my $me = shift; - - my $type = ref($me) || $me; - $me = bless { o => \@_ }, $type; - - $me->DBInit(); - - return $me; -} - - -sub DBInit { - my $self = shift; - my $info = $self->{_DB} || $self; - - $info->{sql} = DBI->connect(@{$self->{o}}, { - PrintError => 0, RaiseError => 1, - AutoCommit => 0, pg_enable_utf8 => 1, - } - ); -} - - -sub DBCheck { - my $self = shift; - my $info = $self->{_DB} || $self; - - require Time::HiRes - if $self->{debug} && !$Time::Hires::VERSION; - $info->{Queries} = [] if $self->{debug}; - my $start = [Time::HiRes::gettimeofday()] if $self->{debug}; - - if(!$info->{sql}->ping) { - warn "Ping failed, reconnecting"; - $self->DBInit; - } - $info->{sql}->rollback(); - push(@{$info->{Queries}}, - [ 'ping/rollback', Time::HiRes::tv_interval($start) ]) - if $self->{debug}; -} - - -sub DBCommit { - my $self = shift; - my $info = $self->{_DB} || $self; - my $start = [Time::HiRes::gettimeofday()] if $self->{debug}; - $info->{sql}->commit(); - push(@{$info->{Queries}}, - [ 'commit', Time::HiRes::tv_interval($start) ]) - if $self->{debug}; -} - - -sub DBRollBack { - my $self = shift; - my $info = $self->{_DB} || $self; - $info->{sql}->rollback(); -} - - -sub DBExit { - my $self = shift; - my $info = $self->{_DB} || $self; - $info->{sql}->disconnect(); -} - - -# XXX: this function should be disabled when performance is going to be a problem -sub DBCategoryCount { - return { - (map { map { $_, 0 } keys %{$VNDB::CAT->{$_}[1]} } keys %{$VNDB::CAT}), - map { $_->{cat}, $_->{cnt} } @{shift->DBAll(q| - SELECT cat, COUNT(vid) AS cnt - FROM vn_categories vc - JOIN vn v ON v.latest = vc.vid - WHERE v.hidden = FALSE - GROUP BY cat - ORDER BY cnt| - )} - }; -} - - -# XXX: Above comment also applies to this function -sub DBLanguageCount { - return { (map { $_ => 0 } keys %$VNDB::LANG ), - map { $_->{language} => $_->{count} } @{shift->DBAll(q| - SELECT rr.language, COUNT(DISTINCT v.id) AS count - FROM releases_rev rr - JOIN releases r ON r.latest = rr.id - JOIN releases_vn rv ON rv.rid = rr.id - JOIN vn v ON v.id = rv.vid - WHERE r.hidden = FALSE - AND v.hidden = FALSE - AND rr.type <> 2 - AND rr.released <= TO_CHAR('today'::timestamp, 'YYYYMMDD')::integer - GROUP BY rr.language|)} }; -} - - -sub DBTableCount { # table (users, producers, vn, releases, votes) - return $_[0]->DBRow(q| - SELECT COUNT(*) as cnt - FROM !s - !W|, - $_[1], - $_[1] =~ /producers|vn|releases/ ? { 'hidden = ?' => 0 } : {}, - )->{cnt} - ($_[1] eq 'users' ? 1 : 0); -} - - - -# XXX: iid, ititle and hidden columns should be cached if performance will be a problem -sub DBGetHist { # %options->{ type, id, cid, caused, next, page, results, ip, edits, showhid, what } (Item hist) - my($s, %o) = @_; - - $o{results} ||= $o{next} ? 1 : 50; - $o{page} ||= 1; - $o{type} ||= ''; - $o{what} ||= ''; #flags: user iid ititle - $o{showhid} ||= $o{type} && $o{type} ne 'u' && $o{id} || $o{cid} ? 1 : 0; - - my %where = ( - $o{cid} ? ( - 'c.id IN(!l)' => [$o{cid}] ) : (), - $o{type} eq 'u' ? ( - 'c.requester = ?' => $o{id} ) : (), - - $o{type} eq 'v' && !$o{releases} ? ( 'c.type = ?' => 0, - $o{id} ? ( 'vr.vid = ?' => $o{id} ) : () ) : (), - $o{type} eq 'v' && $o{releases} ? ( - '((c.type = ? AND vr.vid = ?) OR (c.type = ? AND rv.vid = ?))' => [0,$o{id},1,$o{id}] ) : (), - - $o{type} eq 'r' ? ( 'c.type = ?' => 1, - $o{id} ? ( 'rr.rid = ?' => $o{id} ) : () ) : (), - $o{type} eq 'p' ? ( 'c.type = ?' => 2, - $o{id} ? ( 'pr.pid = ?' => $o{id} ) : () ) : (), - - $o{caused} ? ( - 'c.causedby = ?' => $o{caused} ) : (), - $o{ip} ? ( - 'c.ip = ?' => $o{ip} ) : (), - defined $o{edits} && !$o{edits} ? ( - 'c.rev = ?' => 1 ) : (), - $o{edits} ? ( - 'c.rev > ?' => 1 ) : (), - - # get rid of 'hidden' items - !$o{showhid} ? ( - '(v.hidden IS NOT NULL AND v.hidden = FALSE OR r.hidden IS NOT NULL AND r.hidden = FALSE OR p.hidden IS NOT NULL AND p.hidden = FALSE)' => 1, - ) : $o{showhid} == 2 ? ( - '(v.hidden IS NOT NULL AND v.hidden = TRUE OR r.hidden IS NOT NULL AND r.hidden = TRUE OR p.hidden IS NOT NULL AND p.hidden = TRUE)' => 1, - ) : (), - ); - - my $select = 'c.id, c.type, c.added, c.requester, c.comments, c.rev, c.causedby'; - $select .= ', u.username' if $o{what} =~ /user/; - $select .= ', COALESCE(vr.vid, rr.rid, pr.pid) AS iid' if $o{what} =~ /iid/; - $select .= ', COALESCE(vr2.title, rr2.title, pr2.name) AS ititle, COALESCE(vr2.original, rr2.original, pr2.original) AS ioriginal' if $o{what} =~ /ititle/; - - my $join = ''; - $join .= ' JOIN users u ON u.id = c.requester' if $o{what} =~ /user/; - $join .= ' LEFT JOIN vn_rev vr ON c.type = 0 AND c.id = vr.id'. - ' LEFT JOIN releases_rev rr ON c.type = 1 AND c.id = rr.id'. - ' LEFT JOIN producers_rev pr ON c.type = 2 AND c.id = pr.id' if $o{what} =~ /(iid|ititle)/ || $o{releases} || $o{id} || !$o{showhid}; - # these joins should be optimised away at some point (cache the required columns in changes as mentioned above) - $join .= ' LEFT JOIN vn v ON v.id = vr.vid'. - ' LEFT JOIN vn_rev vr2 ON vr2.id = v.latest'. - ' LEFT JOIN releases r ON r.id = rr.rid'. - ' LEFT JOIN releases_rev rr2 ON rr2.id = r.latest'. - ' LEFT JOIN producers p ON p.id = pr.pid'. - ' LEFT JOIN producers_rev pr2 ON pr2.id = p.latest' if $o{what} =~ /ititle/ || $o{releases} || !$o{showhid}; - $join .= ' LEFT JOIN releases_vn rv ON c.id = rv.rid' if $o{type} eq 'v' && $o{releases}; - - my $r = $s->DBAll(qq| - SELECT $select - FROM changes c - $join - !W - ORDER BY c.id !s - LIMIT ? OFFSET ?|, - \%where, - $o{next} ? 'ASC' : 'DESC', - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - return $r if !wantarray; - return ($r, 0) if $#$r != $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBLockItem { # table, id, locked - my($s, $tbl, $id, $l) = @_; - $s->DBExec(q| - UPDATE !s - SET locked = ? - WHERE id = ?|, - $tbl, $l?1:0, $id); -} - - -sub DBIncId { # sequence (this is a rather low-level function... aww heck...) - return $_[0]->DBRow(q|SELECT nextval(?) AS ni|, $_[1])->{ni}; -} - - -sub DBAddScreenshot { # just returns an ID - return $_[0]->DBRow(q|INSERT INTO screenshots (status) VALUES(0) RETURNING id|)->{id}; -} - - -sub DBGetScreenshot { # ids - return $_[0]->DBAll(q|SELECT * FROM screenshots WHERE id IN(!l)|, $_[1]); -} - - - -#-----------------------------------------------------------------------------# -# A U T H / U S E R S T U F F # -#-----------------------------------------------------------------------------# - - -sub DBGetUser { # %options->{ username mail passwd order firstchar uid results page what } - my $s = shift; - my %o = ( - order => 'username ASC', - page => 1, - results => 10, - what => '', - @_ - ); - - my %where = ( - 'id > 0' => 1, - $o{username} ? ( - 'username = ?' => $o{username} ) : (), - $o{mail} ? ( - 'mail = ?' => $o{mail} ) : (), - $o{passwd} ? ( - 'passwd = decode(?, \'hex\')' => $o{passwd} ) : (), - $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} ? ( - 'id = ?' => $o{uid} ) : (), - !$o{uid} && !$o{username} ? ( - 'id > 0' => 1 ) : (), - ); - - my $r = $s->DBAll(q| - SELECT * - FROM users u - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - - # XXX: easy to cache, good performance win - if($o{what} =~ /list/ && $#$r >= 0) { - my %r = map { - $r->[$_]{votes} = 0; - $r->[$_]{changes} = 0; - ($r->[$_]{id}, $_) - } 0..$#$r; - - $r->[$r{$_->{uid}}]{votes} = $_->{cnt} for (@{$s->DBAll(q| - SELECT uid, COUNT(vid) AS cnt - FROM votes - WHERE uid IN(!l) - GROUP BY uid|, - [ keys %r ] - )}); - - $r->[$r{$_->{requester}}]{changes} = $_->{cnt} for (@{$s->DBAll(q| - SELECT requester, COUNT(id) AS cnt - FROM changes - WHERE requester IN(!l) - GROUP BY requester|, - [ keys %r ] - )}); - } - - return $r if !wantarray; - return ($r, 0) if $#$r != $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBAddUser { # username, passwd, mail, rank - return $_[0]->DBExec(q| - INSERT INTO users - (username, passwd, mail, rank, registered) - VALUES (?, decode(?, 'hex'), ?, ?, ?)|, - lc($_[1]), $_[2], $_[3], $_[4], time - ); -} - - -sub DBUpdateUser { # uid, %options->{ columns in users table } - my $s = shift; - my $user = shift; - my %opt = @_; - my %h; - - defined $opt{$_} && ($h{$_.' = ?'} = $opt{$_}) - for (qw| username mail rank flags |); - $h{'passwd = decode(?, \'hex\')'} = $opt{passwd} - if defined $opt{passwd}; - - return 0 if scalar keys %h <= 0; - return $s->DBExec(q| - UPDATE users - !H - WHERE id = ?|, - \%h, $user); -} - - -sub DBDelUser { # uid - my($s, $id) = @_; - $s->DBExec($_, $id) for ( - q|DELETE FROM vnlists WHERE uid = ?|, - q|DELETE FROM rlists WHERE uid = ?|, - q|DELETE FROM wlists WHERE uid = ?|, - q|DELETE FROM votes WHERE uid = ?|, - q|UPDATE changes SET requester = 0 WHERE requester = ?|, - q|UPDATE threads_posts SET uid = 0 WHERE uid = ?|, - q|DELETE FROM users WHERE id = ?| - ); -} - - - - - - -#-----------------------------------------------------------------------------# -# V O T E S # -#-----------------------------------------------------------------------------# - - -sub DBGetVotes { # %options->{ uid vid hide order results page } - my($s, %o) = @_; - $o{order} ||= 'n.date DESC'; - $o{results} ||= 50; - $o{page} ||= 1; - - my %where = ( - $o{uid} ? ( 'n.uid = ?' => $o{uid} ) : (), - $o{vid} ? ( 'n.vid = ?' => $o{vid} ) : (), - $o{hide} ? ( 'u.flags & ? = ?' => [ $VNDB::UFLAGS->{list}, $VNDB::UFLAGS->{list} ] ) : (), - ); - - my $r = $s->DBAll(q| - SELECT n.vid, vr.title, vr.original, n.vote, n.date, n.uid, u.username - FROM votes n - JOIN vn v ON v.id = n.vid - JOIN vn_rev vr ON vr.id = v.latest - JOIN users u ON u.id = n.uid - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBVoteStats { # uid|vid => id - my($s, $col, $id) = @_; - my $r = [ qw| 0 0 0 0 0 0 0 0 0 0 | ]; - $r->[$_->{vote}-1] = $_->{votes} for (@{$s->DBAll(q| - SELECT vote, COUNT(vote) as votes - FROM votes - !W - GROUP BY vote|, - $col ? { '!s = ?' => [ $col, $id ] } : {}, - )}); - return $r; -} - - -sub DBAddVote { # vid, uid, vote - $_[0]->DBExec(q| - UPDATE votes - SET vote = ? - WHERE vid = ? - AND uid = ?|, - $_[3], $_[1], $_[2] - ) || $_[0]->DBExec(q| - INSERT INTO votes - (vid, uid, vote, date) - VALUES (!l)|, - [ @_[1..3], time ] - ); -} - - -sub DBDelVote { # uid, vid # uid = 0 to delete all - $_[0]->DBExec(q| - DELETE FROM votes - !W|, - { 'vid = ?' => $_[2], - $_[1] ? ('uid = ?' => $_[1]) : () - } - ); -} - - - - - -#-----------------------------------------------------------------------------# -# U S E R V I S U A L N O V E L L I S T S # -#-----------------------------------------------------------------------------# - - -sub DBGetVNList { # %options->{ uid vid hide order results page status } - my($s, %o) = @_; - $o{results} ||= 10; - $o{page} ||= 1; - $o{order} ||= 'l.date DESC'; - - my %where = ( - $o{uid} ? ( - 'l.uid = ?' => $o{uid} ) : (), - $o{vid} ? ( - 'l.vid = ?' => $o{vid} ) : (), - defined $o{status} ? ( - 'l.status = ?' => $o{status} ) : (), - $o{hide} ? ( 'u.flags & ? = ?' => [ $VNDB::UFLAGS->{list}, $VNDB::UFLAGS->{list} ] ) : (), - ); - - return wantarray ? ([], 0) : [] if !keys %where; - - my $r = $s->DBAll(q| - SELECT l.vid, vr.title, l.status, l.comments, l.date, l.uid, u.username - FROM vnlists l - JOIN vn v ON l.vid = v.id - JOIN vn_rev vr ON vr.id = v.latest - JOIN users u ON l.uid = u.id - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBDelVNList { # uid, @vid # uid = 0 to delete all - my($s, $uid, @vid) = @_; - $s->DBExec(q| - DELETE FROM vnlists - !W|, - { 'vid IN (!l)' => [\@vid], - $uid ? ('uid = ?' => $uid) : () - } - ); -} - - - - - -#-----------------------------------------------------------------------------# -# U S E R W I S H L I S T S # -#-----------------------------------------------------------------------------# - - -sub DBGetWishList { # %options->{ uid vid what order page results } - my($s, %o) = @_; - - $o{order} ||= 'wl.wstat ASC'; - $o{page} ||= 1; - $o{results} ||= 50; - $o{what} ||= ''; - - my %where = ( - 'wl.uid = ?' => $o{uid}, - $o{vid} ? ( 'wl.vid = ?' => $o{vid} ) : (), - ); - - my $select = 'wl.vid, wl.wstat, wl.added'; - my @join; - if($o{what} =~ /vn/) { - $select .= ', vr.title, vr.original'; - push @join, 'JOIN vn v ON v.id = wl.vid', - 'JOIN vn_rev vr ON vr.id = v.latest'; - } - - my $r = $s->DBAll(qq| - SELECT $select - FROM wlists wl - @join - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBEditWishList { # %options->{ uid vid wstat } - my($s, %o) = @_; - $s->DBExec(q|UPDATE wlists SET wstat = ? WHERE uid = ? AND vid IN(!l)|, - $o{wstat}, $o{uid}, ref($o{vid}) eq 'ARRAY' ? $o{vid} : [ $o{vid} ]) - || - $s->DBExec(q|INSERT INTO wlists (uid, vid, wstat) - VALUES(!l)|, - [@o{qw| uid vid wstat |}]); -} - - -sub DBDelWishList { # uid, vids - my($s, $uid, $vid) = @_; - $s->DBExec(q|DELETE FROM wlists WHERE uid = ? AND vid IN(!l)|, $uid, $vid); -} - - - - - - -#-----------------------------------------------------------------------------# -# U S E R R E L E A S E L I S T S # -#-----------------------------------------------------------------------------# - - -sub DBGetRList { # %options->{ uid rids } - my($s, %o) = @_; - - my %where = ( - 'uid = ?' => $o{uid}, - $o{rids} ? ( - 'rid IN(!l)' => [$o{rids}] ) : (), - ); - - return $s->DBAll(q| - SELECT uid, rid, rstat, vstat - FROM rlists - !W|, - \%where); -} - - -# separate function, which also fetches VN info and votes -sub DBGetRLists { # %options->{ uid order char rstat vstat voted page results } - my($s, %o) = @_; - - $o{results} ||= 50; - $o{page} ||= 1; - - # bit ugly... - my $where = !$o{rstat} && !$o{vstat} ? 'vo.vote IS NOT NULL' : ''; - $where .= ($where?' OR ':'').q|v.id IN( - SELECT irv.vid - FROM rlists irl - JOIN releases ir ON ir.id = irl.rid - JOIN releases_vn irv ON irv.rid = ir.latest - !W - )| if !$o{voted}; - $where = '('.$where.') AND LOWER(SUBSTR(vr.title, 1, 1)) = \''.$o{char}.'\'' if $o{char}; - $where = '('.$where.') AND (ASCII(vr.title) < 97 OR ASCII(vr.title) > 122) AND (ASCII(vr.title) < 65 OR ASCII(vr.title) > 90)' if defined $o{char} && !$o{char}; - - # WHERE clause for the rlists subquery - my %where = ( - 'uid = ?' => $o{uid}, - defined $o{rstat} ? ( 'rstat = ?' => $o{rstat} ) : (), - defined $o{vstat} ? ( 'vstat = ?' => $o{vstat} ) : (), - ); - - my $r = $s->DBAll(qq| - SELECT vr.vid, vr.title, vr.original, v.c_released, v.c_languages, v.c_platforms, COALESCE(vo.vote, 0) AS vote - FROM vn v - JOIN vn_rev vr ON vr.id = v.latest - !s JOIN votes vo ON vo.vid = v.id AND vo.uid = ? - WHERE $where - ORDER BY !s - LIMIT ? OFFSET ?|, - $o{voted} ? '' : 'LEFT', $o{uid}, # JOIN if we only want votes, LEFT JOIN if we also want rlist items - $o{voted} ? () : \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - - # now fetch the releases and link them to VNs - if(@$r) { - my %vns = map { $_->{rels}=[]; $_->{vid}, $_->{rels} } @$r; - push @{$vns{$_->{vid}}}, $_ for (@{$s->DBAll(q| - SELECT rv.vid, rr.rid, rr.title, rr.original, rr.released, rr.type, rr.language, rr.minage, rl.rstat, rl.vstat - FROM rlists rl - JOIN releases r ON rl.rid = r.id - JOIN releases_rev rr ON rr.id = r.latest - JOIN releases_vn rv ON rv.rid = r.latest - WHERE rl.uid = ? - AND rv.vid IN(!l) - ORDER BY rr.released ASC|, - $o{uid}, [ keys %vns ] - )}); - } - - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBEditRList { # %options->{ uid rid rstat vstat } - # rid can only be a arrayref with UPDATE - my($s, %o) = @_; - my %s = ( - defined $o{rstat} ? ( 'rstat = ?', $o{rstat} ) : (), - defined $o{vstat} ? ( 'vstat = ?', $o{vstat} ) : (), - ); - $o{rstat}||=0; - $o{vstat}||=0; - - $s->DBExec(q|UPDATE rlists !H WHERE uid = ? AND rid IN(!l)|, - \%s, $o{uid}, ref($o{rid}) eq 'ARRAY' ? $o{rid} : [ $o{rid} ]) - || - $s->DBExec(q|INSERT INTO rlists (uid, rid, rstat, vstat) - VALUES(!l)|, - [@o{qw| uid rid rstat vstat |}]); -} - - -sub DBDelRList { # uid, \@rids - my($s, $uid, $rid) = @_; - $s->DBExec(q|DELETE FROM rlists WHERE uid = ? AND rid IN(!l)|, $uid, ref($rid) eq 'ARRAY' ? $rid : [ $rid ]); -} - - - - - -#-----------------------------------------------------------------------------# -# V I S U A L N O V E L S # -#-----------------------------------------------------------------------------# - - -sub DBGetVN { # %options->{ id rev char search order results page what cati cate lang platform } - my $s = shift; - my %o = ( - page => 1, - results => 50, - order => 'vr.title ASC', - what => '', - @_ ); - - my %where = ( - !$o{id} && !$o{rev} ? ( # don't fetch hidden items unless we ask for an ID - 'v.hidden = ?' => 0 ) : (), - $o{id} && !ref($o{id}) ? ( - 'v.id = ?' => $o{id} ) : (), - $o{id} && ref($o{id}) ? ( - 'v.id IN(!l)' => [$o{id}] ) : (), - $o{rev} ? ( - 'c.rev = ?' => $o{rev} ) : (), - $o{char} ? ( - 'LOWER(SUBSTR(vr.title, 1, 1)) = ?' => $o{char} ) : (), - defined $o{char} && !$o{char} ? ( - '(ASCII(vr.title) < 97 OR ASCII(vr.title) > 122) AND (ASCII(vr.title) < 65 OR ASCII(vr.title) > 90)' => 1 ) : (), - $o{cati} && @{$o{cati}} ? ( q| - v.id IN(SELECT iv.id - FROM vn_categories ivc - JOIN vn iv ON iv.latest = ivc.vid - WHERE cat IN(!l) - GROUP BY iv.id - HAVING COUNT(cat) = ?)| => [ $o{cati}, $#{$o{cati}}+1 ] ) : (), - $o{cate} && @{$o{cate}} ? ( q| - v.id NOT IN(SELECT iv.id - FROM vn_categories ivc - JOIN vn iv ON iv.latest = ivc.vid - WHERE cat IN(!l) - GROUP BY iv.id)| => [ $o{cate} ] ) : (), - # this needs some proper handling... - $o{lang} && @{$o{lang}} ? ( - '('.join(' OR ', map "v.c_languages ILIKE '%%$_%%'", @{$o{lang}}).')' => 1 ) : (), - $o{platform} && @{$o{platform}} ? ( - '('.join(' OR ', map "v.c_platforms ILIKE '%%$_%%'", @{$o{platform}}).')' => 1 ) : (), - ); - - if($o{search}) { - my @w; - for (split /[ -,]/, $o{search}) { - s/%//g; - next if length($_) < 2; - if(VNDB::GTINType($_)) { - push @w, 'irr.gtin = ?', $_; - } else { - $_ = "%$_%"; - push @w, '(ivr.title ILIKE ? OR ivr.alias ILIKE ? OR irr.title ILIKE ? OR irr.original ILIKE ?)', - [ $_, $_, $_, $_ ]; - } - } - $where{ q| - v.id IN(SELECT iv.id - FROM vn iv - JOIN vn_rev ivr ON iv.latest = ivr.id - LEFT JOIN releases_vn irv ON irv.vid = iv.id - LEFT JOIN releases_rev irr ON irr.id = irv.rid - LEFT JOIN releases ir ON ir.latest = irr.id - !W - GROUP BY iv.id)| } = [ \@w ] if @w; - } - - my @join = ( - $o{rev} ? - 'JOIN vn v ON v.id = vr.vid' : - 'JOIN vn v ON vr.id = v.latest', - $o{what} =~ /changes/ || $o{rev} ? ( - 'JOIN changes c ON c.id = vr.id', - 'JOIN users u ON u.id = c.requester' ) : (), - $o{what} =~ /relgraph/ ? ( - 'LEFT JOIN relgraph rg ON rg.id = v.rgraph' ) : (), - ); - - my $sel = 'v.id, v.locked, v.hidden, v.c_released, v.c_languages, v.c_platforms, vr.title, vr.original, vr.id AS cid'; - $sel .= ', vr.alias, vr.image AS image, vr.img_nsfw, vr.length, vr.desc, vr.l_wp, vr.l_encubed, vr.l_renai, vr.l_vnn' if $o{what} =~ /extended/; - $sel .= ', c.added, c.requester, c.comments, v.latest, u.username, c.rev, c.causedby' if $o{what} =~ /changes/; - $sel .= ', v.rgraph, rg.cmap' if $o{what} =~ /relgraph/; - - my $r = $s->DBAll(qq| - SELECT $sel - FROM vn_rev vr - @join - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - $_->{c_released} = sprintf '%08d', $_->{c_released} for @$r; - - if($o{what} =~ /(?:relations|categories|anime|screenshots)/ && $#$r >= 0) { - my %r = map { - $r->[$_]{relations} = []; - $r->[$_]{categories} = []; - $r->[$_]{anime} = []; - $r->[$_]{screenshots} = []; - ($r->[$_]{cid}, $_) - } 0..$#$r; - - if($o{what} =~ /categories/) { - push(@{$r->[$r{$_->{vid}}]{categories}}, [ $_->{cat}, $_->{lvl} ]) for (@{$s->DBAll(q| - SELECT vid, cat, lvl - FROM vn_categories - WHERE vid IN(!l)|, - [ keys %r ] - )}); - } - - if($o{what} =~ /anime/) { - push(@{$r->[$r{$_->{vid}}]{anime}}, $_) && delete $_->{vid} for (@{$s->DBAll(q| - SELECT va.vid, a.* - FROM vn_anime va - JOIN anime a ON va.aid = a.id - WHERE va.vid IN(!l)|, - [ keys %r ] - )}); - } - - if($o{what} =~ /screenshots/) { - push(@{$r->[$r{$_->{vid}}]{screenshots}}, $_) && delete $_->{vid} for (@{$s->DBAll(q| - SELECT vs.vid, s.id, vs.nsfw, vs.rid, s.width, s.height - FROM vn_screenshots vs - JOIN screenshots s ON vs.scr = s.id - WHERE vs.vid IN(!l) - ORDER BY vs.scr|, - [ keys %r ] - )}); - } - - if($o{what} =~ /relations/) { - my $rel = $s->DBAll(q| - SELECT rel.vid1, rel.vid2, rel.relation, vr.title, vr.original - FROM vn_relations rel - JOIN vn v ON rel.vid2 = v.id - JOIN vn_rev vr ON v.latest = vr.id - WHERE rel.vid1 IN(!l)|, - [ keys %r ]); - push(@{$r->[$r{$_->{vid1}}]{relations}}, { - relation => $_->{relation}, - id => $_->{vid2}, - title => $_->{title}, - original => $_->{original} - }) for (@$rel); - } - } - - return $r if !wantarray; - return ($r, 0) if $#$r != $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBAddVN { # %options->{ comm + _insert_vn_rev } - my($s, %o) = @_; - - my $id = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments) - VALUES (!l) - RETURNING id|, - [ 0, $s->AuthInfo->{id}, $s->ReqIP, $o{comm} ] - )->{id}; - - my $vid = $s->DBRow(q| - INSERT INTO vn (latest) - VALUES (?) - RETURNING id|, $id - )->{id}; - - _insert_vn_rev($s, $id, $vid, \%o); - - return ($vid, $id); # item id, global revision -} - - -sub DBEditVN { # id, %options->( comm + _insert_vn_rev + uid + causedby } - my($s, $vid, %o) = @_; - - my $c = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments, rev, causedby) - VALUES (?, ?, ?, ?, ( - SELECT c.rev+1 - FROM changes c - JOIN vn_rev vr ON vr.id = c.id - WHERE vr.vid = ? - ORDER BY c.id DESC - LIMIT 1 - ), ?) - RETURNING id, rev|, - 0, $o{uid}||$s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $vid, $o{causedby}||undef); - - _insert_vn_rev($s, $c->{id}, $vid, \%o); - - $s->DBExec(q|UPDATE vn SET latest = ? WHERE id = ?|, $c->{id}, $vid); - return ($c->{rev}, $c->{id}); # local revision, global revision -} - - -sub _insert_vn_rev { # columns in vn_rev + categories + screenshots + relations - my($s, $cid, $vid, $o) = @_; - - $$o{img_nsfw} = $$o{img_nsfw}?1:0; - $s->DBExec(q| - INSERT INTO vn_rev (id, vid, title, original, "desc", alias, image, img_nsfw, length, l_wp, l_encubed, l_renai, l_vnn) - VALUES (!l)|, - [ $cid, $vid, @$o{qw|title original desc alias image img_nsfw length l_wp l_encubed l_renai l_vnn|} ]); - - $s->DBExec(q| - INSERT INTO vn_categories (vid, cat, lvl) - VALUES (?, ?, ?)|, - $cid, $_->[0], $_->[1] - ) for (@{$o->{categories}}); - - $s->DBExec(q| - INSERT INTO vn_screenshots (vid, scr, nsfw, rid) - VALUES (?, ?, ?, ?)|, - $cid, $_->[0], $_->[1]?1:0, $_->[2] - ) for (@{$o->{screenshots}}); - - $s->DBExec(q| - INSERT INTO vn_relations (vid1, vid2, relation) - VALUES (?, ?, ?)|, - $cid, $_->[1], $_->[0] - ) for (@{$o->{relations}}); - - if(@{$o->{anime}}) { - $s->DBExec(q| - INSERT INTO vn_anime (vid, aid) - VALUES (?, ?)|, - $cid, $_ - ) for (@{$o->{anime}}); - - # insert unknown anime - my $a = $s->DBAll(q| - SELECT id FROM anime WHERE id IN(!l)|, - $o->{anime}); - $s->DBExec(q| - INSERT INTO anime (id) VALUES (?)|, $_ - ) for (grep { - my $ia = $_; - !(scalar grep $ia == $_->{id}, @$a) - } @{$o->{anime}}); - } -} - - -sub DBHideVN { # id, hidden - my($s, $id, $h) = @_; - $s->DBExec(q| - UPDATE vn - SET hidden = ? - WHERE id = ?|, - $h?1:0, $id); -} - - -sub DBVNCache { # @vids - my($s,@vn) = @_; - $s->DBExec('SELECT update_vncache(?)', $_) for (@vn); -} - - - - - -#-----------------------------------------------------------------------------# -# R E L E A S E S # -#-----------------------------------------------------------------------------# - - -sub DBGetRelease { # %options->{ id vid results page rev } - my($s, %o) = @_; - - $o{results} ||= 50; - $o{page} ||= 1; - $o{what} ||= ''; - $o{order} ||= 'rr.released ASC'; - my %where = ( - !$o{id} && !$o{rev} ? ( - 'r.hidden = ?' => 0 ) : (), - $o{id} ? ( - 'r.id = ?' => $o{id} ) : (), - $o{rev} ? ( - 'c.rev = ?' => $o{rev} ) : (), - $o{vid} ? ( - 'rv.vid = ?' => $o{vid} ) : (), - defined $o{unreleased} ? ( - q|rr.released !s TO_CHAR('today'::timestamp, 'YYYYMMDD')::integer| => $o{unreleased} ? '>' : '<=' ) : (), - ); - - my @join; - push @join, $o{rev} ? 'JOIN releases r ON r.id = rr.rid' : 'JOIN releases r ON rr.id = r.latest'; - push @join, 'JOIN changes c ON c.id = rr.id' if $o{what} =~ /changes/ || $o{rev}; - push @join, 'JOIN users u ON u.id = c.requester' if $o{what} =~ /changes/; - push @join, 'JOIN releases_vn rv ON rv.rid = rr.id' if $o{vid}; - - my $select = 'r.id, r.locked, r.hidden, rr.id AS cid, rr.title, rr.original, rr.gtin, rr.language, rr.website, rr.released, rr.notes, rr.minage, rr.type'; - $select .= ', c.added, c.requester, c.comments, r.latest, u.username, c.rev' if $o{what} =~ /changes/; - - my $r = $s->DBAll(qq| - SELECT $select - FROM releases_rev rr - @join - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - $_->{released} = sprintf '%08d', $_->{released} for @$r; - - if($#$r >= 0 && $o{what} =~ /(vn|producers|platforms|media)/) { - my %r = map { - $r->[$_]{producers} = []; - $r->[$_]{platforms} = []; - $r->[$_]{media} = []; - $r->[$_]{vn} = []; - ($r->[$_]{cid}, $_) - } 0..$#$r; - - if($o{what} =~ /vn/) { - push(@{$r->[$r{$_->{rid}}]{vn}}, $_) for (@{$s->DBAll(q| - SELECT rv.rid, vr.vid, vr.title, vr.original - FROM releases_vn rv - JOIN vn v ON v.id = rv.vid - JOIN vn_rev vr ON vr.id = v.latest - WHERE rv.rid IN(!l)|, - [ keys %r ] - )}); - } - - if($o{what} =~ /producers/) { - push(@{$r->[$r{$_->{rid}}]{producers}}, $_) for (@{$s->DBAll(q| - SELECT rp.rid, p.id, pr.name, pr.original, pr.type - FROM releases_producers rp - JOIN producers p ON rp.pid = p.id - JOIN producers_rev pr ON pr.id = p.latest - WHERE rp.rid IN(!l)|, - [ keys %r ] - )}); - } - if($o{what} =~ /platforms/) { - push(@{$r->[$r{$_->{rid}}]{platforms}}, $_->{platform}) for (@{$s->DBAll(q| - SELECT rid, platform - FROM releases_platforms - WHERE rid IN(!l)|, - [ keys %r ] - )}); - } - if($o{what} =~ /media/) { - ($_->{medium}=~s/\s+//||1)&&push(@{$r->[$r{$_->{rid}}]{media}}, $_) for (@{$s->DBAll(q| - SELECT rid, medium, qty - FROM releases_media - WHERE rid IN(!l)|, - [ keys %r ] - )}); - } - } - - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBAddRelease { # options -> { comm + _insert_release_rev } - my($s, %o) = @_; - - my $id = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments) - VALUES (!l) - RETURNING id|, - [ 1, $s->AuthInfo->{id}, $s->ReqIP, $o{comm} ] - )->{id}; - - my $rid = $s->DBRow(q| - INSERT INTO releases (latest) - VALUES (?) - RETURNING id|, $id)->{id}; - - _insert_release_rev($s, $id, $rid, \%o); - return ($rid, $id); # item id, global revision -} - - -sub DBEditRelease { # id, %opts->{ comm + _insert_release_rev } - my($s, $rid, %o) = @_; - - my $c = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments, rev) - VALUES (?, ?, ?, ?, ( - SELECT c.rev+1 - FROM changes c - JOIN releases_rev rr ON rr.id = c.id - WHERE rr.rid = ? - ORDER BY c.id DESC - LIMIT 1 - )) - RETURNING id, rev|, - 1, $s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $rid); - - _insert_release_rev($s, $c->{id}, $rid, \%o); - - $s->DBExec(q|UPDATE releases SET latest = ? WHERE id = ?|, $c->{id}, $rid); - return ($c->{rev}, $c->{id}); # local revision, global revision -} - - -sub _insert_release_rev { # %option->{ columns in releases_rev + producers + platforms + vn + media } - my($s, $cid, $rid, $o) = @_; - - $s->DBExec(q| - INSERT INTO releases_rev (id, rid, title, original, gtin, language, website, released, notes, minage, type) - VALUES (!l)|, - [ $cid, $rid, @$o{qw| title original gtin language website released notes minage type|} ]); - - $s->DBExec(q| - INSERT INTO releases_producers (rid, pid) - VALUES (?, ?)|, - $cid, $_ - ) for (@{$o->{producers}}); - - $s->DBExec(q| - INSERT INTO releases_platforms (rid, platform) - VALUES (?, ?)|, - $cid, $_ - ) for (@{$o->{platforms}}); - - $s->DBExec(q| - INSERT INTO releases_vn (rid, vid) - VALUES (?, ?)|, - $cid, $_ - ) for (@{$o->{vn}}); - - $s->DBExec(q| - INSERT INTO releases_media (rid, medium, qty) - VALUES (?, ?, ?)|, - $cid, $_->[0], $_->[1] - ) for (@{$o->{media}}); -} - - -sub DBHideRelease { # id, hidden - my($s, $id, $h) = @_; - $s->DBExec(q| - UPDATE releases - SET hidden = ? - WHERE id = ?|, - $h?1:0, $id); -} - - - -#-----------------------------------------------------------------------------# -# P R O D U C E R S # -#-----------------------------------------------------------------------------# - - -sub DBGetProducer { # %options->{ id search char results page rev } - my($s, %o) = @_; - - $o{results} ||= 50; - $o{page} ||= 1; - $o{search} =~ s/%//g if $o{search}; - $o{what} ||= ''; - my %where = ( - !$o{id} && !$o{rev} ? ( - 'p.hidden = ?' => 0 ) : (), - $o{id} ? ( - 'p.id = ?' => $o{id} ) : (), - $o{search} ? ( - '(pr.name ILIKE ? OR pr.original ILIKE ?)', [ '%%'.$o{search}.'%%', '%%'.$o{search}.'%%' ] ) : (), - $o{char} ? ( - 'LOWER(SUBSTR(pr.name, 1, 1)) = ?' => $o{char} ) : (), - defined $o{char} && !$o{char} ? ( - '(ASCII(pr.name) < 97 OR ASCII(pr.name) > 122) AND (ASCII(pr.name) < 65 OR ASCII(pr.name) > 90)' => 1 ) : (), - $o{rev} ? ( - 'c.rev = ?' => $o{rev} ) : (), - ); - - my @join; - push @join, $o{rev} ? 'JOIN producers p ON p.id = pr.pid' : 'JOIN producers p ON pr.id = p.latest'; - push @join, 'JOIN changes c ON c.id = pr.id' if $o{what} =~ /changes/ || $o{rev}; - push @join, 'JOIN users u ON u.id = c.requester' if $o{what} =~ /changes/; - - my $select = 'p.id, p.locked, p.hidden, pr.type, pr.name, pr.original, pr.website, pr.lang, pr.desc'; - $select .= ', c.added, c.requester, c.comments, p.latest, pr.id AS cid, u.username, c.rev' if $o{what} =~ /changes/; - - my $r = $s->DBAll(qq| - SELECT $select - FROM producers_rev pr - @join - !W - ORDER BY pr.name ASC - LIMIT ? OFFSET ?|, - \%where, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBGetProducerVN { # pid - return $_[0]->DBAll(q| - SELECT v.id, MAX(vr.title) AS title, MAX(vr.original) AS original, MIN(rr.released) AS date - FROM releases_producers vp - JOIN releases_rev rr ON rr.id = vp.rid - JOIN releases r ON r.latest = rr.id - JOIN releases_vn rv ON rv.rid = rr.id - JOIN vn v ON v.id = rv.vid - JOIN vn_rev vr ON vr.id = v.latest - WHERE vp.pid = ? - AND v.hidden = ? - GROUP BY v.id - ORDER BY date|, - $_[1], 0); -} - - -sub DBAddProducer { # %opts->{ comm + _insert_producer_rev } - my($s, %o) = @_; - - my $id = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments) - VALUES (!l) - RETURNING id|, - [ 2, $s->AuthInfo->{id}, $s->ReqIP, $o{comm} ] - )->{id}; - - my $pid = $s->DBRow(q| - INSERT INTO producers (latest) - VALUES (?) - RETURNING id|, $id - )->{id}; - - _insert_producer_rev($s, $id, $pid, \%o); - - return ($pid, $id); # item id, global revision -} - - -sub DBEditProducer { # id, %opts->{ comm + _insert_producer_rev } - my($s, $pid, %o) = @_; - - my $c = $s->DBRow(q| - INSERT INTO changes (type, requester, ip, comments, rev) - VALUES (?, ?, ?, ?, ( - SELECT c.rev+1 - FROM changes c - JOIN producers_rev pr ON pr.id = c.id - WHERE pr.pid = ? - ORDER BY c.id DESC - LIMIT 1 - )) - RETURNING id, rev|, - 2, $s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $pid); - - _insert_producer_rev($s, $c->{id}, $pid, \%o); - - $s->DBExec(q|UPDATE producers SET latest = ? WHERE id = ?|, $c->{id}, $pid); - return ($c->{rev}, $c->{id}); # local revision, global revision -} - - -sub _insert_producer_rev { # %opts->{ columns in produces_rev } - my($s, $cid, $pid, $o) = @_; - $s->DBExec(q| - INSERT INTO producers_rev (id, pid, name, original, website, type, lang, "desc") - VALUES (!l)|, - [ $cid, $pid, @$o{qw| name original website type lang desc|} ]); -} - - -sub DBHideProducer { # id, hidden - my($s, $id, $h) = @_; - $s->DBExec(q| - UPDATE producers - SET hidden = ? - WHERE id = ?|, - $h?1:0, $id); -} - - - - - -#-----------------------------------------------------------------------------# -# D I S C U S S I O N S # -#-----------------------------------------------------------------------------# - - -sub DBGetThreads { # %options->{ id type iid results page what } - my($s, %o) = @_; - - $o{results} ||= 50; - $o{page} ||= 1; - $o{what} ||= ''; - $o{order} ||= 't.id DESC'; - - my %where = ( - $o{id} ? ( - 't.id = ?' => $o{id} ) : (), - !$o{id} ? ( - 't.hidden = ?' => 0 ) : (), - $o{type} && !$o{iid} ? ( - 't.id IN(SELECT tid FROM threads_tags WHERE type = ?)' => $o{type} ) : (), - $o{type} && $o{iid} ? ( - 'tt.type = ?' => $o{type}, 'tt.iid = ?' => $o{iid} ) : (), - ); - - my $select = 't.id, t.title, t.count, t.locked, t.hidden'; - $select .= ', tp.uid, tp.date, u.username' if $o{what} =~ /firstpost/; - $select .= ', tp2.uid AS luid, tp2.date AS ldate, u2.username AS lusername' if $o{what} =~ /lastpost/; - - my @join; - push @join, 'JOIN threads_posts tp ON tp.tid = t.id AND tp.num = 1' if $o{what} =~ /firstpost/; - push @join, 'JOIN users u ON u.id = tp.uid' if $o{what} =~ /firstpost/; - push @join, 'JOIN threads_posts tp2 ON tp2.tid = t.id AND tp2.num = t.count' if $o{what} =~ /lastpost/; - push @join, 'JOIN users u2 ON u2.id = tp2.uid' if $o{what} =~ /lastpost/; - push @join, 'JOIN threads_tags tt ON tt.tid = t.id' if $o{type} && $o{iid}; - - my $r = $s->DBAll(qq| - SELECT $select - FROM threads t - @join - !W - ORDER BY !s - LIMIT ? OFFSET ?|, - \%where, - $o{order}, - $o{results}+(wantarray?1:0), $o{results}*($o{page}-1) - ); - - if($o{what} =~ /(tags|tagtitles)/ && $#$r >= 0) { - my %r = map { - $r->[$_]{tags} = []; - ($r->[$_]{id}, $_) - } 0..$#$r; - - if($o{what} =~ /tags/) { - ($_->{type}=~s/ +//||1) && push(@{$r->[$r{$_->{tid}}]{tags}}, [ $_->{type}, $_->{iid} ]) for (@{$s->DBAll(q| - SELECT tid, type, iid - FROM threads_tags - WHERE tid IN(!l)|, - [ keys %r ] - )}); - } - if($o{what} =~ /tagtitles/) { - ($_->{type}=~s/ +//||1) && push(@{$r->[$r{$_->{tid}}]{tags}}, [ $_->{type}, $_->{iid}, $_->{title}, $_->{original} ]) for (@{$s->DBAll(q| - SELECT tt.tid, tt.type, tt.iid, COALESCE(u.username, vr.title, pr.name) AS title, COALESCE(u.username, vr.original, pr.original) AS original - FROM threads_tags tt - LEFT JOIN vn v ON tt.type = 'v' AND v.id = tt.iid - LEFT JOIN vn_rev vr ON vr.id = v.latest - LEFT JOIN producers p ON tt.type = 'p' AND p.id = tt.iid - LEFT JOIN producers_rev pr ON pr.id = p.latest - LEFT JOIN users u ON tt.type = 'u' AND u.id = tt.iid - WHERE tt.tid IN(!l)|, - [ keys %r ] - )}); - } - } - - return $r if !wantarray; - return ($r, 0) if $#$r < $o{results}; - pop @$r; - return ($r, 1); -} - - -sub DBGetPosts { # %options->{ tid num page results } - my($s, %o) = @_; - - $o{results} ||= 50; - $o{page} ||= 1; - - my %where = ( - 'tp.tid = ?' => $o{tid}, - $o{num} ? ( - 'tp.num = ?' => $o{num} ) : (), - ); - - my $r = $s->DBAll(q| - SELECT tp.num, tp.date, tp.edited, tp.msg, tp.hidden, tp.uid, u.username - FROM threads_posts tp - JOIN users u ON u.id = tp.uid - !W - ORDER BY tp.num ASC - LIMIT ? OFFSET ?|, - \%where, - $o{results}, $o{results}*($o{page}-1) - ); - - return $r if !wantarray; -} - - -sub DBAddPost { # %options->{ tid uid msg num } - my($s, %o) = @_; - - $o{num} ||= $s->DBRow('SELECT num FROM threads_posts WHERE tid = ? ORDER BY num DESC LIMIT 1', $o{tid})->{num}+1; - $o{uid} ||= $s->AuthInfo->{id}; - - $s->DBExec(q| - INSERT INTO threads_posts (tid, num, uid, msg) - VALUES(?, ?, ?, ?)|, - @o{qw| tid num uid msg |} - ); - $s->DBExec(q| - UPDATE threads - SET count = count+1 - WHERE id = ?|, - $o{tid}); - - return $o{num}; -} - - -sub DBEditPost { # %options->{ tid num msg hidden } - my($s, %o) = @_; - - my %set = ( - 'msg = ?' => $o{msg}, - 'edited = ?' => time, - 'hidden = ?' => $o{hidden}?1:0, - ); - - $s->DBExec(q| - UPDATE threads_posts - !H - WHERE tid = ? - AND num = ?|, - \%set, $o{tid}, $o{num} - ); -} - - -sub DBEditThread { # %options->{ id title locked hidden tags } - my($s, %o) = @_; - - my %set = ( - 'title = ?' => $o{title}, - 'locked = ?' => $o{locked}?1:0, - 'hidden = ?' => $o{hidden}?1:0, - ); - - $s->DBExec(q| - UPDATE threads - !H - WHERE id = ?|, - \%set, $o{id}); - - if($o{tags}) { - $s->DBExec('DELETE FROM threads_tags WHERE tid = ?', $o{id}); - $s->DBExec(q| - INSERT INTO threads_tags (tid, type, iid) - VALUES (?, ?, ?)|, - $o{id}, $_->[0], $_->[1]||0 - ) for (@{$o{tags}}); - } -} - - -sub DBAddThread { # %options->{ title hidden locked tags } - my($s, %o) = @_; - - my $id = $s->DBRow(q| - INSERT INTO threads (title, hidden, locked) - VALUES (?, ?, ?) - RETURNING id|, - $o{title}, $o{hidden}?1:0, $o{locked}?1:0 - )->{id}; - - $s->DBExec(q| - INSERT INTO threads_tags (tid, type, iid) - VALUES (?, ?, ?)|, - $id, $_->[0], $_->[1] - ) for (@{$o{tags}}); - - return $id; -} - - - - - -#-----------------------------------------------------------------------------# -# U T I L I T I E S # -#-----------------------------------------------------------------------------# - - -sub DBExec { return sqlhelper(shift, 0, @_); } -sub DBRow { return sqlhelper(shift, 1, @_); } -sub DBAll { return sqlhelper(shift, 2, @_); } - -sub sqlhelper { # type, query, @list - my $self = shift; - my $type = shift; - my $sqlq = shift; - my $s = $self->{_DB}->{sql}; - - my $start = [Time::HiRes::gettimeofday()] if $self->{debug}; - - $sqlq =~ s/\r?\n/ /g; - $sqlq =~ s/ +/ /g; - my(@q) = @_ ? sqlprint(0, $sqlq, @_) : ($sqlq); - #warn join(', ', map "'$_'", @q)."\n"; - - my $q = $s->prepare($q[0]); - $q->execute($#q ? @q[1..$#q] : ()); - my $r = $type == 1 ? $q->fetchrow_hashref : - $type == 2 ? $q->fetchall_arrayref({}) : - $q->rows; - $q->finish(); - - push(@{$self->{_DB}->{Queries}}, [ $q[0], Time::HiRes::tv_interval($start), @q[1..$#q] ]) if $self->{debug}; - - $r = 0 if $type == 0 && !$r; - $r = {} if $type == 1 && (!$r || ref($r) ne 'HASH'); - $r = [] if $type == 2 && (!$r || ref($r) ne 'ARRAY'); - - return $r; -} - - -# sqlprint: -# ? normal placeholder -# !l list of placeholders, expects arrayref -# !H list of SET-items, expects hashref or arrayref: format => (bind_value || \@bind_values) -# !W same as !H, but for WHERE clauses (AND'ed together) -# !s the classic sprintf %s, use with care -# This isn't sprintf, so all other things won't work, -# Only the ? placeholder is supported, so no dollar sign numbers or named placeholders -# Indeed, this also means you can't use PgSQL operators containing a question mark - -sub sqlprint { # start, query, bind values. Returns new query + bind values - my @a; - my $q=''; - my $s = shift; - for my $p (split /(\?|![lHWs])/, shift) { - next if !defined $p; - if($p eq '?') { - push @a, shift; - $q .= '$'.(@a+$s); - } elsif($p eq '!s') { - $q .= shift; - } elsif($p eq '!l') { - my $l = shift; - $q .= join ', ', map '$'.(@a+$s+$_+1), 0..$#$l; - push @a, @$l; - } elsif($p eq '!H' || $p eq '!W') { - my $h=shift; - my @h=ref $h eq 'HASH' ? %$h : @$h; - my @r; - while(my($k,$v) = (shift(@h), shift(@h))) { - last if !defined $k; - my($n,@l) = sqlprint($#a+1, $k, ref $v eq 'ARRAY' ? @$v : $v); - push @r, $n; - push @a, @l; - } - $q .= ($p eq '!W' ? 'WHERE ' : 'SET ').join $p eq '!W' ? ' AND ' : ', ', @r - if @r; - } else { - $q .= $p; - } - } - return($q, @a); -} - -1; - |