summaryrefslogtreecommitdiff
path: root/lib/VNDB/Util/DB.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNDB/Util/DB.pm')
-rw-r--r--lib/VNDB/Util/DB.pm1268
1 files changed, 1268 insertions, 0 deletions
diff --git a/lib/VNDB/Util/DB.pm b/lib/VNDB/Util/DB.pm
new file mode 100644
index 00000000..59088387
--- /dev/null
+++ b/lib/VNDB/Util/DB.pm
@@ -0,0 +1,1268 @@
+
+package VNDB::Util::DB;
+
+use strict;
+use warnings;
+use DBI;
+use Exporter 'import';
+use Storable 'nfreeze', 'thaw';
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+
+@EXPORT = qw|
+ DBInit DBCheck DBCommit DBRollBack DBExit
+ DBLanguageCount DBCategoryCount DBTableCount DBGetHist DBLockItem DBIncId
+ DBGetUser DBAddUser DBUpdateUser
+ DBGetVotes DBVoteStats DBAddVote DBDelVote
+ DBGetVNList DBVNListStats DBAddVNList DBEditVNList DBDelVNList
+ DBGetVN DBAddVN DBEditVN DBDelVN DBHideVN
+ DBGetRelease DBAddRelease DBEditRelease DBDelRelease DBHideRelease
+ DBGetProducer DBGetProducerVN DBAddProducer DBEditProducer DBDelProducer DBHideProducer
+ DBExec DBRow DBAll DBLastId
+|;
+
+
+
+
+
+#-----------------------------------------------------------------------------#
+# 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 { @_ }, $type;
+
+ $me->DBInit();
+
+ return $me;
+}
+
+
+sub DBInit {
+ my $self = shift;
+ my $info = $self->{_DB} || $self;
+
+ my $settings;
+ $settings .= "host=$info->{host};" if $info->{host};
+ $settings .= "port=$info->{port};" if $info->{port};
+ $settings .= "dbname=$info->{database}";
+
+ $info->{sql} = DBI->connect("dbi:Pg:$settings",
+ $info->{user}, $info->{passwd}, {
+ 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
+ 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 rv.vid) AS count
+ FROM releases_rev rr
+ JOIN releases r ON r.latest = rr.id
+ JOIN releases_vn rv ON rv.rid = rr.id
+ GROUP BY rr.language|)} };
+}
+
+
+sub DBTableCount { # table (users, producers, vn, releases, votes)
+ return $_[0]->DBRow(q|
+ SELECT COUNT(*) as cnt
+ FROM %s
+ %s|,
+ $_[1],
+ $_[1] =~ /producers|vn|releases/ ? 'WHERE hidden = 0' : '',
+ )->{cnt};
+}
+
+
+
+# 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 = %d' => $o{id} ) : (),
+
+ $o{type} eq 'v' && !$o{releases} ? ( 'c.type = 0' => 1,
+ $o{id} ? ( 'vr.vid = %d' => $o{id} ) : () ) : (),
+ $o{type} eq 'v' && $o{releases} ? (
+ '((c.type = 0 AND vr.vid = %d) OR (c.type = 1 AND rv.vid = %1$d))' => $o{id} ) : (),
+
+ $o{type} eq 'r' ? ( 'c.type = 1' => 1,
+ $o{id} ? ( 'rr.rid = %d' => $o{id} ) : () ) : (),
+ $o{type} eq 'p' ? ( 'c.type = 2' => 1,
+ $o{id} ? ( 'pr.pid = %d' => $o{id} ) : () ) : (),
+
+ $o{next} ? (
+ 'c.id > %d' => $o{next} ) : (),
+ $o{caused} ? (
+ 'c.causedby = %d' => $o{caused} ) : (),
+ $o{ip} ? (
+ 'c.ip = !s' => $o{ip} ) : (),
+ defined $o{edits} && !$o{edits} ? (
+ 'c.prev = 0' => 1 ) : (),
+ $o{edits} ? (
+ 'c.prev > 0' => 1 ) : (),
+
+ # get rid of 'hidden' items
+ !$o{showhid} ? (
+ '(v.hidden IS NOT NULL AND v.hidden = 0 OR r.hidden IS NOT NULL AND r.hidden = 0 OR p.hidden IS NOT NULL AND p.hidden = 0)' => 1,
+ ) : $o{showhid} == 2 ? (
+ '(v.hidden IS NOT NULL AND v.hidden = 1 OR r.hidden IS NOT NULL AND r.hidden = 1 OR p.hidden IS NOT NULL AND p.hidden = 1)' => 1,
+ ) : (),
+ );
+
+ my $where = keys %where ? 'WHERE !W' : '';
+
+ my $select = 'c.id, c.type, c.added, c.requester, c.comments, c.prev, 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' 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
+ $where
+ ORDER BY c.id %s
+ LIMIT %d OFFSET %d|,
+ $where ? \%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 = %d
+ WHERE id = %d|,
+ $tbl, $l, $id);
+}
+
+
+sub DBHideItem { # table, id, hidden
+ my($s, $tbl, $id, $h) = @_;
+ $s->DBExec(q|
+ UPDATE %s
+ SET hidden = %d
+ WHERE id = %d|,
+ $tbl, $h, $id);
+}
+
+
+sub DBIncId { # sequence (this is a rather low-level function... aww heck...)
+ return $_[0]->DBRow(q|SELECT nextval(!s) AS ni|, $_[1])->{ni};
+}
+
+
+
+#-----------------------------------------------------------------------------#
+# 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 = (
+ $o{username} ? (
+ 'username = !s' => $o{username} ) : (),
+ $o{mail} ? (
+ 'mail = !s' => $o{mail} ) : (),
+ $o{passwd} ? (
+ 'passwd = decode(!s, \'hex\')' => $o{passwd} ) : (),
+ $o{firstchar} ? (
+ 'SUBSTRING(username from 1 for 1) = !s' => $o{firstchar} ) : (),
+ !$o{firstchar} && defined $o{firstchar} ? (
+ 'ASCII(username) < 97 OR ASCII(username) > 122' => 1 ) : (),
+ $o{uid} ? (
+ 'id = %d' => $o{uid} ) : (),
+ );
+
+ my $where = keys %where ? 'AND !W' : '';
+ my $r = $s->DBAll(qq|
+ SELECT *
+ FROM users u
+ WHERE id > 0 $where
+ ORDER BY %s
+ LIMIT %d OFFSET %d|,
+ $where ? \%where : (),
+ $o{order},
+ $o{results}+(wantarray?1:0), $o{results}*($o{page}-1)
+ );
+
+ if($o{what} =~ /list/ && $#$r >= 0) {
+ my %r = map {
+ $r->[$_]{votes} = 0;
+ $r->[$_]{vnlist} = 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{$_->{uid}}]{vnlist} = $_->{cnt} for (@{$s->DBAll(q|
+ SELECT uid, COUNT(vid) AS cnt
+ FROM vnlists
+ 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 (!s, decode(!s, 'hex'), !s, %d, %d)|,
+ 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{$_.' = !s'} = $opt{$_})
+ for (qw| username mail |);
+ defined $opt{$_} && ($h{$_.' = %d'} = $opt{$_})
+ for (qw| rank flags |);
+ $h{'passwd = decode(!s, \'hex\')'} = $opt{passwd}
+ if defined $opt{passwd};
+
+ return 0 if scalar keys %h <= 0;
+ return $s->DBExec(q|
+ UPDATE users
+ SET !H
+ WHERE id = %d|,
+ \%h, $user);
+}
+
+
+
+
+
+
+#-----------------------------------------------------------------------------#
+# V O T E S #
+#-----------------------------------------------------------------------------#
+
+
+sub DBGetVotes { # %options->{ uid vid order results page }
+ my($s, %o) = @_;
+ $o{order} ||= 'n.date DESC';
+ $o{results} ||= 50;
+ $o{page} ||= 1;
+
+ my %where = (
+ $o{uid} ? ( 'n.uid = %d' => $o{uid} ) : (),
+ $o{vid} ? ( 'n.vid = %d' => $o{vid} ) : (),
+ );
+
+ my $where = scalar keys %where ? 'WHERE !W' : '';
+ my $r = $s->DBAll(qq|
+ SELECT n.vid, vr.title, 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
+ $where
+ ORDER BY %s
+ LIMIT %d OFFSET %d|,
+ $where ? \%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 | ],
+ my $where = $col ? 'WHERE '.$col.' = '.$id : '';
+ $r->[$_->{vote}-1] = $_->{votes} for (@{$s->DBAll(qq|
+ SELECT vote, COUNT(vote) as votes
+ FROM votes
+ $where
+ GROUP BY vote|,
+ )});
+ return $r;
+}
+
+
+sub DBAddVote { # vid, uid, vote
+ $_[0]->DBExec(q|
+ UPDATE votes
+ SET vote = %d
+ WHERE vid = %d
+ AND uid = %d|,
+ $_[3], $_[1], $_[2]
+ ) || $_[0]->DBExec(q|
+ INSERT INTO votes
+ (vid, uid, vote, date)
+ VALUES (%d, %d, %d, %d)|,
+ $_[1], $_[2], $_[3], time
+ );
+ # XXX: performance improvement: let a cron job handle this
+ $_[0]->DBExec('SELECT calculate_rating()');
+}
+
+
+sub DBDelVote { # uid, vid # uid = 0 to delete all
+ my $uid = $_[1] ? 'uid = '.$_[1].' AND' : '';
+ $_[0]->DBExec(q|
+ DELETE FROM votes
+ WHERE %s vid = %d|,
+ $uid, $_[2]);
+ $_[0]->DBExec('SELECT calculate_rating()');
+}
+
+
+
+
+
+#-----------------------------------------------------------------------------#
+# 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 order results page status }
+ my($s, %o) = @_;
+ $o{results} ||= 10;
+ $o{page} ||= 1;
+ $o{order} ||= 'l.date DESC';
+
+ my %where = (
+ $o{uid} ? (
+ 'l.uid = %d' => $o{uid} ) : (),
+ $o{vid} ? (
+ 'l.vid = %d' => $o{vid} ) : (),
+ defined $o{status} ? (
+ 'l.status = %d' => $o{status} ) : (),
+ );
+
+ 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
+ WHERE !W
+ ORDER BY %s
+ LIMIT %d OFFSET %d|,
+ \%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 DBVNListStats { # uid|vid => id
+ my($s, $col, $id) = @_;
+ my $r = [ map 0, 0..$#$VNDB::LSTAT ],
+ my $where = $col ? 'WHERE '.$col.' = '.$id : '';
+ $r->[$_->{status}] = $_->{cnt} for (@{$s->DBAll(qq|
+ SELECT status, COUNT(uid) as cnt
+ FROM vnlists
+ $where
+ GROUP BY status|
+ )});
+ return $r;
+}
+
+
+sub DBAddVNList { # uid, vid, status, [comments]
+ $_[0]->DBExec(q|
+ INSERT INTO vnlists (uid, vid, status, date, comments)
+ VALUES (!l, !s)|,
+ [ @_[1..3], time ], $_[4]||'');
+}
+
+
+sub DBEditVNList { # %options->{ uid status comments vid }
+ my($s, %o) = @_;
+ my %set;
+ $set{'status = %d'} = $o{status} if defined $o{status};
+ $set{'comments = !s'} = $o{comments} if defined $o{comments};
+ return if !keys %set;
+ $s->DBExec(q|
+ UPDATE vnlists
+ SET !H
+ WHERE uid = %d
+ AND vid IN(!l)|,
+ \%set, $o{uid}, $o{vid}
+ );
+}
+
+
+sub DBDelVNList { # uid, @vid # uid = 0 to delete all
+ my($s, $uid, @vid) = @_;
+ $uid = $uid ? 'uid = '.$uid.' AND ' : '';
+ $s->DBExec(q|
+ DELETE FROM vnlists
+ WHERE %s vid IN(!l)|,
+ $uid, \@vid
+ );
+}
+
+
+
+
+
+#-----------------------------------------------------------------------------#
+# 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 }
+ 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' => 1 ) : (),
+ $o{id} ? (
+ 'v.id = %d' => $o{id} ) : (),
+ $o{rev} ? (
+ 'vr.id = %d' => $o{rev} ) : (),
+ $o{char} ? (
+ 'LOWER(SUBSTR(vr.title, 1, 1)) = !s' => $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}}+1).')' => $o{cati} ) : (),
+ $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} ) : (),
+ $o{lang} && @{$o{lang}} ? ( q|
+ v.id IN(SELECT irv.vid
+ FROM releases_rev irr
+ JOIN releases ir ON irr.id = ir.latest
+ JOIN releases_vn irv ON irv.rid = irr.id
+ WHERE irr.language IN(!L)
+ AND irr.type <> 2
+ AND irr.released <= TO_CHAR('today'::timestamp, 'YYYYMMDD')::integer)| => $o{lang} ) : (),
+ );
+
+ if($o{search}) {
+ my %w;
+ for (split /[ -,]/, $o{search}) {
+ s/%//g;
+ next if length($_) < 2;
+ $w{ sprintf '(ivr.title ILIKE %s OR ivr.alias ILIKE %1$s OR irr.title ILIKE %1$s OR irr.original ILIKE %1$s)',
+ qs('%%'.$_.'%%') } = 1;
+ }
+ $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
+ WHERE !W
+ GROUP BY iv.id)| } = \%w if keys %w;
+ }
+
+ my $where = scalar keys %where ? 'WHERE !W' : '';
+
+ my @join = (
+ $o{rev} ?
+ 'JOIN vn v ON v.id = vr.vid' :
+ 'JOIN vn v ON vr.id = v.latest',
+ $o{what} =~ /changes/ ? (
+ 'JOIN changes c ON c.id = vr.id',
+ 'JOIN users u ON u.id = c.requester' ) : (),
+ );
+
+ my $sel = 'v.id, v.locked, v.hidden, v.c_released, v.c_languages, v.c_votes, vr.title, vr.id AS cid, v.rgraph';
+ $sel .= ', vr.alias, vr.image AS image, vr.img_nsfw, vr.length, vr.desc, vr.l_wp, vr.l_cisv, vr.l_vnn' if $o{what} =~ /extended/;
+ $sel .= ', c.added, c.requester, c.comments, v.latest, u.username, c.prev, c.causedby' if $o{what} =~ /changes/;
+
+ my $r = $s->DBAll(qq|
+ SELECT $sel
+ FROM vn_rev vr
+ @join
+ $where
+ ORDER BY %s
+ LIMIT %d OFFSET %d|,
+ $where ? \%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)/ && $#$r >= 0) {
+ my %r = map {
+ $r->[$_]{relations} = [];
+ $r->[$_]{categories} = [];
+ ($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} =~ /relations/) {
+ my $rel = $s->DBAll(q|
+ SELECT rel.vid1, rel.vid2, rel.relation, vr.title
+ 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}
+ }) for (@$rel);
+ }
+ }
+
+ return $r if !wantarray;
+ return ($r, 0) if $#$r != $o{results};
+ pop @$r;
+ return ($r, 1);
+}
+
+
+sub DBAddVN { # %options->{ columns in vn_rev + comm + relations }
+ my($s, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments)
+ VALUES (%d, %d, !s, !s)|,
+ 0, $s->AuthInfo->{id}, $s->ReqIP, $o{comm});
+
+ my $id = $s->DBLastId('changes');
+
+ $s->DBExec(q|
+ INSERT INTO vn (latest)
+ VALUES (%d)|, $id);
+ my $vid = $s->DBLastId('vn');
+
+ _insert_vn_rev($s, $id, $vid, \%o);
+
+ return ($vid, $id);
+}
+
+
+sub DBEditVN { # id, %options->( columns in vn_rev + comm + relations + categories + uid + causedby }
+ my($s, $vid, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments, prev, causedby)
+ VALUES (%d, %d, !s, !s, (
+ SELECT c.id
+ FROM changes c
+ JOIN vn_rev vr ON vr.id = c.id
+ WHERE vr.vid = %d
+ ORDER BY c.id DESC
+ LIMIT 1
+ ), %d)|,
+ 0, $o{uid}||$s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $vid, $o{causedby}||0);
+
+ my $id = $s->DBLastId('changes');
+
+ _insert_vn_rev($s, $id, $vid, \%o);
+
+ $s->DBExec(q|UPDATE vn SET latest = %d WHERE id = %d|, $id, $vid);
+ return $id;
+}
+
+
+sub _insert_vn_rev {
+ my($s, $cid, $vid, $o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO vn_rev (id, vid, title, "desc", alias, image, img_nsfw, length, l_wp, l_cisv, l_vnn)
+ VALUES (%d, %d, !s, !s, !s, %d, %d, %d, !s, %d, %d)|,
+ $cid, $vid, @$o{qw|title desc alias image img_nsfw length l_wp l_cisv l_vnn|});
+
+ $s->DBExec(q|
+ INSERT INTO vn_categories (vid, cat, lvl)
+ VALUES (%d, !s, %d)|,
+ $cid, $_->[0], $_->[1]
+ ) for (@{$o->{categories}});
+
+ $s->DBExec(q|
+ INSERT INTO vn_relations (vid1, vid2, relation)
+ VALUES (%d, %d, %d)|,
+ $cid, $_->[1], $_->[0]
+ ) for (@{$o->{relations}});
+}
+
+
+sub DBDelVN { # id
+ my($s, $vid) = @_;
+
+ # delete or update relations
+ my $rels = $s->DBAll(q|
+ SELECT r.id, COUNT(rv2.vid) AS vids
+ FROM releases r
+ JOIN releases_vn rv ON rv.rid = r.latest
+ JOIN releases_vn rv2 ON rv2.rid = r.latest
+ WHERE rv.vid = %d
+ GROUP BY r.id|,
+ $vid
+ );
+ # delete if no other VN's were found
+ $s->DBDelRelease(0, map { $_->{vids} == 1 ? $_->{id} : () } @$rels);
+ # remove relation otherwise
+ $s->DBExec(q|
+ DELETE FROM releases_vn
+ WHERE vid = %d|,
+ $vid);
+
+ $s->DBExec($_, $vid) for(
+ q|DELETE FROM changes c WHERE c.id IN(SELECT v.id FROM vn_rev v WHERE v.vid = %d)|,
+ q|DELETE FROM vn WHERE id = %d|,
+ q|DELETE FROM vn_categories WHERE vid IN(SELECT v.id FROM vn_rev v WHERE v.vid = %d)|,
+ q|DELETE FROM vn_relations WHERE vid1 IN(SELECT v.id FROM vn_rev v WHERE v.vid = %d)|,
+ q|DELETE FROM vn_rev WHERE vid = %d|,
+ q|DELETE FROM vn_relations WHERE vid2 = %d|,
+ q|DELETE FROM votes WHERE vid = %d|,
+ q|DELETE FROM vnlists WHERE vid = %d|,
+ );
+}
+
+
+sub DBHideVN { # id, hidden
+ my($s, $id, $h) = @_;
+ $s->DBExec(q|
+ UPDATE vn
+ SET hidden = %d
+ WHERE id = %d|,
+ $h, $id);
+
+# $s->DBExec(q|
+# DELETE FROM vn_relations
+# WHERE vid2 = %d
+# OR vid1 IN(SELECT id FROM vn_rev WHERE vid = %d)|,
+# $id, $id);
+# $s->DBDelVNList(0, $id);
+# $s->DBDelVote(0, $id);
+}
+
+
+
+
+#-----------------------------------------------------------------------------#
+# 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} ||= '';
+ my %where = (
+ !$o{id} && !$o{rev} ? (
+ 'r.hidden = 0' => 1 ) : (),
+ $o{id} ? (
+ 'r.id = %d' => $o{id} ) : (),
+ $o{rev} ? (
+ 'rr.id = %d' => $o{rev} ) : (),
+ $o{vid} ? (
+ 'rv.vid = %d' => $o{vid} ) : (),
+ );
+
+ my $where = scalar keys %where ? 'WHERE !W' : '';
+ 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/;
+ 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.language, rr.website, rr.released, rr.notes, rr.minage, rr.type';
+ $select .= ', c.added, c.requester, c.comments, r.latest, u.username, c.prev' if $o{what} =~ /changes/;
+
+ my $r = $s->DBAll(qq|
+ SELECT $select
+ FROM releases_rev rr
+ @join
+ $where
+ ORDER BY rr.released ASC
+ LIMIT %d OFFSET %d|,
+ $where ? \%where : (),
+ $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
+ 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.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/) {
+ ($_->{platform}=~s/\s+//||1)&&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 -> { columns in releases_rev table + comm + vn + producers + media + platforms }
+ my($s, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments)
+ VALUES (%d, %d, !s, !s)|,
+ 1, $s->AuthInfo->{id}, $s->ReqIP, $o{comm});
+
+ my $id = $s->DBLastId('changes');
+ $s->DBExec(q|
+ INSERT INTO releases (latest)
+ VALUES (%d)|, $id);
+ my $rid = $s->DBLastId('releases');
+
+ _insert_release_rev($s, $id, $rid, \%o);
+
+ $s->DBExec('SELECT update_vncache(%d)', $_) for (@{$o{vn}});
+ return ($rid, $id);
+}
+
+
+sub DBEditRelease { # id, %opts->{ columns in releases_rev table + comm + vn + producers + media + platforms }
+ my($s, $rid, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments, prev)
+ VALUES (%d, %d, !s, !s, (
+ SELECT c.id
+ FROM changes c
+ JOIN releases_rev rr ON rr.id = c.id
+ WHERE rr.rid = %d
+ ORDER BY c.id DESC
+ LIMIT 1
+ ))|,
+ 1, $s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $rid);
+
+ my $id = $s->DBLastId('changes');
+
+ _insert_release_rev($s, $id, $rid, \%o);
+
+ $s->DBExec(q|UPDATE releases SET latest = %d WHERE id = %d|, $id, $rid);
+
+ $s->DBExec('SELECT update_vncache(%d)', $_) for (@{$o{vn}});
+ return $id;
+}
+
+
+sub _insert_release_rev {
+ my($s, $cid, $rid, $o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO releases_rev (id, rid, title, original, language, website, released, notes, minage, type)
+ VALUES (%d, %d, !s, !s, !s, !s, %d, !s, %d, %d)|,
+ $cid, $rid, @$o{qw| title original language website released notes minage type|});
+
+ $s->DBExec(q|
+ INSERT INTO releases_producers (rid, pid)
+ VALUES (%d, %d)|,
+ $cid, $_
+ ) for (@{$o->{producers}});
+
+ $s->DBExec(q|
+ INSERT INTO releases_platforms (rid, platform)
+ VALUES (%d, !s)|,
+ $cid, $_
+ ) for (@{$o->{platforms}});
+
+ $s->DBExec(q|
+ INSERT INTO releases_vn (rid, vid)
+ VALUES (%d, %d)|,
+ $cid, $_
+ ) for (@{$o->{vn}});
+
+ $s->DBExec(q|
+ INSERT INTO releases_media (rid, medium, qty)
+ VALUES (%d, !s, %d)|,
+ $cid, $_->[0], $_->[1]
+ ) for (@{$o->{media}});
+}
+
+
+sub DBDelRelease { # $vns, @ids
+ my($s, $vn, @rid) = @_;
+ return if !@rid;
+ $s->DBExec($_, \@rid) for(
+ q|DELETE FROM changes WHERE id IN(SELECT rr.id FROM releases_rev rr WHERE rr.rid IN(!l))|,
+ q|DELETE FROM releases_producers WHERE rid IN(SELECT rr.id FROM releases_rev rr WHERE rr.rid IN(!l))|,
+ q|DELETE FROM releases_platforms WHERE rid IN(SELECT rr.id FROM releases_rev rr WHERE rr.rid IN(!l))|,
+ q|DELETE FROM releases_media WHERE rid IN(SELECT rr.id FROM releases_rev rr WHERE rr.rid IN(!l))|,
+ q|DELETE FROM releases_rev WHERE rid IN(!l)|,
+ q|DELETE FROM releases_vn WHERE rid IN(!l)|,
+ q|DELETE FROM releases WHERE id IN(!l)|,
+ );
+
+ if($vn) {
+ $s->DBExec('SELECT update_vncache(%d)', $_) for (@$vn);
+ }
+}
+
+
+sub DBHideRelease { # id, hidden, vns
+ my($s, $id, $h, $vn) = @_;
+ $s->DBExec(q|
+ UPDATE releases
+ SET hidden = %d
+ WHERE id = %d|,
+ $h, $id);
+ if(@$vn) {
+ $s->DBExec('SELECT update_vncache(%d)', $_) for (@$vn);
+ }
+}
+
+
+
+#-----------------------------------------------------------------------------#
+# 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' => 1 ) : (),
+ $o{id} ? (
+ 'p.id = %d' => $o{id} ) : (),
+ $o{search} ? (
+ sprintf('(pr.name ILIKE %s OR pr.original ILIKE %1$s)', qs('%%'.$o{search}.'%%')), 1
+ ) : (),
+ $o{char} ? (
+ 'LOWER(SUBSTR(pr.name, 1, 1)) = !s' => $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} ? (
+ 'pr.id = %d' => $o{rev} ) : (),
+ );
+
+ my $where = scalar keys %where ? 'WHERE !W' : '';
+ 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/;
+ 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.prev' if $o{what} =~ /changes/;
+
+ my $r = $s->DBAll(qq|
+ SELECT $select
+ FROM producers_rev pr
+ @join
+ $where
+ ORDER BY pr.name ASC
+ LIMIT %d OFFSET %d|,
+ $where ? \%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);
+}
+
+
+# XXX: This query is killing me!
+sub DBGetProducerVN { # pid
+ return $_[0]->DBAll(q|
+ SELECT v.id, MAX(vr.title) AS title, 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 = %d
+ AND v.hidden = 0
+ GROUP BY v.id
+ ORDER BY date|,
+ $_[1]);
+}
+
+
+sub DBAddProducer { # %opts->{ columns in producers_rev + comm }
+ my($s, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments)
+ VALUES (%d, %d, !s, !s)|,
+ 2, $s->AuthInfo->{id}, $s->ReqIP, $o{comm});
+
+ my $id = $s->DBLastId('changes');
+ $s->DBExec(q|
+ INSERT INTO producers (latest)
+ VALUES (%d)|, $id);
+ my $pid = $s->DBLastId('producers');
+
+ _insert_producer_rev($s, $id, $pid, \%o);
+
+ return ($pid, $id);
+}
+
+
+sub DBEditProducer { # id, %opts->{ columns in producers_rev + comm }
+ my($s, $pid, %o) = @_;
+
+ $s->DBExec(q|
+ INSERT INTO changes (type, requester, ip, comments, prev)
+ VALUES (%d, %d, !s, !s, (
+ SELECT c.id
+ FROM changes c
+ JOIN producers_rev pr ON pr.id = c.id
+ WHERE pr.pid = %d
+ ORDER BY c.id DESC
+ LIMIT 1
+ ))|,
+ 2, $s->AuthInfo->{id}, $s->ReqIP, $o{comm}, $pid);
+
+ my $id = $s->DBLastId('changes');
+
+ _insert_producer_rev($s, $id, $pid, \%o);
+
+ $s->DBExec(q|UPDATE producers SET latest = %d WHERE id = %d|, $id, $pid);
+ return $id;
+}
+
+
+sub _insert_producer_rev {
+ my($s, $cid, $pid, $o) = @_;
+ $s->DBExec(q|
+ INSERT INTO producers_rev (id, pid, name, original, website, type, lang, "desc")
+ VALUES (%d, %d, !s, !s, !s, !s, !s, !s)|,
+ $cid, $pid, @$o{qw| name original website type lang desc|});
+}
+
+
+sub DBDelProducer { # id
+ my($s, $pid) = @_;
+ $s->DBExec($_, $pid) for (
+ q|DELETE FROM changes c WHERE c.id IN(SELECT p.id FROM producers_rev p WHERE p.pid = %d)|,
+ q|DELETE FROM producers_rev WHERE pid = %d|,
+ q|DELETE FROM releases_producers WHERE pid = %d|,
+ q|DELETE FROM producers WHERE id = %d|,
+ );
+}
+
+
+sub DBHideProducer { # id, hidden
+ my($s, $id, $h) = @_;
+ $s->DBExec(q|
+ UPDATE producers
+ SET hidden = %d
+ WHERE id = %d|,
+ $h, $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 DBLastId { # table
+ return $_[0]->{_DB}->{sql}->last_insert_id(undef, undef, $_[1], undef);
+}
+
+
+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;
+ $sqlq = sqlprint($sqlq, @_) if exists $_[0];
+# warn "$sqlq\n";
+
+ my $q = $s->prepare($sqlq);
+ $q->execute();
+ my $r = $type == 1 ? $q->fetchrow_hashref :
+ $type == 2 ? $q->fetchall_arrayref({}) :
+ $q->rows;
+ $q->finish();
+
+ push(@{$self->{_DB}->{Queries}}, [ $sqlq, Time::HiRes::tv_interval($start) ]) 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;
+}
+
+
+# Added features:
+# !s SQL-quote
+# !l listify
+# !L SQL-quote-and-listify
+# !H list of SET-items: key = format, value = replacement
+# !W same as !H, but for WHERE clauses
+sub sqlprint {
+ my $i = -1;
+ my @arg;
+ my $sq = my $s = shift;
+ while($sq =~ s/([%!])(.)//) {
+ $i++;
+ my $t = $1; my $d = $2;
+ if($t eq '%') {
+ if($d eq '%') {
+ $i--; next
+ }
+ $arg[$i] = $_[$i];
+ next;
+ }
+ if($d !~ /[slLHW]/) {
+ $i--; next
+ }
+ $arg[$i] = qs($_[$i]) if $d eq 's';
+ $arg[$i] = join(',', @{$_[$i]}) if $d eq 'l';
+ $arg[$i] = join(',', (qs(@{$_[$i]}))) if $d eq 'L';
+ if($d eq 'H' || $d eq 'W') {
+ my @i;
+ defined $_[$i]{$_} && push(@i, sqlprint($_, $_[$i]{$_})) for keys %{$_[$i]};
+ $arg[$i] = join($d eq 'H' ? ', ' : ' AND ', @i);
+ }
+ }
+ $s =~ s/![sSlLHW]/%s/g;
+ $s =~ s/!!/!/g;
+ return sprintf($s, @arg);
+}
+
+
+sub qs { # ISO SQL2-quoting, with some PgSQL-specific stuff
+ my @r = @_;
+ # NOTE: we use E''-style strings because backslash escaping in the normal ''-style
+ # depends on the standard_conforming_strings configuration option of PgSQL,
+ # while E'' will always behave the same regardless of the server configuration.
+ for (@r) {
+ (!defined $_ or $_ eq '_NULL_') && ($_ = 'NULL') && next;
+ s/'/''/g;
+ s/\\/\\\\/g;
+ $_ = "E'$_'";
+ }
+ return wantarray ? @r : $r[0];
+}
+
+
+1;
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-16 04:31:48 +0000