From d7046f5d38004ff20739798c18f5796c31676546 Mon Sep 17 00:00:00 2001
From: yorhel
Date: Sun, 13 Apr 2008 13:45:20 +0000
Subject: W00t, VNDB on SVN!
git-svn-id: svn://vndb.org/vndb@1 1fe2e327-d9db-4752-bcf7-ef0cb4a1748b
---
data/tpl/defs.pl | 482 ++++++++++++++++
data/tpl/docs | 298 ++++++++++
data/tpl/error | 45 ++
data/tpl/faq | 75 +++
data/tpl/hist | 103 ++++
data/tpl/home | 67 +++
data/tpl/main | 14 +
data/tpl/myvotes | 30 +
data/tpl/page | 140 +++++
data/tpl/pbrowse | 45 ++
data/tpl/pedit | 45 ++
data/tpl/ppage | 58 ++
data/tpl/redit | 70 +++
data/tpl/rpage | 61 ++
data/tpl/useredit | 34 ++
data/tpl/userlist | 54 ++
data/tpl/userlogin | 14 +
data/tpl/userpage | 13 +
data/tpl/userpass | 21 +
data/tpl/userreg | 38 ++
data/tpl/vnbrowse | 87 +++
data/tpl/vnedit | 94 ++++
data/tpl/vnlist | 74 +++
data/tpl/vnpage | 171 ++++++
data/tpl/vnpage_rel | 51 ++
data/tpl/vnpage_rg | 11 +
data/tpl/vnpage_stats | 68 +++
lib/ChangeLog | 215 +++++++
lib/VNDB.pm | 338 +++++++++++
lib/VNDB/HomePages.pm | 286 ++++++++++
lib/VNDB/Producers.pm | 188 +++++++
lib/VNDB/Releases.pm | 178 ++++++
lib/VNDB/Users.pm | 230 ++++++++
lib/VNDB/Util/Auth.pm | 131 +++++
lib/VNDB/Util/DB.pm | 1268 ++++++++++++++++++++++++++++++++++++++++++
lib/VNDB/Util/Request.pm | 46 ++
lib/VNDB/Util/Response.pm | 238 ++++++++
lib/VNDB/Util/Template.pm | 235 ++++++++
lib/VNDB/Util/Tools.pm | 145 +++++
lib/VNDB/VN.pm | 380 +++++++++++++
lib/VNDB/VNLists.pm | 96 ++++
lib/VNDB/Votes.pm | 61 ++
lib/global.pl | 569 +++++++++++++++++++
static/files/def.js | 239 ++++++++
static/files/dyna.js | 579 +++++++++++++++++++
static/files/footer.gif | Bin 0 -> 91 bytes
static/files/graph.png | Bin 0 -> 601 bytes
static/files/headerbg.jpg | Bin 0 -> 6068 bytes
static/files/headerbot.png | Bin 0 -> 2343 bytes
static/files/platforms.png | Bin 0 -> 2353 bytes
static/files/rss.png | Bin 0 -> 735 bytes
static/files/select.png | Bin 0 -> 1165 bytes
static/files/sidebarbg.jpg | Bin 0 -> 3035 bytes
static/files/sidebarbot.jpg | Bin 0 -> 1642 bytes
static/files/sidebg.jpg | Bin 0 -> 553 bytes
static/files/style.css | 729 ++++++++++++++++++++++++
static/files/warning.png | Bin 0 -> 2348 bytes
util/cleanimg.pl | 102 ++++
util/cron_daily.sh | 31 ++
util/cron_daily.sql | 15 +
util/relgraph.pl | 237 ++++++++
util/sitemap.pl | 94 ++++
util/updates/update_1.1.pl | 18 +
util/updates/update_1.1.sql | 13 +
util/updates/update_1.10.sql | 92 +++
util/updates/update_1.11.sql | 4 +
util/updates/update_1.12.sql | 34 ++
util/updates/update_1.13.sql | 229 ++++++++
util/updates/update_1.14.pl | 57 ++
util/updates/update_1.14.sql | 76 +++
util/updates/update_1.2.sql | 9 +
util/updates/update_1.4.sql | 37 ++
util/updates/update_1.5.sql | 10 +
util/updates/update_1.6.sql | 21 +
util/updates/update_1.7.sql | 23 +
util/updates/update_1.8.sql | 27 +
util/updates/update_1.9.sql | 375 +++++++++++++
77 files changed, 9918 insertions(+)
create mode 100644 data/tpl/defs.pl
create mode 100644 data/tpl/docs
create mode 100644 data/tpl/error
create mode 100644 data/tpl/faq
create mode 100644 data/tpl/hist
create mode 100644 data/tpl/home
create mode 100644 data/tpl/main
create mode 100644 data/tpl/myvotes
create mode 100644 data/tpl/page
create mode 100644 data/tpl/pbrowse
create mode 100644 data/tpl/pedit
create mode 100644 data/tpl/ppage
create mode 100644 data/tpl/redit
create mode 100644 data/tpl/rpage
create mode 100644 data/tpl/useredit
create mode 100644 data/tpl/userlist
create mode 100644 data/tpl/userlogin
create mode 100644 data/tpl/userpage
create mode 100644 data/tpl/userpass
create mode 100644 data/tpl/userreg
create mode 100644 data/tpl/vnbrowse
create mode 100644 data/tpl/vnedit
create mode 100644 data/tpl/vnlist
create mode 100644 data/tpl/vnpage
create mode 100644 data/tpl/vnpage_rel
create mode 100644 data/tpl/vnpage_rg
create mode 100644 data/tpl/vnpage_stats
create mode 100644 lib/ChangeLog
create mode 100644 lib/VNDB.pm
create mode 100644 lib/VNDB/HomePages.pm
create mode 100644 lib/VNDB/Producers.pm
create mode 100644 lib/VNDB/Releases.pm
create mode 100644 lib/VNDB/Users.pm
create mode 100644 lib/VNDB/Util/Auth.pm
create mode 100644 lib/VNDB/Util/DB.pm
create mode 100644 lib/VNDB/Util/Request.pm
create mode 100644 lib/VNDB/Util/Response.pm
create mode 100644 lib/VNDB/Util/Template.pm
create mode 100644 lib/VNDB/Util/Tools.pm
create mode 100644 lib/VNDB/VN.pm
create mode 100644 lib/VNDB/VNLists.pm
create mode 100644 lib/VNDB/Votes.pm
create mode 100644 lib/global.pl
create mode 100644 static/files/def.js
create mode 100644 static/files/dyna.js
create mode 100644 static/files/footer.gif
create mode 100644 static/files/graph.png
create mode 100644 static/files/headerbg.jpg
create mode 100644 static/files/headerbot.png
create mode 100644 static/files/platforms.png
create mode 100644 static/files/rss.png
create mode 100644 static/files/select.png
create mode 100644 static/files/sidebarbg.jpg
create mode 100644 static/files/sidebarbot.jpg
create mode 100644 static/files/sidebg.jpg
create mode 100644 static/files/style.css
create mode 100644 static/files/warning.png
create mode 100644 util/cleanimg.pl
create mode 100755 util/cron_daily.sh
create mode 100644 util/cron_daily.sql
create mode 100755 util/relgraph.pl
create mode 100755 util/sitemap.pl
create mode 100755 util/updates/update_1.1.pl
create mode 100644 util/updates/update_1.1.sql
create mode 100644 util/updates/update_1.10.sql
create mode 100644 util/updates/update_1.11.sql
create mode 100644 util/updates/update_1.12.sql
create mode 100644 util/updates/update_1.13.sql
create mode 100755 util/updates/update_1.14.pl
create mode 100644 util/updates/update_1.14.sql
create mode 100644 util/updates/update_1.2.sql
create mode 100644 util/updates/update_1.4.sql
create mode 100644 util/updates/update_1.5.sql
create mode 100644 util/updates/update_1.6.sql
create mode 100644 util/updates/update_1.7.sql
create mode 100644 util/updates/update_1.8.sql
create mode 100644 util/updates/update_1.9.sql
diff --git a/data/tpl/defs.pl b/data/tpl/defs.pl
new file mode 100644
index 00000000..b68faab0
--- /dev/null
+++ b/data/tpl/defs.pl
@@ -0,0 +1,482 @@
+[[!
+
+use Time::CTime ();
+use Algorithm::Diff 'sdiff';
+use POSIX ('ceil', 'floor');
+
+my %p; # $X->{page} global page data
+my %d; # $X->{page}->{$p} local page data
+
+# redefine _hchar - usually a bad idea, but who cares
+sub _hchar {local$_=shift||return'';s/&/&/g;s/</g;s/>/>/g;s/"/"/g;s/\r?\n/ \n/g;return$_;}
+
+sub formatdate {return _hchar(Time::CTime::strftime($_[0],gmtime($_[1]||0)))||'';}
+sub txt {local$_=shift||return'';s/&/&/g;s/</g;s/>/>/g;return$_;}
+sub art2str {my$r='';$r.=($r?' & ':'').$_->{name}foreach (@{$_[0]->{artists}});return $_[1]?$r:_hchar($r);}
+sub calctime {my$r=shift;return'0:00:00'if!$r;my$x=sprintf'%d:%02d:%02d',int($r/3600),int(($r%3600)/60),($r%3600)%60;return $x;}
+sub shorten {local$_=shift||return'';return length>$_[0]?substr($_,0,$_[0]-3).'...':$_};
+
+# Date string format: yyyy-mm-dd
+# y = 0 -> Unknown
+# y = 9999 -> TBA (To Be Announced)
+# m = 0 -> Month + day unknown, year known
+# d = 0 -> Day unknown, month + year known
+sub datestr {
+ my $d = $_[0]||'00000000';
+ my @d = map { int } $1, $2, $3 if $d =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/;
+ return 'unknown' if $d[0] == 0;
+ my $r = sprintf !$d[1] ? '%04d' : !$d[2] ? '%04d-%02d' : '%04d-%02d-%02d', @d;
+ my $b = $r gt Time::CTime::strftime("%Y-%m-%d", gmtime());
+ $r = 'TBA' if $d[0] == 9999;
+ return ($b?'':'').$r.($b?' ':'');
+}
+sub mediastr {
+ return join(', ', map {
+ $_->{medium} =~ /^(cd|dvd|gdr|blr)$/
+ ? sprintf('%d %s%s', $_->{qty}, $VNDB::MED->{$_->{medium}}, $_->{qty}>1?'s':'')
+ : $VNDB::MED->{$_->{medium}}
+ } @{$_[0]});
+}
+sub sortbut { # url, col
+ my $r=' '; my $u = _hchar($_[0]);
+ $u .= $u =~ /\?/ ? ';' : '?';
+ for ('a', 'd') {
+ my $chr = $_ eq 'd' ? "\x{25BE}" : "\x{25B4}";
+ $r .= $d{order}[0] eq $_[1] && $d{order}[1] eq $_ ? $chr :
+ sprintf '%s ', $u, $_[1], $_, $chr;
+ }
+ return $r;
+}
+sub pagebut { # url
+ my @br; my $ng = $_[0] =~ /\?/ ? ';' : '?';
+ push @br, sprintf '<- previous ', $_[0].($d{page}-2 ? $ng.'p='.($d{page}-1) : '') if $d{page} > 1;
+ push @br, sprintf 'next -> ', $_[0].$ng.'p='.($d{page}+1) if $d{npage};
+ return $#br >= 0 ? ('( '.join(' | ', @br).' )
') : '';
+}
+sub wraplong { # text, margin
+ local $_ = $_[0];
+ my $m = $_[1]/2;
+ s/([^\s\r\n]{$m})([^\s\r\n])/$1 $2/g;
+ return $_;
+}
+
+
+sub wordsplit { # split a string into an array of words, but make sure to not split HTML tags
+# return [ split //, $_[0] ];
+ my @a;
+ my $in='';
+ for (split /\s+/, $_[0]) {
+ my $gt = () = />/g;
+ my $lt = () = / $lt) {
+ push @a, $in.$_;
+ $in='';
+ } elsif($lt > $gt || $in) {
+ $in .= $_.' ';
+ } else {
+ push @a, $_;
+ };
+ }
+ push @a, $in if $in;
+ return \@a;
+}
+
+sub cdiff { # obj1, obj2, @items->[ short, name, serialise, diff, [parsed_x, parsed_y] ]
+ my($x, $y, @items, @c) = @_;
+ # serialise = 0 -> integer, 1 -> string, CODEref -> code
+
+ my $type = defined $$y{minage} ? 'r' : defined $$y{length} ? 'v' : 'p';
+ my $pre = '|;
+
+ if(!$x) { # just show info about the revision if there is no previous edit
+ return $pre.qq|Revision $$y{cid} (
edit )
By
$$y{username} on |.
+ formatdate('%Y-%m-%d at %R', $$y{added}).'
Edit summary: '.
+ summary($$y{comments}, 0, '[no summary]').'
';
+ }
+ for (@items) {
+ $_->[4] = !$_->[2] ? $x->{$_->[0]}||'0' : !ref($_->[2]) ? _hchar(wraplong($x->{$_->[0]}||'[empty]',60)) : &{$_->[2]}($x->{$_->[0]})||'[empty]';
+ $_->[5] = !$_->[2] ? $y->{$_->[0]}||'0' : !ref($_->[2]) ? _hchar(wraplong($y->{$_->[0]}||'[empty]',60)) : &{$_->[2]}($y->{$_->[0]})||'[empty]';
+ push(@c, $_) if $_->[4] ne $_->[5];
+ if($_->[3] && $_->[4] ne $_->[5]) {
+ my($rx,$ry,$ch) = ('','','u');
+ for (sdiff(wordsplit($_->[4]), wordsplit($_->[5]))) {
+ if($ch ne $_->[0]) {
+ if($ch ne 'u') {
+ $rx .= '';
+ $ry .= '';
+ }
+ $rx .= '' if $_->[0] eq '-' || $_->[0] eq 'c';
+ $ry .= '' if $_->[0] eq '+' || $_->[0] eq 'c';
+ }
+ $ch = $_->[0];
+ $rx .= $_->[1].' ' if $ch ne '+';
+ $ry .= $_->[2].' ' if $ch ne '-';
+ }
+ $_->[4] = $rx;
+ $_->[5] = $ry;
+ }
+ }
+ return $pre.' '.
+ qq|Revision $$x{cid} (edit ) By $$x{username} on |.formatdate('%Y-%m-%d at %R', $$x{added}).' '.
+ qq|Revision $$y{cid} (edit ) By $$y{username} on |.formatdate('%Y-%m-%d at %R', $$y{added}).' '.
+ ' Edit summary of revision '.$$y{cid}.' '.summary($$y{comments}, 0, '[no summary]').' '.
+ join('',map{
+ ''.$_->[1].' '.$_->[4].' '.$_->[5].' '
+ } @c).'
';
+}
+
+
+sub summary { # cmd, len, def
+ return $_[2]||'' if !$_[0];
+ my $res = '';
+ my $len = 0;
+ my $as = 0;
+ for (split / /, $_[0]) {
+ next if !$_;
+ my $l = length;
+ s/\&/&/g;
+ s/>/>/g;
+ s/</g;
+ while(s/\[url=((https?:\/\/|\/)[^\]>]+)\]//) {
+ $l -= length($1)+6;
+ $as++;
+ }
+ if(!$as && s/(http|https):\/\/(.+[0-9a-zA-Z\/])/ link<\/a>/) {
+ $l = 4;
+ } elsif(!$as) {
+ s/^([uvpr][0-9]+)[^\w]*$/ $1<\/a>/;
+ }
+ while(s/\[\/url\]/<\/a>/) {
+ $l -= 6;
+ $as--;
+ }
+ $len += $l + 1;
+ last if $_[1] && $len > $_[1];
+ $res .= "$_ ";
+ }
+ $res =~ y/\r\n/ / if $_[1];
+ $res =~ s/\r?\n/ /g if !$_[1];
+ $res =~ s/ +$//;
+ $res .= ' ' x $as if $as;
+ $res .= '...' if $_[1] && $len > $_[1];
+ return $res;
+}
+
+
+sub ttabs { # [vrp], obj, sel
+ my($t, $o, $s) = @_;
+ $s||='';
+ my @act = (
+ !$s?'%s':'%1$s ',
+ $$o{locked} ?
+ 'locked for editing ' : (),
+ $p{Authlock} ?
+ sprintf('%s ', $$o{locked} ? 'unlock' : 'lock') : (),
+ $p{Authdel} ? (
+ 'del ',
+ sprintf('%s ', $t eq 'v' ? ' id="vhide"' : '', $$o{hidden} ? 'unhide' : 'hide')
+ ) : (),
+ !$$o{locked} || ($p{Authedit} && $p{Authlock}) ?
+ ($s eq 'edit' ? 'edit' : 'edit ') : (),
+
+ $p{Authhist} ?
+ ($s eq 'hist' ? 'history' : 'history ') : (),
+ );
+ return ' < '.join(' - ', map { sprintf $_, $t.$$o{id} } @act).' >
'.(
+ $t eq 'v' ? qq|
+| : $t eq 'r' ? qq|
+| : ''
+ );
+}
+
+
+
+my %pagetitles = (
+ faq => 'Frequently Asked Questions',
+ userlogin => 'Login',
+ userreg => 'Register a new account',
+ userpass => 'Forgot your password?',
+ home => 'Visual Novel Database',
+ pbrowse => 'Browse producers',
+ userlist => 'Browse users',
+ myvotes => sub {
+ return $p{myvotes}{user}{username} eq $p{AuthUsername} ? 'My votes' : ('Votes by '.$p{myvotes}{user}{username}); },
+ userpage => sub {
+ return 'User: '.$p{userpage}{user}{username} },
+ vnlist => sub {
+ return $p{vnlist}{user}{username} eq $p{AuthUsername} ? 'My visual novel list' : ($p{vnlist}{user}{username}.'\'s visual novel list'); },
+ useredit => sub {
+ return !$p{useredit}{adm} ? 'My account' : 'Edit '.$p{useredit}{form}{username}.'\'s account'; },
+ ppage => sub {
+ return $p{ppage}{prod}{name} },
+ pedit => sub {
+ return $p{pedit}{id} ? sprintf('Edit %s', $p{pedit}{form}{name}) : 'Add a new producer'; },
+ vnedit => sub {
+ return $p{vnedit}{id} ? sprintf('Edit %s', $p{vnedit}{form}{title}) : 'Add a new visual novel'; },
+ redit => sub {
+ return $p{redit}{id} ? sprintf('Edit %s', $p{redit}{rel}{title}) : sprintf('Add release to %s', $p{redit}{vn}{title}); },
+ vnpage => sub { return $p{vnpage}{vn}{title}; },
+ vnrg => sub { return 'Relations for '.$p{vnrg}{vn}{title} },
+ vnstats => sub { return 'User statistics for '.$p{vnstats}{vn}{title} },
+ vnbrowse => sub {
+ return $p{vnbrowse}{chr} eq 'search' ? sprintf 'Search results for "%s"', $p{searchquery} :
+ $p{vnbrowse}{chr} eq 'cat' ? 'Browse categories' :
+ $p{vnbrowse}{chr} eq 'mod' ? 'Visual Novels awaiting moderation' :
+ $p{vnbrowse}{chr} eq 'all' ? 'Browse all visual novels' :
+ $p{vnbrowse}{chr} eq '0' ? 'Browse by char: Other' :
+ sprintf 'Browse by char: %s', uc $p{vnbrowse}{chr}; },
+ rpage => sub {
+ return $p{rpage}{rel}{romaji} || $p{rpage}{rel}{title} },
+ hist => sub {
+ return !$p{hist}{id} || !$p{hist}{type} ? 'Recent changes' :
+ $p{hist}{type} eq 'u' ? 'Recent changes by '.$p{hist}{title} : 'Edit history of '.$p{hist}{title}; },
+ docs => sub {
+ return (
+ 'Categories', 'Adding/editing a visual novel', 'Adding/editing a release',
+ 'Adding/editing a producer', 'General guidelines', 'Error parsing form',
+ )[$p{docs}{p}-1]||'' }
+);
+sub gettitle{$p{$_}&&($p{PageTitle}=ref($pagetitles{$_}) eq 'CODE' ? &{$pagetitles{$_}} : $pagetitles{$_}) for (keys%pagetitles);}
+
+
+#
+# F O R M E R R O R H A N D L I N G
+#
+my %formerr_names = (
+ mail => 'Email',
+ username => 'Username',
+ userpass => 'Password',
+ pass1 => 'Password',
+ pass2 => 'Password (second)',
+ title => 'Title',
+ desc => 'Description',
+ rel => 'Relation',
+ romaji => 'Romanized title',
+ lang => 'Language',
+ web => 'Website',
+ released => 'Release date',
+ platforms => 'Platforms',
+ media => 'Media',
+ name => 'Name',
+ vn => 'Visual novel relations',
+);
+my @formerr_msgs = (
+ sub { return sprintf 'Field "%s" is required.', @_ },
+ sub { return sprintf '%s should have at least %d characters.', @_ },
+ sub { return sprintf '%s is too large! Only %d characters allowed.', @_ },
+ sub { return
+ $_[1] eq 'mail' ? 'Invalid email address' :
+ $_[1] eq 'url' ? 'Invalid URL' :
+ $_[1] eq 'pname' ? sprintf('%s can only contain alfanumeric characters!', $_[0]) :
+ $_[1] eq 'asciiprint' ? sprintf('Only ASCII characters are allowed at %s', $_[0]) :
+ $_[1] eq 'int' ? sprintf('%s should be a number!', $_[0]) : '';
+ },
+ sub { return sprintf '%s: invalid item selected', @_ },
+ sub { return 'Invalid unicode, are you sure your browser works fine?' },
+);
+my %formerr_exeptions = (
+ loginerr => 'Invalid username or password',
+ badpass => 'Passwords do not match',
+ usrexists => 'Username already exists, please choose an other one',
+ mailexists => 'There already is a user with that email address, please request a new password if you forgot it',
+ nomail => 'No user found with that email address',
+ nojpeg => 'Image is not in JPEG format!',
+ toolarge => 'Image is too large (in filesize), try to compress it a little',
+ imgsize => 'Image is too large (in height/width), try to resize it a little',
+);
+sub formerr {
+ my @err = ref $_[0] eq 'ARRAY' ? @{$_[0]} : ();
+ return '' if $#err < 0;
+ my @msgs;
+ my $ret = '
+ Error:';
+ $ret .= sprintf " %s \n",
+ /^([a-z0-9]+)_([0-9]+)_?(.*)$/ ? &{$formerr_msgs[$2-1]}($formerr_names{$1}, $3?$3:'') : $formerr_exeptions{$_}
+ foreach (@err);
+ $ret .= " \n \n";
+}
+
+#
+# F O R M C R E A T I N G
+#
+
+# args = [
+# {
+# type => $type,
+# %options
+# }, ...
+# ], $formobj
+#
+# $type $formobj %options ( required, [ optional ] )
+# error X ( )
+# startform ( action, [ upload ] )
+# endform ( )
+# input X ( short, name, [ class, default ] )
+# pass ( short, name )
+# upload ( short, name, [ class ] )
+# hidden X ( short, [ value ] )
+# textarea X ( short, name, [ rows, cols, class ] )
+# select X ( short, name, options, [ class ] ) # options = arrayref of hashes with keys: short, name
+# as X ( name )
+# trans X ( )
+# submit ( [ text, short ] )
+# sub ( title )
+# check X ( short, name, [ value ] )
+# static ( text, raw [ name, class ] )
+# date X ( short, name )
+#
+sub cform {
+ my $obj = shift;
+ my $frm = shift;
+ my $ret = '';
+ my $csub = '';
+ for (@$obj) {
+ $_->{class} ||= '';
+ $_->{class} .= ' sf_'.$csub if $csub && $_->{class} !~ /nohid/;
+ $_->{class} .= ' formhid' if $csub && $frm->{_hid} && !$frm->{_hid}{$csub} && $_->{class} !~ /nohid/;
+ $_->{name} = '* '.$_->{name} if $_->{r};
+
+ # error
+ if($_->{type} eq 'error') {
+ $ret .= formerr($frm->{_err});
+ # startform
+ } elsif($_->{type} eq 'startform') {
+ $ret .= sprintf qq|\n|;
+ # input
+ } elsif($_->{type} eq 'input') {
+ $ret .= sprintf qq|\n %s \n %s \n \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}, $_->{pre} ? ''.$_->{pre}.' ' : '',
+ _hchar($frm->{$_->{short}}?$frm->{$_->{short}}:$_->{default});
+ # pass
+ } elsif($_->{type} eq 'pass') {
+ $ret .= sprintf qq|\n %s \n \n \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name};
+ # upload
+ } elsif($_->{type} eq 'upload') {
+ $ret .= sprintf qq|\n %s \n \n \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name};
+ # hidden
+ } elsif($_->{type} eq 'hidden') {
+ $ret .= sprintf qq| \n|,
+ $_->{short}, _hchar($_->{value} || $frm->{$_->{short}});
+ # textarea
+ } elsif($_->{type} eq 'textarea') {
+ $ret .= sprintf qq|\n %s \n \n \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}, $_->{rows}||15, $_->{cols}||70, txt($frm->{$_->{short}});
+ # select
+ } elsif($_->{type} eq 'select') {
+ $ret .= sprintf qq|\n %s \n \n%s \n \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}, eval {
+ my $r='';
+ for my $s (@{$_->{options}}) {
+ $r .= sprintf qq| %s \n|,
+ $s->{short}, defined $frm->{$_->{short}} && $frm->{$_->{short}} eq $s->{short} ? ' selected="selected"' : '', $s->{name};
+ }
+ return $r;
+ };
+ # jssel
+ } elsif($_->{type} eq 'jssel') {
+ (my $oname = $_->{name}) =~ s/^\*<\/i>//;
+ $ret .= sprintf
+ qq|\n|
+ .qq| %s \n|
+ .qq| \n|
+ .qq| Add %s... \n|
+ .qq| \n|
+ .qq| \n|
+ .qq| Loading...\n|
+ .qq|
\n|
+ .qq| \n|
+ .qq| \n|,
+ $_->{class} ? ' class="'.$_->{class}.'"' : '',
+ $_->{sh}, $_->{name}, $_->{sh}, $_->{sh}, $oname, $_->{sh}, $_->{short}, $_->{short}, _hchar($frm->{$_->{short}});
+ # submit
+ } elsif($_->{type} eq 'submit') {
+ $ret .= sprintf qq|\n \n \n|,
+ $_->{text} || 'Verstuur', $_->{short} ? sprintf(' name="%s" id="%1$s"', $_->{short}) : '';
+ # sub
+ } elsif($_->{type} eq 'sub') {
+ $ret .= sprintf qq|\n %s %s \n \n|,
+ $_->{short}, $frm->{_hid} && !$frm->{_hid}{$_->{short}} ? '▸' : '▾', $_->{title};
+ $csub = $_->{short};
+ # check
+ } elsif($_->{type} eq 'check') {
+ $ret .= sprintf qq|\n \n %s \n \n|,
+ $_->{class} ? ' '.$_->{class} : '',
+ $_->{short}, $_->{value} || 'true', $frm->{$_->{short}} ? ' checked="checked"' : '', $_->{name};
+ # static
+ } elsif($_->{type} eq 'static') {
+ $ret .= $_->{name}
+ ? sprintf qq|\n %s \n %s
\n |, $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{name}, $_->{text}
+ : $_->{raw}
+ ? sprintf qq|\n %s\n |, $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{text}
+ : sprintf qq|\n %s\n |, $_->{class} ? ' '.$_->{class} : '', $_->{text};
+ # date
+ } elsif($_->{type} eq 'date') {
+ $ret .= sprintf qq|\n %s \n|,
+ $_->{class} ? ' '.$_->{class} : '', $_->{short}, $_->{name};
+ $ret .= sprintf qq| \n%s \n|,
+ $_->{short}, $_->{short}, eval {
+ my $r='';
+ for my $s (0, 1990..((localtime())[5]+1905), 9999) {
+ $r .= sprintf qq| %s \n|,
+ $s, $frm->{$_->{short}} && ($frm->{$_->{short}}[0]||0) == $s ? ' selected="selected"' : '',
+ !$s ? '-year-' : $s < 9999 ? $s : 'TBA';
+ }
+ return $r;
+ };
+ $ret .= sprintf qq| \n%s \n|,
+ $_->{short}, $_->{short}, eval {
+ my $r='';
+ for my $s (0..12) {
+ $r .= sprintf qq| %s \n|,
+ $s, $frm->{$_->{short}} && ($frm->{$_->{short}}[1]||0) == $s ? ' selected="selected"' : '',
+ $s ? $Time::CTime::MonthOfYear[$s-1] : '-month-';
+ }
+ return $r;
+ };
+ $ret .= sprintf qq| \n%s \n \n|,
+ $_->{short}, $_->{short}, eval {
+ my $r='';
+ for my $s (0..31) {
+ $r .= sprintf qq| %s \n|,
+ $s, $frm->{$_->{short}} && ($frm->{$_->{short}}[2]||0) == $s ? ' selected="selected"' : '',
+ $s ? $s : '-day-';
+ }
+ return $r;
+ };
+ }
+ }
+ return $ret;
+}
+
+]]
diff --git a/data/tpl/docs b/data/tpl/docs
new file mode 100644
index 00000000..1ca812c2
--- /dev/null
+++ b/data/tpl/docs
@@ -0,0 +1,298 @@
+[[ if(0) { ]]
+ < categories - visual novels - releases - producers - general guidelines >
+[[ } ]]
+[[: $p{PageTitle} ]]
+
+
+[[ # C A T E G O R I E S
+ if($d{p} == 1) { ]]
+
+
Elements
+
+ ...own interpretation for now... (Should be documented at some time, too)
+
+
+
+
Gameplay
+
+ This category is used to describe the gameplay or game engine.
+
+
+ Visual Novel
+ All games where the text is overlaid on the background and there is no special
+ dialog-box fall under this category. Can be abbreviated as VN or NVL.
+ Adventure
+ This is the opposite of the Visual Novel category: The text is presented
+ in a special window, usually at the bottom of the screen. In some (rare) cases
+ a game will switch between both styles, for these games both the Visual Novel
+ and Adventure categories should be selected. Can be abbreviated as ADV or AVG.
+ Action
+ This category indicates that the game includes a gameplay that challenges the
+ player's speed, dexterity and reaction time. Common examples are fighting games,
+ puzzles that should be solved within a short time limit, and shooter games.
+ RPG
+ Abbreviation for Role Playing Game. An RPG is a game in which you assume the
+ role of a character introduced to a vast world to be explored. Games typically
+ place emphasis on gaining equipment and experience points through fighting enemies
+ in order to advance through different levels.
+ Strategy
+ A strategy game is one that challenges the player to think critically in order
+ to achieve victory.
+ Simulation
+ A simulation game attempts to recreate aspects of reality and puts the player in
+ control.
+
+
+
+
Plot
+
+ Indicates the plot type of a game. There are only two options: Branching and
+ Linear .
+
+
+ Linear
+ A game with a linear plot has a static story; it is not possible to get different paths
+ or endings. Many games in this category do not prompt the player with choices and simply
+ tell the story as it is. This is, however, not a rule: it is also possible for a game
+ to provide choises, but they have no influence on the story itself. (e.g.
+ Utawarerumono )
+ Branching
+ A game with a branching plot has a story whose path is directly affected by choices
+ made by the player during the game. These different paths are sometimes referred to
+ as "arcs" when they pertain to the stories of different female characters within a game.
+
+
+
+
Time
+
+ Indicates the time period in which the story has been set.
+
+
+ Future
+ The game is set in a time beyond that of our own. Games may incorperate elements of
+ future technologies or events yet-to-come.
+ Present
+ The game is set in the current day.
+ Past
+ The game is set in a time before our own. Games may or may not adhere to historic fact.
+
+
+
+
Place
+
+ Indicates the place in which the story is told.
+
+
+ Earth
+ The game takes place on our own planet.
+ Fantasy World
+ The game takes place on another world. The game's environment could be similar
+ to that of our own with a few significant changes, but it could also be
+ radically different.
+ Space
+ The game takes place in the vacuum of space between celestial bodies. For example,
+ this category can be used to define games where the characters may inhabit
+ spaceships that journey across the universe.
+
+
+
+
Sexual content
+
+ Indicates the types of sexual content that the game contains.
+
+
+ Sexual content
+ This is a generic category to indicate the presence of any sexual content in the
+ game. If there is any such content, this category should be selected.
+ Bestiality
+ Sexual activity between characters and animals.
+ No catgirls, I guess?
+ Incest
+ Sexual activity between members of the same family. Most of the time under the
+ justification of participants not blood related (step-sister etc.).
+ Lolicon
+ The usage of female characters with childlike features in sexual situations.
+ Shotacon
+ The usage of male characters with childlike features in sexual situations.
+ Yaoi
+ Sexual content depicting activity between males.
+ Yuri
+ Sexual content depicting activity between females.
+ Rape
+ Situation in which a character is made to engage in sexual activities against
+ their will.
+
+
+
+
+
+
+[[ } # V I S U A L N O V E L A D D / E D I T
+ if($d{p} == 2) { ]]
+
+
+ Blahblah about what we define as VN? Or should that be in General guidelines ?
+
+
+
General info
+
+ *Title
+ ..
+ Aliases
+ ..
+ *Description
+ ..
+ Length
+ ..
+ External links
+ ..
+
+
+
+
Categories
+
+ See Categories .
+
+
+
Image
+
+ General image guidelines and when to use the NSFW warning
+
+
+
Relations
+
+ When to add relation, and document direct and reverse relations
+ (Stolen from AniDB, needs some rewriting)
+
+
+ Sequel
+ Continuation of the story. <=>Prequel .
+ Prequel
+ The story happens before the original story.<=>Sequel .
+ Same setting
+ Same universe/world/reality/timeline, completely different characters.
+ Alternative setting
+ Same characters, different universe/world/reality/timeline.
+ Alternative version
+ Same setting, same characters, story is told differently.
+ Same characters
+ Shares one or more characters, story is unrelated.
+ Side story
+ Takes place sometime during the parent storyline. <=>Parent story
+ Parent story
+ .. <=>Side story .
+ Summary
+ Summarizes full story, may contain additional stuff. <=>Full story .
+ Full story
+ Full version of the summarized story. <=>Summary .
+ Other
+ ..
+
+
+
+
+
+
+
+
+[[ } # R E L E A S E A D D / E D I T
+ if($d{p} == 3) { ]]
+
+
+ When to add a release
+
+
+
General info
+
+ *Type
+ ..
+ *Title (romaji)
+ ..
+ Original title
+ ..
+ *Language
+ ..
+ Official website
+ ..
+ Release date
+ ..
+ Age rating
+ ..
+ Notes
+ ..
+
+
+
+
Platforms & Media
+
+ Platforms
+ ..
+ Media
+ ..
+
+
+
+
Producers
+..
+
+
Visual novel relations
+..
+
+
+
+
+
+
+[[ } # P R O D U C E R A D D / E D I T
+ if($d{p} == 4) { ]]
+
+
+ When to add a producer and what to do with producer relations...
+
+
+
General info
+
+ *Type
+ ..
+ *Name (romaji)
+ ..
+ Original name
+ ..
+ *Primary language
+ ..
+ Website
+ ..
+ Description
+ ..
+
+
+
+
+
+
+[[ } # G E N E R A L G U I D E L I N E S
+ if($d{p} == 5) { ]]
+
+
+Misc documentation:
+- Romanisation and capitalization (http://wiki.anidb.net/w/Romanisation)
+- What to do with fandisks
+- Edit summary
+- Quoting sources in descriptions
+- Piracy
+- Spoilers
+
+
+
+
+[[ } # N O S P A M M E S S A G E
+ if($d{p} == 6) { ]]
+
+
+ Error: The form could not be sent, please make sure you have Javascript
+ enabled in your browser!
+
+
+
+[[ } ]]
+
diff --git a/data/tpl/error b/data/tpl/error
new file mode 100644
index 00000000..76bd9462
--- /dev/null
+++ b/data/tpl/error
@@ -0,0 +1,45 @@
+
+
+ [[ if($X->{error}->{code} == 1) { ]]VNDB offline
+ [[ } else { ]] ERROR: [[= $X->{error}->{code} ]][[ } ]]
+
+
+
+
+
+
+
+
+
+
+ [[ if($X->{error}->{code} > 300 && $X->{error}->{code} < 310) { ]]
+
Moved
+
+ Check [[: $X->{error}->{url} ]] for the new location.
+
+ [[ } elsif($X->{error}->{code} == 401) { ]]
+
Login required
+
+ Please login
+
+ [[ } elsif($X->{error}->{code} == 1) { ]]
+
VNDB offline
+
+ [[: $X->{error}->{msg} ]]
+
+ [[ } ]]
+
+
+
diff --git a/data/tpl/faq b/data/tpl/faq
new file mode 100644
index 00000000..1c64056e
--- /dev/null
+++ b/data/tpl/faq
@@ -0,0 +1,75 @@
+[[: $p{PageTitle} ]]
+
+What is a Visual Novel?
+
+ A visual novel can be seen as a combination of a novel and a computer game:
+ they're computer games with a large text based storyline and only little
+ interaction of the player. A typical visual novel consists of text over
+ an anime-style background image and is accompanied by background music.
+ Throughout the game, the player usually has to answer a few questions which will
+ have an effect on the story, thus playing a visual novel a second time while
+ giving other answers may result in an entirely different plot.
+
+ For more information see
+ the Wikipedia article on visual novels or the description on
+ Visual-Novels.net .
+ To get a general idea of the genre, try one of the free short visual novels from
+ al|together 2006 .
+
+
+
+
+How about Eroge, H-Games and Dating Sims?
+
+ An eroge or H-game is basically any Japanese game that features sexual
+ content. Many visual novels are eroge and many eroge are visual novels,
+ but this is not a rule. The definition of dating sim is a bit more vague,
+ but it's usually the same as a visual novel, except that a dating sim
+ generally uses a gameplay based on statistics.
+
+ There are no strict bounds to the definition of "visual novel", most
+ eroge and dating sims include elements of visual novels, but may -
+ strictly speaking - not be visual novels themselves. As VNDB aims to
+ be comprehensive, we simply accept any game that contains elements of a
+ visual novel and is produced by a Japanese or Japan-related company or
+ doujin cicle.
+
+
+
+
+Why a Visual Novel Database?
+
+ The internet is large, very large, but the number of English resources
+ related to visual novels is only very limited. VNDB attempts to collect
+ and present as much information as possible that would otherwise be very
+ hard to find for the English speaking audience. This way fans can easily
+ keep track of new releases and localizations of their favorite games,
+ while not having to browse numerous of indistinct Japanese websites.
+
+
+
+
+How can I help VNDB?
+
+ There are many ways to contribute to VNDB. First of all you can freely
+ edit all information found on this website, so if you find any errors
+ just click the "edit" link on the top right of the page. You can also
+ add new information (visual novels, producers, releases) to the database,
+ though please search the database before you do in order to prevent
+ duplicate pages.
+
+ To discuss about new features or to help the development of the website
+ itself, feel free to browse the forums
+ or join us on IRC at #vndb @ irc.synirc.net .
+ If you aren't used to IRC or are just to lazy to install a client, you can
+ still join the chat using the Webchat .
+ Just choose a nickname, specify #vndb as channel and hit Login!
+
+
+
+
+Where can I download the Visual Novels?
+
+ Not here. We do not provide downloads nor links to resources that encourage
+ the illegal spreading of visual novels.
+
diff --git a/data/tpl/hist b/data/tpl/hist
new file mode 100644
index 00000000..e02a149f
--- /dev/null
+++ b/data/tpl/hist
@@ -0,0 +1,103 @@
+[[= $d{type} && $d{type} ne 'u' ? ttabs($d{type}, $d{obj}, 'hist') : '' ]]-
+
+[[ if($d{type} eq 'u' && $#{$d{hist}} < 0) { ]]
+
+ You haven't made any changes yet.
+
+[[ } ]]
+
+
+[[
+ my $url = !$d{type} ? '/hist' : '/'.$d{type}.$d{id}.'/hist';
+ my $furl = $url.'?e='.$d{sele}.';t=';
+ my $eurl = $url.'?t='.$d{selt}.';e=';
+ my $purl = !$d{type}?$eurl.$d{sele}:$d{type} eq 'v' && $d{seli} ? $url.'?i=1' : $url;
+ my $rurl = $url.'/rss'.(!$d{type}?'?t='.$d{selt}.';e='.$d{sele}:$d{type} eq 'v' && $d{seli} ? '?i=1' : '');
+ local $_ = $d{selt};
+ my @fil = (
+ /a/ ? 'all items' : 'all items ',
+ /v/ ? 'visual novels' : 'visual novels ',
+ /r/ ? 'releases' : 'releases ',
+ /p/ ? 'producers' : 'producers ',
+ );
+ local $_ = $d{sele};
+ my @edi = (
+ /0/ ? 'all changes' : 'all changes ',
+ /2/ ? 'edits only' : 'edits only ',
+ /1/ ? 'newly created pages only' : 'newly created pages only ',
+ );
+ local $_ = $d{seli};
+ my @inc = (
+ /0/ ? 'exclude' : 'exclude ',
+ /1/ ? 'include' : 'include ',
+ );
+]]
+
+[[ if(!$d{type}) { ]]-
+
+ [[= join(' | ', map { sprintf $_, $furl } @fil) ]]
+ [[= join(' | ', map { sprintf $_, $eurl } @edi) ]]
+
+[[ } if($d{type} eq 'v') { ]]-
+
+ ([[= join(' | ', @inc) ]]) edits of releases.
+
+[[ } ]]
+
+[[ if($d{act} eq 'r') { ]]
+
+ Performed the mass-revert, please see the following list for details.
+
+[[ } elsif($d{act} eq 'd') { ]]
+
+ The following edits have been completely deleted.
+
+[[ } ]]-
+
+
+
+[[= pagebut($purl) ]]
+[[ if(0 and $p{Authmod} || $p{Authdel}) { ]]
+[[ } ]]
+[[= pagebut($purl) ]]
+
diff --git a/data/tpl/home b/data/tpl/home
new file mode 100644
index 00000000..5d8cd763
--- /dev/null
+++ b/data/tpl/home
@@ -0,0 +1,67 @@
+Welcome to VNDB - The Visual Novel Database!
+
+
+ VNDB.org strives to be a comprehensive database for information about visual novels and
+ eroge.
+ 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.
+ Registered users are also able to keep track of a personal list of games they want to play or have finished
+ and they can vote on all visual novels.
+
+ Feel free to browse around , register an account
+ or to discuss about the database at our forums .
+
+
+VNDB 1.13!
+
+ And it's time for an update again: This update makes it possible to specify how much
+ a category applies to a visual novel, adds a language filter to the category browser,
+ and fixes many, many bugs.
+
+ Read more... - news archive .
+
+
+
+
+
+
+
+ Most popular
+ [[ for (@{$d{popular}}) { $_->{c_votes} =~ s#^([0-9]{2}.[0-9]{2}).+$#sprintf '%.1f', $1#e; ]]-
+ [[: shorten $_->{title}, 30 ]] ([[= $_->{c_votes} ]])
+ [[ } ]]
+
+
+
+
+
+
+
+
+
diff --git a/data/tpl/main b/data/tpl/main
new file mode 100644
index 00000000..d52a576a
--- /dev/null
+++ b/data/tpl/main
@@ -0,0 +1,14 @@
+[[+ defs.pl ]]
+
+
+
+
+-[[ if($X->{error}) { ]]
+ [[+ error ]]
+[[ } if($X->{page}) { %p = %{$X->{page}}; gettitle(); ]]
+ [[+ page ]]
+[[ } ]]-
+
+
diff --git a/data/tpl/myvotes b/data/tpl/myvotes
new file mode 100644
index 00000000..9379e98e
--- /dev/null
+++ b/data/tpl/myvotes
@@ -0,0 +1,30 @@
+[[: $p{PageTitle} ]]
+[[ if($#{$d{votes}} < 0) { ]]-
+
+[[ if($d{user}{username} eq $p{AuthUsername}) { ]]
+ You haven't voted on anything yet...
+[[ } else { ]]
+ [[: $d{user}{username} ]]- hasn't voted on anything yet...
+[[ } ]]
+
+[[ } else {
+ my $url = sprintf '/u%d/votes', $d{user}{id};
+ my $surl = sprintf '%s?s=%s&o=%s', $url, $d{order}[0], $d{order}[1];
+]]
+[[= pagebut($surl) ]]-
+
+
+ Title [[= sortbut($url, 'title') ]]
+ Vote [[= sortbut($url, 'vote') ]]
+ Date [[= sortbut($url, 'date') ]]
+
+ [[ for (@{$d{votes}}) { ]]-
+
+ [[: $_->{title} ]]
+ [[: $_->{vote} ]]
+ [[= formatdate('%Y-%m-%d', $_->{date}, 'dh') ]]
+
+ [[ } ]]-
+
+-[[= pagebut($surl) ]]
+[[ } ]]
diff --git a/data/tpl/page b/data/tpl/page
new file mode 100644
index 00000000..e6ce9e99
--- /dev/null
+++ b/data/tpl/page
@@ -0,0 +1,140 @@
+
+ [[: $p{PageTitle} ]]- :: VNDB
+
+
+[[ if($p{redit} || $p{vnedit}) { ]]-
+
+[[ } ]]-
+
+[[ if($p{devshit}) { ]]-
+
+[[ } elsif($p{userlist} || $p{userpage} || $p{myvotes} || $p{vnlist} || $p{hist} || ($p{vnpage} && $p{vnpage}{page} eq 'stats')
+ || grep { $p{$_} && $p{$_}{change} } qw|vnpage ppage rpage|) { ]]-
+
+[[ }]]-
+
+[[if($p{hist}){ ]]
+
+[[ } ]]-
+
+
+
+
+
+
+
+
+
+[[ # = noindex-tag (see above) ]]
+[[ if($p{home}) { %d = %{$p{home}}; ]] [[+ home ]][[ } ]]
+[[ if($p{faq}) { %d = %{$p{faq}}; ]] [[+ faq ]][[ } ]]
+[[ if($p{userlogin}) { %d = %{$p{userlogin}}; ]] [[+ userlogin ]][[ } ]]
+[[ if($p{userreg}) { %d = %{$p{userreg}}; ]] [[+ userreg ]][[ } ]]
+[[ if($p{userpass}) { %d = %{$p{userpass}}; ]] [[+ userpass ]][[ } ]]
+[[ if($p{useredit}) { %d = %{$p{useredit}}; ]] [[+ useredit ]][[ } ]]
+[[ if($p{userlist}) { %d = %{$p{userlist}}; ]] [[+ userlist ]][[ }# ]]
+[[ if($p{userpage}) { %d = %{$p{userpage}}; ]] [[+ userpage ]][[ }# ]]
+[[ if($p{vnpage}) { %d = %{$p{vnpage}}; ]] [[+ vnpage ]][[ } ]]
+[[ if($p{vnedit}) { %d = %{$p{vnedit}}; ]] [[+ vnedit ]][[ } ]]
+[[ if($p{redit}) { %d = %{$p{redit}}; ]] [[+ redit ]][[ } ]]
+[[ if($p{vnbrowse}) { %d = %{$p{vnbrowse}}; ]] [[+ vnbrowse ]][[ } ]]
+[[ if($p{pbrowse}) { %d = %{$p{pbrowse}}; ]] [[+ pbrowse ]][[ } ]]
+[[ if($p{pedit}) { %d = %{$p{pedit}}; ]] [[+ pedit ]][[ } ]]
+[[ if($p{ppage}) { %d = %{$p{ppage}}; ]] [[+ ppage ]][[ } ]]
+[[ if($p{myvotes}) { %d = %{$p{myvotes}}; ]] [[+ myvotes ]][[ }# ]]
+[[ if($p{vnlist}) { %d = %{$p{vnlist}}; ]] [[+ vnlist ]][[ }# ]]
+[[ if($p{hist}) { %d = %{$p{hist}}; ]] [[+ hist ]][[ }# ]]
+[[ if($p{rpage}) { %d = %{$p{rpage}}; ]] [[+ rpage ]][[ } ]]
+[[ if($p{docs}) { %d = %{$p{docs}}; ]] [[+ docs ]][[ } ]]
+
+
+
+
+
+
Menu
+
+
+-[[ if(!$p{AuthLoggedin}) { ]]-
+
Login
+
+
+ register or forgot password?
+
+[[ } else { ]]-
+
User menu
+
+[[ } ]]-
+
+-[[ #
]]
+
Statistics
+
+ [[= $p{Statvn}||0 ]] visual novels
+ [[= $p{Statproducers}||0 ]] producers
+ [[= $p{Statreleases}||0 ]] releases
+ [[= $p{Statvotes}||0 ]] votes
+ [[= $p{Statusers}||0 ]] users
+
+[[ if(0) { ]]
Most popular
+
[[ } ]]-
+
+
+
+
+
+
+-[[ if(0 && $p{devshit}) { ]]-
+ SQL Queries used:
+[[= $p{devshit} ]]
+
+[[ } ]]-
+
+
diff --git a/data/tpl/pbrowse b/data/tpl/pbrowse
new file mode 100644
index 00000000..71b40c82
--- /dev/null
+++ b/data/tpl/pbrowse
@@ -0,0 +1,45 @@
+[[: $p{PageTitle} ]]
+
+ -[[= $d{chr} ne 'all' ? 'all ' : 'all' ]]- |
+ [[ for('a'..'z', 0) { ]]-
+ -[[ if($d{chr} eq $_) { ]][[= $_?$_:'#' ]][[ } else { ]][[= $_?$_:'#' ]] [[ } ]]
+ [[ } ]]-
+
+
+
+-[[ if($#{$d{prods}} < 0) { ]]
+
+ No results again, life sucks... :'(
+
+[[ } else {
+ my $url = sprintf '/p/%s', $d{chr};
+ $url .= '?q='.$d{query} if $d{query};
+]]
+[[= pagebut($url) ]]
+
+[[= pagebut($url) ]]
+[[ } ]]
diff --git a/data/tpl/pedit b/data/tpl/pedit
new file mode 100644
index 00000000..6ef398cf
--- /dev/null
+++ b/data/tpl/pedit
@@ -0,0 +1,45 @@
+[[= $d{id} ? ttabs('p', $d{prod}, 'edit') : '' ]]
+[[: $p{PageTitle} ]]
+-[[ if(!$d{id}) { ]]
+
+ Please search the database before adding a new producer in order to prevent duplicate entries.
+
+[[ } else { ]]
+
+ It is currently not possible to delete producers from the database, please
+ use the forums to request
+ a deletion. Also refer to the forums for more serious edits or discussions about changes.
+
+[[ } if($d{id} && $d{prod}{cid} != $d{prod}{latest}) { ]]
+
+ You are editing an old revision of this producer. If you save it, all changes made after
+ -[[= formatdate('%Y-%m-%d %R', $d{prod}{added}) ]]- will be removed!
+
+[[ } ]]
+
+-[[= cform([
+ { type => 'error' },
+ { type => 'startform', action => $d{id} ? '/p'.$d{id}.'/edit' : '/p/add' },
+
+ { type => 'sub', title => 'General info', short => 'info' },
+ { type => 'select', name => 'Type', short => 'type', r=>1, options => [ map {
+ { short => $_, name => $VNDB::PROT->{$_} } } sort keys %$VNDB::PROT ] },
+ { type => 'input', name => 'Name (romaji)', short => 'name', r=>1 },
+ { type => 'input', name => 'Original name', short => 'original' },
+ { type => 'static', text => q|
+ The original name of the producer, leave blank if it is already in the Latin alphabet. | },
+
+ { type => 'select', name => 'Primary language', short => 'lang', r=>1, options => [ map {
+ ({ short => $_, name => sprintf '%s (%s)', $_, $VNDB::LANG->{$_} }) } sort keys %{$VNDB::LANG} ] },
+
+ { type => 'input', name => 'Website', short => 'website' },
+ { type => 'textarea', name => 'Description', short => 'desc', rows => 7, cols => 60 },
+
+ { type => 'sub', title => 'Edit summary', short => 'com' },
+ { type => 'textarea', name => 'Edit summary', short => 'comm', rows => 3, cols => 60 },
+ { type => 'static', text => 'Please motivate your modifications and cite all sources.' },
+
+ { type => 'submit', text => $d{id} ? 'Edit' : 'Add' },
+ { type => 'endform' },
+
+], $d{form}) ]]
diff --git a/data/tpl/ppage b/data/tpl/ppage
new file mode 100644
index 00000000..e829682a
--- /dev/null
+++ b/data/tpl/ppage
@@ -0,0 +1,58 @@
+[[= ttabs('p', $d{prod}) ]]
+[[: $p{PageTitle} ]]
+
+[[ if($d{prod}{hidden}) { ]]-
+
+ This item has been deleted from the database. File a request on the
+ forums
+ to undelete this page.
+
+[[ } ]]
+[[ if(!$d{prod}{hidden} || $p{Authdel}) { ]]-
+
+
+
+[[ if($d{change}) { ]]
+[[= cdiff($d{prev}, $d{prod},
+ [ type => 'Type', sub { $VNDB::PROT->{$_[0]} } ],
+ [ name => 'Name (romaji)', 1 ],
+ [ original => 'Original name', 1 ],
+ [ lang => 'Language', sub { $VNDB::LANG->{$_[0]} } ],
+ [ website => 'Website', 1 ],
+ [ desc => 'Description', 1, 1 ],
+ ) ]]
+[[ } ]]
+
+
+ Name [[ if($d{prod}{original}) { ]]
+ [[: $d{prod}{original} ]]- ([[: $d{prod}{name} ]])
+ [[ } else { ]][[: $d{prod}{name} ]][[ } ]]
+ Type [[: $VNDB::PROT->{$d{prod}{type}} ]]
+ Primary lang. [[: $VNDB::LANG->{$d{prod}{lang}} ]]
+[[ if($d{prod}{website}) { ]]-
+ Links Official homepage [[ } ]]-
+
+
+-[[ if($d{prod}{desc}) { ]]
+[[= summary($d{prod}{desc}) ]]
+[[ } ]]
+
+
+Visual novel relations
+[[ if($#{$d{vn}} < 0) { ]]-
+
+ We have currently no visual novels related to this producer.
+
+[[ } else { ]]-
+
+ [[ for (@{$d{vn}}) { ]]-
+ [[: $_->{title} ]]
+ [[ if($_->{date} ne "0000-00-00") { ]]- ([[= datestr($_->{date}) ]])[[ } ]]
+
+ [[ } ]]-
+
+[[ } ]]
+
+
+
+[[ } ]]
diff --git a/data/tpl/redit b/data/tpl/redit
new file mode 100644
index 00000000..0e83b670
--- /dev/null
+++ b/data/tpl/redit
@@ -0,0 +1,70 @@
+[[= $d{id} ? ttabs('r', $d{rel}, 'edit') : ttabs('v', $d{vn}, 'edit') ]]-
+[[: $p{PageTitle} ]]
+
+[[ if($d{id}) { ]]
+
+ It is currently not possible to delete releases from the database, please
+ use the forums to request
+ a deletion. Also refer to the forums for more serious edits or discussions about changes.
+
+[[ } if($d{id} && $d{rel}{cid} != $d{rel}{latest}) { ]]
+
+ You are editing an old revision of this producer. If you save it, all changes made after
+ -[[= formatdate('%Y-%m-%d %R', $d{rel}{added}) ]]- will be removed!
+
+[[ } ]]
+
+[[= cform( [
+ { type => 'error' },
+ { type => 'startform', action => $d{id} ? sprintf('/r%d/edit', $d{rel}{id}) : '/v'.$d{vn}{id}.'/add', fh => 1 },
+
+ { type => 'sub', title => 'General info', short => 'info' },
+ { type => 'select', name => 'Type', short => 'type', r=>1, options => [ map {
+ ({ short => $_, name => $VNDB::RTYP->[$_] }) } 0..$#{$VNDB::RTYP} ] },
+
+ { type => 'input', name => 'Title (romaji)', short => 'title', r=>1 },
+ { type => 'input', name => 'Original title', short => 'original' },
+ { type => 'static', text => q|
+ The original title of this release, leave blank if it already is in the Latin alphabet. | },
+
+ { type => 'select', name => 'Language', short => 'language', r=>1, options => [ map {
+ ({ short => $_, name => sprintf '%s (%s)', $_, $VNDB::LANG->{$_} }) } sort keys %{$VNDB::LANG} ] },
+
+ { type => 'input', name => 'Official website', short => 'website' },
+ { type => 'date', name => 'Release date', short => 'released' },
+ { type => 'static', text => 'Leave month or day blank if they are unknown ' },
+ { type => 'select', name => 'Age rating', short => 'minage', options => [ map
+ { { name => $VNDB::VRAGES->{$_}, short => $_ } } sort { $a <=> $b } keys %$VNDB::VRAGES ] },
+ { type => 'textarea', name => 'Notes', short => 'notes', rows => 3, cols => 50 },
+ { type => 'static', text => 'Miscellaneous notes/comments, information that does not fit in the above fields. E.g.: Censored/uncensored or for which releases this patch applies. Max. 250 characters.' },
+
+ { type => 'sub', title => 'Platforms & Media', short => 'pnm' },
+ { type => 'static', raw => 1, text => 'Platforms ' },
+
+ { type => 'static', text => ' ' },
+ { type => 'jssel', name => 'Media', sh => 'md', short => 'media' },
+
+ { type => 'sub', title => 'Producers', short => 'prod' },
+ { type => 'jssel', name => 'Producers', sh => 'pd', short => 'producers' },
+
+ { type => 'sub', title => 'Visual novel relations', short => 'rel'},
+ { type => 'jssel', name => 'Relations', sh => 'vn', short => 'vn', r=>1 },
+ { type => 'static', text => q|
+ Although a release usually contains only one visual novel, it is also possible
+ for one release to include several games. Use this field to specify which
+ visual novels are included in this release.| },
+
+
+ { type => 'sub', title => 'Edit summary', short => 'com' },
+ { type => 'textarea', name => 'Edit summary', short => 'comm', rows => 3, cols => 60 },
+ { type => 'static', text => 'Please motivate your modifications and cite all sources.' },
+
+ { type => 'submit', text => $d{id} ? 'Edit' : 'Add' },
+ { type => 'endform' },
+
+], $d{form}) ]]
diff --git a/data/tpl/rpage b/data/tpl/rpage
new file mode 100644
index 00000000..7ad3c4ea
--- /dev/null
+++ b/data/tpl/rpage
@@ -0,0 +1,61 @@
+[[= ttabs('r', $d{rel}) ]]
+[[: $p{PageTitle} ]]
+
+[[ if($d{rel}{hidden}) { ]]-
+
+ This item has been deleted from the database. File a request on the
+ forums
+ to undelete this page.
+
+[[ } ]]
+[[ if(!$d{rel}{hidden} || $p{Authdel}) { ]]-
+
+
+
+[[ if($d{change}) { ]]
+[[= cdiff($d{prev}, $d{rel},
+ [ vn => 'Relations', sub { join(" \n", map { $_->{title} } @{$_[0]}) } ],
+ [ type => 'Type', sub { $VNDB::RTYP->[$_[0] ] } ],
+ [ title => 'Title', 1 ],
+ [ original => 'Orig. title', 1 ],
+ [ language => 'Language', sub { $VNDB::LANG->{$_[0]} } ],
+ [ website => 'Website', \&summary ],
+ [ released => 'Release date', \&datestr ],
+ [ minage => 'Age rating', sub { $VNDB::VRAGES->{$_[0]} } ],
+ [ notes => 'Notes', 1 ],
+ [ platforms => 'Platforms', sub { join(', ', sort @{$_[0]}) } ],
+ [ media => 'Media', \&mediastr ],
+ [ producers => 'Producers', sub { join(', ', map { _hchar($_->{name}) } sort { $a->{name} cmp $b->{name} } @{$_[0]}) } ],
+ ) ]]
+[[ } ]]
+
+
+ Relation [[= join(' ', map { ''._hchar($_->{title}).' ' } @{$d{rel}{vn}}) ]]
+ Type [[: $VNDB::RTYP->[$d{rel}{type}] ]]
+ Title [[: $d{rel}{title} ]]
+[[ if($d{rel}{original}) { ]]-
+ Original Title [[: $d{rel}{original} ]] [[ } ]]-
+ Language [[: $VNDB::LANG->{$d{rel}{language}} ]]
+ Release date [[= datestr($d{rel}{released}) ]]
+[[ if($d{rel}{minage} >= 0) { ]]-
+ Age rating [[: $VNDB::VRAGES->{$d{rel}{minage}} ]] [[ } ]]-
+[[ if($#{$d{rel}{producers}} >= 0) { ]]-
+ Producer[[: $#{$d{rel}{producers}} > 0 ? 's' : '' ]] [[= join(', ', map {
+ sprintf('%s ', $_->{id}, _hchar($_->{name})) } @{$d{rel}{producers}})
+ ]] [[ } ]]-
+[[ if($#{$d{rel}{platforms}} >= 0) { ]]-
+ Platform[[: $#{$d{rel}{platforms}} > 0 ? 's' : '' ]] [[: join(', ', map {
+ $VNDB::PLAT->{$_} } @{$d{rel}{platforms}}) ]] [[ } ]]-
+[[ if($#{$d{rel}{media}} >= 0) { ]]-
+ Medi[[: $#{$d{rel}{media}} > 0 ? 'a' : 'um' ]] [[: mediastr($d{rel}{media}) ]] [[ } ]]-
+[[ if($d{rel}{website}) { ]]-
+ Links Official website [[ } ]]-
+
+
+[[ if($d{rel}{notes}) { ]]-
+[[= summary($d{rel}{notes}) ]]
+[[ } ]]-
+
+
+
+[[ } ]]
diff --git a/data/tpl/useredit b/data/tpl/useredit
new file mode 100644
index 00000000..f470ce0a
--- /dev/null
+++ b/data/tpl/useredit
@@ -0,0 +1,34 @@
+[[: $p{PageTitle} ]]
+
+-[[ if($d{done}) { ]]
+
+ Settings succesfully saved.
+
+[[ } ]]
+-[[= cform( [
+ { type => 'error' },
+ { type => 'startform', action => '/u'.$d{user}.'/edit' },
+
+ { type => 'sub', title => 'General info', short => 'info' },
+ { type => 'static', name => 'Username', text => _hchar($d{form}{username}) },
+ { type => 'input', name => 'Email', short => 'mail' },
+
+ { type => 'sub', title => 'Change password', short => 'pass' },
+ { type => 'static', text => 'Leave blank to keep your current password.' },
+ { type => 'pass', name => 'Password', short => 'pass1' },
+ { type => 'pass', name => 'Confirm', short => 'pass2' },
+
+ { type => 'sub', title => 'Miscellaneous options', short => 'misc' },
+ { type => 'check', short => 'pvotes', name => sprintf 'Allow other people to see my votes (/u%1$d/votes )', $d{user} },
+ { type => 'check', short => 'plist', name => sprintf 'Allow other people to see my visual novel list (/u%1$d/list )', $d{user} },
+ { type => 'check', short => 'pign_nsfw', name => 'Disable warnings for images that are not safe for work.' },
+
+ $d{adm} ? (
+ { type => 'sub', title => 'Admin', short => 'adm' },
+ { type => 'select', name => 'Rank', short => 'rank', options => [
+ map { { name => $VNDB::VNDBopts{ranks}[0][0][$_], short => $_ } } 1..($#{$VNDB::VNDBopts{ranks}}-1) ] },
+ ) : (),
+
+ { type => 'submit', text => 'Save' },
+ { type => 'endform' },
+], $d{form}) ]]
diff --git a/data/tpl/userlist b/data/tpl/userlist
new file mode 100644
index 00000000..4fcb12c7
--- /dev/null
+++ b/data/tpl/userlist
@@ -0,0 +1,54 @@
+[[: $p{PageTitle} ]]
+
+ -[[= $d{chr} ne 'all' ? 'all ' : 'all' ]]- |
+ [[ for('a'..'z', 0) { ]]-
+ -[[ if($d{chr} eq $_) { ]][[= $_?$_:'#' ]][[ } else { ]][[= $_?$_:'#' ]] [[ } ]]
+ [[ } ]]-
+
+
+
+[[ if($#{$d{users}} < 0) { ]]-
+
+ No users found...
+
+[[ } else {
+ my $url = sprintf '/u/list/%s', $d{chr};
+ my $surl = sprintf '%s?s=%s&o=%s', $url, $d{order}[0], $d{order}[1];
+]]
+[[= pagebut($surl) ]]-
+
+
+ Username [[= sortbut($url, 'username') ]]
+[[ if($p{Authuserlist}) { ]]-
+ Mail [[= sortbut($url, 'mail') ]]
+ Rank [[= sortbut($url, 'rank') ]] [[ } ]]-
+ Registered [[= sortbut($url, 'registered') ]]
+ VN list
+ Votes
+ Changes
+[[ if($p{Authuseredit}) { ]]-
+ [[ } ]]-
+
+ [[ for (@{$d{users}}) { ]]-
+
+ [[: $_->{username} ]]
+[[ if($p{Authuserlist}) { ]]-
+ [[: $_->{mail} ]]
+ [[: $VNDB::VNDBopts{ranks}[0][0][$_->{rank}] ]] [[ } ]]-
+ [[= formatdate('%Y-%m-%d', $_->{registered}, 'wd') ]]
+ [[ if($_->{flags} & $VNDB::UFLAGS->{list} && $_->{vnlist}) { ]]
+ [[= $_->{vnlist} ]]
+ [[ } else { ]][[= $_->{flags} & $VNDB::UFLAGS->{list} ? 0 : '-' ]][[ } ]]
+ [[ if($_->{flags} & $VNDB::UFLAGS->{votes} && $_->{votes}) { ]]
+ [[= $_->{votes} ]]
+ [[ } else { ]][[= $_->{flags} & $VNDB::UFLAGS->{votes} ? 0 : '-' ]][[ } ]]
+ [[ if($_->{changes}) { ]]
+ [[= $_->{changes} ]]
+ [[ } else { ]]0[[ } ]]
+[[ if($p{Authuseredit}) { ]]-
+ ( edit ) [[ } ]]-
+
+ [[ } ]]-
+
+-[[= pagebut($surl) ]]-
+[[ } ]]
diff --git a/data/tpl/userlogin b/data/tpl/userlogin
new file mode 100644
index 00000000..b4af29d2
--- /dev/null
+++ b/data/tpl/userlogin
@@ -0,0 +1,14 @@
+[[: $p{PageTitle} ]]
+-[[= cform( [
+ { type => 'error' },
+ { type => 'startform', action => '/u/login' },
+ { type => 'input', short => 'username', name => 'Username' },
+ { type => 'pass', short => 'userpass', name => 'Password' },
+ { type => 'submit', text => 'Login!' },
+ { type => 'endform' },
+], $d{log}) ]]-
+
+
+
+ No account yet , or forgot your username or password?
+
diff --git a/data/tpl/userpage b/data/tpl/userpage
new file mode 100644
index 00000000..9b14efc9
--- /dev/null
+++ b/data/tpl/userpage
@@ -0,0 +1,13 @@
+[[
+ ($d{pv}, $d{pl}) = ($d{user}{flags} & $VNDB::UFLAGS->{votes}, $d{user}{flags} & $VNDB::UFLAGS->{list});
+]]
+[[: $p{PageTitle} ]]
+
+ Username [[: $d{user}{username} ]]- (u[[= $d{user}{id} ]] )
+ Registered [[= formatdate('%Y-%m-%d', $d{user}{registered}) ]]
+ Votes [[= $d{pv} ? $d{user}{votes}.' (view all )' : '(hidden)' ]]
+ VN List [[= $d{pl} ? $d{user}{vnlist}.' (view all )' : '(hidden)' ]]
+ Changes [[= $d{user}{changes}.($d{user}{changes}>0?' (recent changes )':'') ]]
+
+
+[[= T_vnpage_stats($X) ]]
diff --git a/data/tpl/userpass b/data/tpl/userpass
new file mode 100644
index 00000000..c3b04840
--- /dev/null
+++ b/data/tpl/userpass
@@ -0,0 +1,21 @@
+[[: $p{PageTitle} ]]
+
+ You're lucky that vndb has a very advanced password recovery tool! Just
+ type your email address (the same one you used for your account), and
+ wait for an email!
+
+
+-[[ if(!$d{done}) { ]]
+[[= cform( [
+ { type => 'error', },
+ { type => 'startform', action => '/u/newpass' },
+ { type => 'input', short => 'mail', name => 'Email' },
+ { type => 'submit', text => 'Gimme my password!' },
+ { type => 'endform' },
+], $d{pas} ) ]]
+
+[[ } else { ]]
+
+ Your password succesfully been reset. Check your mail for instructions.
+
+[[ } ]]
diff --git a/data/tpl/userreg b/data/tpl/userreg
new file mode 100644
index 00000000..68565470
--- /dev/null
+++ b/data/tpl/userreg
@@ -0,0 +1,38 @@
+[[: $p{PageTitle} ]]
+
+-[[ if($d{denied}) { ]]
+[[ } ]]-
+
+
+Why should I register?
+
+ Registered users have access to special features on this site:
+
+
+ You can keep track of the visual novels you'd like to play or have
+ finnished playing,
+ Vote on visual novels,
+ And more importantly: you can add and edit all information on the
+ website!
+
+
+
+ And of course, registering an account is (and will always remain)
+ completely free!
+
+
+
+-[[= cform( [
+ { type => 'error' },
+ { type => 'startform', action => '/u/register' },
+ { type => 'input', short => 'username', name => 'Username' },
+ { type => 'input', short => 'mail', name => 'Email' },
+ { type => 'static', text => q|
+ Your email address will only be used in case you lose your password, at least for now.
+ We will never send spam or newsletters unless you explicitly ask us for it.
+ | },
+ { type => 'pass', short => 'pass1', name => 'Password' },
+ { type => 'pass', short => 'pass2', name => 'Confirm pass.' },
+ { type => 'submit', text => 'Register!' },
+ { type => 'endform' },
+], $d{reg}) ]]
diff --git a/data/tpl/vnbrowse b/data/tpl/vnbrowse
new file mode 100644
index 00000000..79dd122e
--- /dev/null
+++ b/data/tpl/vnbrowse
@@ -0,0 +1,87 @@
+[[: $p{PageTitle} ]]
+
+[[ if($d{chr} eq 'cat') { ]]-
+
+[[ for my $c (qw| e g p t l s |) { ]]-
+ -[[= $c ne 'l' && $c ne 'p' ? '' : ' ' ]][[: $VNDB::CAT->{$c}[0] ]]-
+
+ [[ for (sort keys %{$VNDB::CAT->{$c}[1]}) { ]]-
+
+ [[: $VNDB::CAT->{$c}[1]{$_} ]]- ([[= $d{cat}{$c.$_} || 0 ]])
+ [[ } ]]
+ [[= $c ne 't' && $c ne 'g' ? ' ' : '' ]]-
+[[ } ]]-
+
+
+ Languages (none selected means all)
+[[ for (sort keys %{$d{lang}}) { next if !$d{lang}{$_}; ]]-
+
+ [[: $VNDB::LANG->{$_} ]]- ([[= $d{lang}{$_} ]])
+[[ } ]]-
+
+
+
+
+
+
+
+[[ } elsif($d{chr} ne 'search') { ]]-
+
+ -[[= $d{chr} ne 'all' ? 'all ' : 'all' ]]- |
+ [[ for('a'..'z', 0) { ]]-
+ -[[ if($d{chr} eq $_) { ]][[= $_?$_:'#' ]][[ } else { ]][[= $_?$_:'#' ]] [[ } ]]
+ [[ } ]]-
+
+
+[[ } ]]-
+
+-[[ if($#{$d{vn}} < 0) { ]]
+
+ -[[ if($d{chr} eq 'cat' && !$d{scat}[0][0] && !$d{scat}[0][1]) { ]]
+ Select some categories and hit the "Search" button to get a list of visual novels. Click on a
+ category again to exclude it.
+ Please keep in mind that not all visual novels have the correct categories set, so you
+ may not always find what you are looking for.
+ [[ } else { ]]
+ No results again, life sucks... :'(
+ [[ } ]]-
+
+[[ } else {
+ my %url = (
+ $p{searchquery} ? ( q => $p{searchquery} ) : (),
+ $d{incl} ? ( i => $d{incl} ) : (),
+ $d{excl} ? ( e => $d{excl} ) : (),
+ $d{slang} ? ( l => $d{slang} ) : (),
+ );
+ my %urls = ( %url,
+ $d{order}[0] ne 'title' ? ( s => $d{order}[0] ) : (),
+ $d{order}[1] ne 'a' ? ( o => $d{order}[1] ) : (),
+ );
+ my $url = sprintf '/v/%s', $d{chr};
+ my $urls = $url;
+ $urls .= '?'.join(';', map { $_.'='.$urls{$_} } keys %urls) if keys %urls;
+ $url .= '?'.join(';', map { $_.'='.$url{$_} } keys %url) if keys %url;
+]]
+
+[[= pagebut($urls) ]]
+
+
+ Title [[= sortbut($url, 'title') ]]
+ Released [[= sortbut($url, 'released') ]]
+ Languages
+ Rating [[= sortbut($url, 'votes') ]]
+
+ [[ for (@{$d{vn}}) {
+ $_->{c_votes} =~ s#^([0-9]{2}.[0-9]{2})\|([0-9]{4})$#$1 == 0 ? sprintf '- (%d)', $2 : sprintf '%.2f (%d)', $1, $2#e;
+ $_->{c_released} =~ s#^([0-9]{4})([0-9]{2}).+#$1==0?'N/A':$1==9999?'TBA':(($2&&$2>0?($Time::CTime::MoY[$2-1].' '):'').$1)#e;
+ ]]-
+
+ [[: $_->{title} ]]
+ [[: $_->{c_released} ]]
+ [[: $_->{c_languages} || 'N/A' ]]
+ [[: $_->{c_votes} ]]
+
+ [[ } ]]-
+
+[[= pagebut($urls) ]]
+[[ } ]]
diff --git a/data/tpl/vnedit b/data/tpl/vnedit
new file mode 100644
index 00000000..f3ae245c
--- /dev/null
+++ b/data/tpl/vnedit
@@ -0,0 +1,94 @@
+[[= $d{id} ? ttabs('v', $d{vn}, 'edit') : '' ]]-
+[[: $p{PageTitle} ]]
+
+[[ if(!$d{id}) { ]]
+ Please search the database before adding a new visual novel
+ in order to prevent duplicate entries.
+[[ } else { ]]
+
+ It is currently not possible to delete visual novels from the database, please
+ use the forums to request
+ a deletion. Also refer to the forums for more serious edits or discussions about changes.
+
+[[ } if($d{id} && $d{vn}{cid} != $d{vn}{latest}) { ]]
+
+ You are editing an old revision of this producer. If you save it, all changes made after
+ -[[= formatdate('%Y-%m-%d %R', $d{vn}{added}) ]]- will be removed!
+
+[[ } ]]
+
+
+-[[= cform([
+ { type => 'error' },
+ { type => 'startform', action => $d{id} ?( '/v'.$d{id}.'/edit') : '/v/new', upload => 1, fh => 1 },
+
+ { type => 'sub', title => 'General info', short => 'info' },
+ { type => 'input', name => 'Title', short => 'title', r=>1 },
+ { type => 'static', text => q|
+ Use official English title if available, use the romanized version of the official title otherwise.
+ Other titles can be added at a later time when specifying releases. | },
+
+ { type => 'textarea', name => 'Aliases', short => 'alias', rows => 2, cols => 60 },
+ { type => 'static', text => q|
+ Comma seperated list of alternative titles or abbreviations. Can include both official
+ (japanese/english) titles and unofficial titles used around net. Titles that are listed in the releases do not have to be added here. | },
+
+ { type => 'textarea', name => 'Description', short => 'desc', rows => 7, cols => 70, r=>1 },
+ { type => 'static', text => q|
+ 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. ([url] BBCode tag is allowed) | },
+
+ { type => 'select', name => 'Length', short => 'length', class => 'longopts', options => [ map {
+ { short => $_,
+ name => !$_?$VNDB::VNLEN->[$_][0]:($VNDB::VNLEN->[$_][0].', '.$VNDB::VNLEN->[$_][1].' ('.$VNDB::VNLEN->[$_][2].')') } } 0..$#$VNDB::VNLEN
+ ] },
+ { type => 'static', text => ' ' },
+ { type => 'input', name => 'External links', short => 'l_wp', pre => 'http://en.wikipedia.org/wiki/' },
+ { type => 'input', name => ' ', short => 'l_vnn', pre => 'http://visual-novels.net/vn/index.php?option=com_content&task=view&id=', class => 'shortopts' },
+ { type => 'input', name => ' ', short => 'l_cisv', pre => 'http://cisvisual.net/title/', class => 'shortopts' },
+
+ { type => 'sub', title => 'Categories', short => 'cat' },
+ { type => 'hidden', short => 'categories' },
+ { type => 'static', raw => 1, text => eval {
+ my $r = '';
+ for my $c (qw| e g p t l s |) {
+ $r .= ($c ne 'l' && $c ne 'p' ? '' : ' ').$VNDB::CAT->{$c}[0].'';
+ for (sort keys %{$VNDB::CAT->{$c}[1]}) {
+ $r .= sprintf '- %2$s ',
+ $c.$_, $VNDB::CAT->{$c}[1]{$_};
+ }
+ $r .= ' '.($c ne 't' && $c ne 'g' ? ' ' : '');
+ }
+ $r.' ';
+ } },
+
+ { type => 'sub', title => 'Image', short => 'img' },
+ $d{id} ? (
+ { type => 'static', text => $d{vn}{image} ?
+ sprintf ' ', $p{st}, $d{vn}{image}%50, $d{vn}{image} :
+ 'No image uploaded yet...' },
+ ) : (),
+ { type => 'upload', name => $d{vn}{image} ? 'Change' : 'Upload', short => 'img' },
+ { type => 'static', text => q|
+ Preferably the cover of the CD/DVD/package. Image must be in JPEG format and at most 256x400px and 50KB. | },
+ { type => 'check', short => 'img_nsfw', name => 'NSFW. Please check this option if the image contains nudity, gore, or is otherwise not safe in a work-friendly environment.' },
+
+ { type => 'sub', title => 'Visual novel relations', short => 'rel' },
+ { type => 'jssel', name => 'Relations', short => 'relations', sh => 'rl' },
+ { type => 'static', text => q|
+ Direct relations: Please only add direct relations. E.g. the sequel of a sequel does not have to be listed
+ here because it's already listed on an other visual novel that is in turn listed here. VNDB will handle these
+ relations automatically.
+ Reverse relations: If you add a relation with an other visual novel here, the same (or "reverse") relation
+ will automatically be added to the other visual novel. For example: if you add Tsukihime as a prequel of Kagetsu Tohya,
+ Kagetsu Tohya will automatically be added as a sequel for Tsukihime.
+ |},
+
+ { type => 'sub', title => 'Edit summary', short => 'com' },
+ { type => 'textarea', name => 'Edit summary', short => 'comm', rows => 3, cols => 60 },
+ { type => 'static', text => 'Please motivate your modifications and cite all sources.' },
+
+ { type => 'submit', text => $d{id} ? 'Edit' : 'Add' },
+ { type => 'endform' },
+
+], $d{form}) ]]
diff --git a/data/tpl/vnlist b/data/tpl/vnlist
new file mode 100644
index 00000000..64db1c05
--- /dev/null
+++ b/data/tpl/vnlist
@@ -0,0 +1,74 @@
+[[: $p{PageTitle} ]]
+[[
+ my $url = sprintf '/u%d/list', $d{user}{id};
+ my $surl = sprintf '%s?s=%s;o=%s', $url, $d{order}[0], $d{order}[1];
+ my $purl = $surl . ';t='.$d{status};
+ my $sourl = $url . '?t='.$d{status};
+ my $furl = $purl . ';p='.$d{page};
+]]
+
+ status: -[[ for (-1..$#$VNDB::LSTAT) { if($_ >= 0) { ]]- | -[[ }
+ if($d{status} == $_) { ]][[= $_ eq -1 ? 'all' : lc $VNDB::LSTAT->[$_] ]] [[ }
+ else { ]][[= $_ eq -1 ? 'all' : lc $VNDB::LSTAT->[$_] ]] [[ } } ]]
+
+
+
+
+[[ if($#{$d{list}} < 0) { ]]-
+
+[[ if($d{status} >= 0) { ]]
+ No results found...
+[[ } elsif($d{user}{username} eq $p{AuthUsername}) { ]]
+ Your visual novel list is empty. You can keep track of all the visual novels
+ you'd like to play, you're currently playing, or you've finished. Just go to
+ a visual novel page and add it to your VN list!
+[[ } else { ]]
+ [[: $d{user}{username} ]]'s visual novel list is empty...
+[[ } ]]
+
+
+[[ } else { ]]
+[[= pagebut($purl) ]]-
+[[ if($d{user}{username} eq $p{AuthUsername}) { ]]
+[[ } ]]
+-[[= pagebut($purl) ]]
+[[ } ]]-
+
+[[ if($d{user}{username} eq $p{AuthUsername}) { ]]-
+
+
+ NOTE: Your personal notes are only visible to you, other people can't see them.
+
[[ } ]]
diff --git a/data/tpl/vnpage b/data/tpl/vnpage
new file mode 100644
index 00000000..15cb3235
--- /dev/null
+++ b/data/tpl/vnpage
@@ -0,0 +1,171 @@
+[[= ttabs('v', $d{vn}) ]]
+[[: $d{vn}{title} ]]
+
+[[ if($d{vn}{hidden}) { ]]-
+
+ This item has been deleted from the database. File a request on the
+ forums
+ to undelete this page.
+
+[[ } ]]
+[[ if(!$d{vn}{hidden} || $p{Authdel}) { ]]-
+
+
+[[ if($d{change}) { ]]
+[[= cdiff($d{prev}, $d{vn},
+ [ title => 'Title', 1 ],
+ [ alias => 'Alias', 1 ],
+ [ desc => 'Description', 1, 1 ],
+ [ length => 'Length', sub { $VNDB::VNLEN->[$_[0] ][0] } ],
+ [ l_wp => 'Wikipedia link', sub { $_[0] ? ''.$_[0].' ' : 'No link' } ],
+ [ l_vnn => 'V-N.net link', sub { $_[0] ? ''.$_[0].' ' : 'No link' } ],
+ [ l_cisv => 'CISVisual link', sub { $_[0] ? ''.$_[0].' ' : 'No link' } ],
+ [ categories => 'Categories', sub { join(' ', map { $VNDB::CAT->{substr($_->[0],0,1)}[1]{substr($_->[0],1,2)}.'('.$_->[1].')' } sort { $a->[0] cmp $b->[0] } @{$_[0]}) || 'No categories selected' }, 1 ],
+ [ relations => 'Relations', sub { join(" \n", map { $VNDB::VREL->[$_->{relation}].': '._hchar($_->{title}) } sort { $a->{id} <=> $b->{id} } @{$_[0]}) } ],
+ [ image => 'Image', sub { $_[0] ? sprintf ' ', $p{st}, $_[0]%50, $_[0] : 'No image'; } ],
+ [ img_nsfw => 'NSFW', sub { $_[0] ? 'Not safe' : 'Safe' } ]
+ ) ]]
+[[ } ]]-
+
+[[
+ my @lang;
+ for (@{$d{rel}}) {
+ my $l = $_->{language};
+ next if grep { $_ eq $l } @lang;
+ push @lang, $l;
+ }
+
+]]
+
+
+
+
+-[[
+ my @lnks = (
+ !$d{page} ? 'description & releases ' : 'description & releases ',
+ $d{page} eq 'stats' ? 'stats ' : 'stats ',
+ $d{vn}{rgraph} ? (
+ $d{page} eq 'rg' ? 'relations ' : 'relations ',
+ ) : (),
+ );
+]]
+- -[[= join(' - ', @lnks) ]]- -
+
+[[ if(!$d{page}) { ]][[+ vnpage_rel ]][[ } ]]
+[[ if($d{page} eq 'stats') { ]][[+ vnpage_stats ]][[ } ]]
+[[ if($d{page} eq 'rg') { ]][[+ vnpage_rg ]][[ } ]]
+
+[[ if($p{AuthLoggedin}) { ]]-
+
+
+
+ [[ if($d{vote}{vid}) { ]]-
+ revoke
+ [[ } for (reverse 1..10) { ]]-
+ [[= $_ ]]
+ [[ } ]]
+
+
+
+
+
+ [[ for (0..$#$VNDB::LSTAT) { ]]-
+
+ [[ } if($d{list}{vid}) { ]]-
+ Remove
+ [[ } ]]-
+
+
+
+[[ } ]]
+
+
+[[ } ]]
diff --git a/data/tpl/vnpage_rel b/data/tpl/vnpage_rel
new file mode 100644
index 00000000..f2570548
--- /dev/null
+++ b/data/tpl/vnpage_rel
@@ -0,0 +1,51 @@
+Description
+
+ [[= summary($d{vn}{desc}) ]]
+
+
+
+
+
+[[
+ my @lang;
+ for (@{$d{rel}}) {
+ my $l = $_->{language};
+ next if grep { $_ eq $l } @lang;
+ push @lang, $l;
+ }
+
+]]
+
+
+Releases
+[[ if((!$d{vn}{locked} && $p{Authedit}) || $p{Authlock}) { ]]- (add release )
[[ } ]]
+[[ if(@{$d{rel}}) { ]]-
+
+[[ for(@lang) { my $l = $_; ]]-
+
+ [[: $VNDB::LANG->{$l} ]]
+
+[[ for (@{$d{rel}}) { next if $l ne $_->{language}; ]]-
+
+ [[= datestr($_->{released}) ]]
+ [[= $_->{minage}<0 ? '' : $VNDB::VRAGES->{$_->{minage}} ]]
+ [[= join('', map { $_ ne 'oth' ? ''.$_.' ' : () } sort @{$_->{platforms}}) ]]
+ [[= lc substr($VNDB::RTYP->[$_->{type}],0,1) ]]
+ [[: shorten $_->{title},60 ]]
+
+ [[ if($_->{website}) { ]]www [[ } ]]
+
+[[ } ]]-
+[[ } ]]-
+
+[[ } else { ]]-
+
+ This game has either not been released yet, or we just don't have information about
+ any releases.
+
+[[ } ]]
+
+
diff --git a/data/tpl/vnpage_rg b/data/tpl/vnpage_rg
new file mode 100644
index 00000000..d988e226
--- /dev/null
+++ b/data/tpl/vnpage_rg
@@ -0,0 +1,11 @@
+Relations
+[[ if(!$d{vn}{rgraph}) { ]]
+
+ Relation graph has not been generated yet...
+
+[[ } else { ]]
+ [[= $d{vn}{rmap} ]]
+
+
+
+[[ } ]]
diff --git a/data/tpl/vnpage_stats b/data/tpl/vnpage_stats
new file mode 100644
index 00000000..dde9aed3
--- /dev/null
+++ b/data/tpl/vnpage_stats
@@ -0,0 +1,68 @@
+
+[[
+ my $max = 1; my $total = 0; my $sum = 0;
+ for (0..$#{$d{votes}{graph}}) {
+ $total += $d{votes}{graph}[$_];
+ $max = $d{votes}{graph}[$_] if $d{votes}{graph}[$_] > $max;
+ $sum += ($_+1) * $d{votes}{graph}[$_];
+ }
+]]
+[[ if(!$d{user} || ($d{pv} && $d{user}{votes})) { ]]-
+Vote graph [[= $total ]]- vote[[= $total==1?'':'s' ]]- total
+ [[= $total ? sprintf(', average: %.1f.', $sum/$total) : '' ]]
+
+[[ for (0..$#{$d{votes}{graph}}) { ]]-
+
+ [[= $_+1 ]]
+
[[= $d{votes}{graph}[$_] ]]
+
+[[ } ]]-
+
+
+[[ if($#{$d{votes}{latest}} >= 0) { ]]
+Recent votes
+
+[[ } } ]]-
+
+-[[ $max = 1; $total = 0;
+ for (@{$d{lists}{graph}}) { $total += $_; $max = $_ if $_ > $max; } ]]
+[[ if(!$d{user} || ($d{pl} && $d{user}{vnlist})) { ]]-
+VN List stats [[= $total ]]- -[[= $d{user}?'visual novel':'user' ]][[= $total==1?'':'s' ]]- total
+
+ [[ for (0..$#$VNDB::LSTAT) { ]]-
+
+ [[= $VNDB::LSTAT->[$_] ]]
+
[[= $d{lists}{graph}[$_] ]]
+
+ [[ } ]]-
+
+
+[[ if($#{$d{lists}{latest}} >= 0) { ]]
+Recent VN list additions
+
+[[ } } ]]-
+
diff --git a/lib/ChangeLog b/lib/ChangeLog
new file mode 100644
index 00000000..eb47140c
--- /dev/null
+++ b/lib/ChangeLog
@@ -0,0 +1,215 @@
+TODO:
+ + Remove all references to an item when it's hidden
+
+1.14 - ?
+ - Removed the ID gap prevention method
+ - Moved static content to static.vndb.org (and rely on lighty for js/css
+ compression)
+ - relation graphs and cover images now get an ID instead of MD5-sum
+ - Added Nintendo Wii to platforms
+ - Added 'hidden' flag, which should now be used instead of the delete option
+
+1.13 - 2008-04-04
+ - Fixed update_prev
+ - Split revision insert queries into a seperate function for code reuse
+ - Fixed wiki links
+ - Fixed search for VN's without releases
+ - Fixed bug with accepting zero-padded VNDB ID's
+ - Fixed bug with V-N.net link getting lost after reverse relation update
+ - Added .xml extension to AJAX requests
+ - Switched to ';' seperator instead of '&' for some URL's (=cleaner)
+ - Added language filter to category browser
+ - Stored release dates as integers and added NOT NULL constraint
+ - Used a newline to seperate multiple relations on a VN page
+ - Multi will get credits for a reverse relation edit
+ - Going to an edit-page without logging in will redirect
+ - Added rankings to the categories
+ - Fixed automated relation graph updates
+ - Added /nospam page
+ - Changed vote treshold to 3
+
+1.12 - 2008-03-09
+ - Color coded diffs
+ - Added noindex on ?ref= pages
+ - Added TBA to release dates
+ - Possibility to change vote without revoking first
+ - Added VN/ADV categories
+ - Replaced the Release summary with Producers on VN pages
+ - Added foreign key constrains
+
+1.11 - 2008-02-29
+ - [bug] Home page layout got screwed up when line wrapping occurs
+ - [bug] Multiple revisions got counted at the category browser
+ - Added GBA platform
+ - Added Gameplay and Plot categories
+ - Added link to V-N.net review
+ - Added vote count to the global statistics in the main menu
+ - [hidden] Added language filter to category browser
+ - Created user pages
+ - Redirect to VN page if someone visits an rX page from google/yahoo
+ - Added link to latest revision in the diff-browser
+ - Renamed "comments" to "Personal note" at VN List
+
+1.10 - 2008-02-09
+ - [bug] Long revision summaries incorrectly chopped
+ - Added GD-ROM and Blu-ray disk to media
+ - Platform icons will be kept in a consistent order
+ - ?rev= pages now show information about the change + diffs + links to
+ previous/next revisions
+ - Removed diff and revert links on history pages
+ - Added rel="nofollow" to edit links
+ - Changed lowest selectable year at releases to 1990
+ - Use Bayesian ratings and added extra char to c_votes
+ - A few small internal DB changes
+ - Allowed [url]-tag in edit summary, and used same function to parse vn/p/r
+ descriptions
+ - Added line wrapping on long words at diff-viewer
+ - VN search matches on release titles again
+ - Added producer search
+ - [bug] Releases in the future don't count as new language
+ - Release dates in the future are now red
+ - multiple vns for releases
+ - Redirect to specific revision after editing
+ - Redirect to the page you were at after logging in
+ - Added "Other" status and "comments" field to VN lists
+
+1.9 - 2008-02-01
+ - Redirect to VN when changing VN List status
+ - [bug] All ages was not automatically selected
+ - [bug] Description field ignored when adding or requesting edit of producer
+ - Rewrote diff calculation
+ - Added wildcard support to URI-mappings
+ - Changed some URI's:
+ /vn/* -> /v/*
+ /u/_* -> /u/*
+ /u/[username] -> /u[uid]
+ - id-gaps for producers and releases are now also filled automatically
+ - Switched producers name and romaji
+ - Added visitor as rank for non-logged in visitors, and losers for banned
+ users
+ - Added history pages & feeds
+ - Removed everything related to "pending changes"
+ - Producers are lockable
+ - Combined DBGetVN and DBGetVNs
+ - Moved code for releases from VN.pm to Releases.pm
+ - Denormalized vn_categories
+ - Added "tabs" to visual novels, releases & producers
+ - Made several changes to the visual novel page layout
+ - Added mass-change/delete option to vnlists
+ - Renamed vnr* to releases*
+ - Fixed relation graphs generator to work with the new DB structure, and to
+ delete graphs for VN's where the relation was deleted
+ - Removed option to hide a user from the userlist
+ - ResDenied will show the regiser-new-account-page
+ - Usernames linkified at history and vn-stats pages
+ - Added noindex tag on pages that include usernames
+ - Swapped title <-> romaji for releases
+ - Removed relation field and added type field for releases
+ - Also allow [url]-bbcode tag for the notes field for releases and producers
+ - [bug] Self-refering vn relations are not possible anymore
+ - Wrote update_vncache as a plpgsql function
+ - Updated homepage layout: added a few lists
+ - Added filters to recent changes pages
+ - Added platform icons to releases
+ - Added user menu to vn pages
+ - De-JS'ed the platform select form, used checkboxes instead
+ - Updated FAQ
+
+1.8 - 2007-12-05
+ - Added [url]-tag to vn description field
+ - Changed category input to checkboxes
+ - Used image sprites for category browser icons
+ - Fixed bug with media-select-form
+ - Fixed bug with pending producer changes showing up in the producer search
+ - Added hack to exclude trial versions in the release dates
+ - Removed audience category and added age rating field to releases
+ - Fixed typo: "game hes either" -> "game has either"
+ - Added Wikipedia & CISVisual link
+ - Added small vertical padding between releases
+ - Added length of visual novel
+ - Renamed continues back to Sequel/Prequel
+
+1.7 - 2007-11-25
+ - Bugfix: The visual novel itself is now also listed at the Pending Changes
+ under the releases
+ - Bugfix: Comments and Moderation subforms cannot be automatically hidden
+ - Made release and vn-links in the edit-dropdown clickable, to edit all
+ - Added "show all pending changes" option for moderators
+ - Removed official (japanese) titles from producer list
+ - Added description field for producers
+ - Added a red asterisk for fields that are required
+ - Combined 4 flag-columns in the users table to one
+ - Added cronjob to delete unused relation graphs
+
+1.6 - 2007-11-11
+ - vnr.released accepts NULL
+ - vn.c_years renamed to vn.c_released, and only stores year+month of first
+ release
+ - Removed vn_releases.lastmod
+ - Fixed CSS bug in releases layout
+ - Renamed Sequel/Prequel to Continuation/continues...
+ - Added relation graphs (/vX/rg)
+
+1.5 - 2007-11-04
+ - Automatically hiding form parts is now done server-side
+ - Release id's are hidden for not logged in visitors
+ - Added cron job to compress images and remove Exif information
+ - Possibility to add planned releases to 5 years in the future
+ - Bugfix: When editing a VN that's waiting for moderation, the 'added'
+ column won't be updated
+ - Added NSFW-option to VN-images
+ - Added small edit-dropdown when clicked on release-id
+ - Pending changes tab for VN removed and contents moved to relations tab
+ - Added Visual Novel Relations
+
+1.4 - 2007-10-28
+ - 'Mina' category renamed to 'All Ages'
+ - Added 'Clear selection' button to the category browser
+ - New visual novels will get unused/lower ID's
+ - Added notes-field to releases
+ - Subforms can be dynamically hidden/shown
+ - Bugfix: user stats will always stay under the votes at /vX/stats
+ - Bugfix: syntax error in dyna.js in Opera
+ - Combined all the add/edit/del-buttons into one menu
+ - Changed VN page layout: description moved to relations page and categories
+ have their own sub-item
+
+1.3 - 2007-10-21
+ - Bugfix: checkbox at producer-search now works
+ - VN ratings don't count of only one user has voted
+ - Added VN list size and number of votes to user list
+ - Added categories 'Drama' & 'Mystery'
+ - Added exclude filters to the category browser
+ - Added a few statistics to the right bottom of the page
+
+1.2 - 2007-10-14
+ - Bugfix: vnr_producers rows weren't deleted when deleting a release
+ - Added number of pending changes at "Pending changes" menu item
+ - Long items (>30 chars) at the top 5's (right bottom) will be shortened
+ - Added visual novel descriptions to the RSS feed
+ - Bugfix: fixed msg when browsing votes of someone who hasn't voted yet
+ - Bugfix: Voting now also works when viewing the vote stats of a VN
+ - Added user VN lists
+ - Added profile option to hide VN list
+ - Changed 'votes' tab on VN page to 'stats' and added user stats.
+
+1.1 - 2007-10-07
+ - Bugfix: you can now empty columns of the vn table
+ - Japanese is automatically selected when adding a release or producer
+ - User list has been made public
+ - Possible to browse other people's votes
+ - Added two options to "my account" to hide in user list and votes
+ - Bugfix: username is now shown when accepting a producer
+ - Bugfix: variable typo in tpl->pedit
+ - Bugfix: c_*-update-function wasn't called correctly when changing/deleting
+ releases
+ - Bugfix: 'added' column in releases, vn and vnr is now updated at accepting
+ - Added "Most Popular" vns to every page, and added "More..."-links.
+ - Added RSS feed for recent additions
+ - Changes visual novel page layout
+ - Added vote graph + latest votes to the visual novel pages
+ - Added compression on javascript files
+ - Replaced relation-selection-box with an input field
+
+1.0 - 2007-09-30
+ - First release
diff --git a/lib/VNDB.pm b/lib/VNDB.pm
new file mode 100644
index 00000000..9779d571
--- /dev/null
+++ b/lib/VNDB.pm
@@ -0,0 +1,338 @@
+package VNDB;
+
+use strict;
+use warnings;
+
+our($VERSION, $DEBUG, %VNDBopts, @WARN);
+
+$DEBUG = 1;
+$VERSION = '1.14';
+%VNDBopts = (
+ CookieDomain => '.vndb.org',
+ root_url => $DEBUG ? 'http://beta.vndb.org' : 'http://vndb.org',
+ static_url => $DEBUG ? 'http://static.beta.vndb.org' : 'http://static.vndb.org',
+ debug => $DEBUG,
+ sqlopts => {
+ user => 'vndb',
+ passwd => 'passwd',
+ database => 'vndb',
+ },
+ tplopts => {
+ filename => 'main',
+ searchdir => '/www/vndb/data/tpl',
+ compiled => '/www/vndb/data/tplcompiled.pm',
+ namespace => 'VNDB::Util::Template::tpl',
+ pre_chomp => 1,
+ post_chomp => 1,
+ rm_newlines => 0,
+ deep_reload => $DEBUG,
+ },
+ ranks => [
+ [ [ qw| visitor loser user mod admin | ], [] ],
+ {map{$_,1}qw| hist |}, # 0 - visitor (not logged in)
+ {map{$_,1}qw| hist |}, # 1 - loser
+ {map{$_,1}qw| hist edit |}, # 2 - user
+ {map{$_,1}qw| hist edit mod lock |}, # 3 - mod
+ {map{$_,1}qw| hist edit mod lock del userlist useredit |}, # 4 - admin
+ ],
+ imgpath => '/www/vndb/static/cv',
+ mappath => '/www/vndb/data/rg',
+ grapher => '/www/vndb/util/relgraph.pl',
+);
+$VNDBopts{ranks}[0][1] = { (map{$_,1} map { keys %{$VNDBopts{ranks}[$_]} } 1..5) };
+
+
+require 'global.pl';
+
+require Time::HiRes if $DEBUG;
+require Data::Dumper if $DEBUG;
+use VNDB::Util::Template;
+use VNDB::Util::Request;
+use VNDB::Util::Response;
+use VNDB::Util::DB;
+use VNDB::Util::Tools;
+use VNDB::Util::Auth;
+use VNDB::HomePages;
+use VNDB::Producers;
+use VNDB::Releases;
+use VNDB::VNLists;
+use VNDB::Users;
+use VNDB::Votes;
+use VNDB::VN;
+
+
+my %VNDBuris = ( # wildcards: * -> (.+), + -> ([0-9]+)
+ '/' => sub { shift->HomePage },
+ faq => sub { shift->FAQ },
+ 'd+' => sub { shift->DocPage(shift) },
+ nospam => sub { shift->DocPage(6) },
+ hist => {'*'=> sub { shift->History(undef, undef, $_[1]) } },
+ # users
+ u => {
+ login => sub { shift->UsrLogin },
+ logout => sub { shift->UsrLogout },
+ register => sub { shift->UsrReg },
+ newpass => sub { shift->UsrPass },
+ list => {
+ '/' => sub { shift->UsrList },
+ '*' => sub { $_[3] =~ /^([a-z0]|all)$/ ? shift->UsrList($_[2]) : shift->ResNotFound },
+ },
+ },
+ 'u+' => {
+ '/' => sub { shift->UsrPage(shift) },
+ votes => sub { shift->VNVotes(shift) },
+ edit => sub { shift->UsrEdit(shift) },
+ pending => sub { shift->UsrPending(shift) },
+ list => sub { shift->VNMyList(shift) },
+ hist => {'*'=> sub { shift->History('u', shift, $_[1]) } },
+ },
+ # visual novels
+ v => {
+ '/' => sub { shift->VNBrowse },
+ new => sub { shift->VNEdit(0); },
+ '*' => sub { $_[2] =~ /^([a-z0]|all|search|cat)$/ ? shift->VNBrowse($_[1]) : shift->ResNotFound; },
+ },
+ 'v+' => {
+ '/' => sub { shift->VNPage(shift) },
+ stats => sub { shift->VNPage(shift, shift) },
+ rg => sub { shift->VNPage(shift, shift) },
+ edit => sub { shift->VNEdit(shift) },
+ del => sub { shift->VNDel(shift) },
+ vote => sub { shift->VNVote(shift) },
+ list => sub { shift->VNListMod(shift) },
+ add => sub { shift->REdit('v', shift) },
+ lock => sub { shift->VNLock(shift) },
+ hide => sub { shift->VNHide(shift) },
+ hist => {'*'=> sub { shift->History('v', shift, $_[1]) } },
+ },
+ # releases
+ 'r+' => {
+ '/' => sub { shift->RPage(shift) },
+ edit => sub { shift->REdit('r', shift) },
+ lock => sub { shift->RLock(shift) },
+ del => sub { shift->RDel(shift) },
+ hide => sub { shift->RHide(shift) },
+ hist => {'*'=> sub { shift->History('r', shift, $_[1]) } },
+ },
+ # producers
+ p => {
+ '/' => sub { shift->PBrowse },
+ add => sub { shift->PEdit(0) },
+ '*' => sub { $_[2] =~ /^([a-z0]|all)$/ ? shift->PBrowse($_[1]) : shift->ResNotFound; }
+ },
+ 'p+' => {
+ '/' => sub { shift->PPage(shift) },
+ edit => sub { shift->PEdit(shift) },
+ del => sub { shift->PDel(shift) },
+ lock => sub { shift->PLock(shift) },
+ hide => sub { shift->PHide(shift) },
+ hist => {'*'=> sub { shift->History('p', shift, $_[1]) } },
+ },
+ # stuff (.xml extension to make sure they aren't counted as pageviews)
+ xml => {
+ 'producers.xml' => sub { shift->PXML },
+ 'vn.xml' => sub { shift->VNXML },
+ },
+);
+
+
+# provide redirects for old URIs
+my %OLDuris = (
+ vn => {
+ rss => sub { shift->ResRedirect('/hist/rss?t=v&e=1', 'perm') },
+ '*' => sub { shift->ResRedirect('/v/'.$_[1], 'perm') },
+ },
+ 'v+' => {
+ votes => sub { shift->ResRedirect('/v'.(shift).'/stats', 'perm') },
+ },
+ u => {
+ '*' => {
+ '*' => sub {
+ if($_[2] =~ /^_(login|logout|register|newpass|list)$/) {
+ $_[3] eq '/' ? $_[0]->ResRedirect('/u/'.$1, 'perm') : $_[0]->ResRedirect('/u/'.$1.'/'.$_[3], 'perm');
+ } else {
+ my $id = $_[0]->DBGetUser(username => $_[2])->[0]{id};
+ $id ? $_[0]->ResRedirect('/u'.$id.'/'.$_[3], 'perm') : $_[0]->ResNotFound;
+ }
+ },
+ }
+ }
+);
+
+
+
+sub new {
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my %args = @_;
+
+ my $me = bless {
+ %args,
+ _DB => VNDB::Util::DB->new(%{$args{sqlopts}}),
+ _TPL => VNDB::Util::Template->new(%{$args{tplopts}}),
+ }, $type;
+
+ return $me;
+}
+
+
+sub get_page {
+ my $self = shift;
+ my $r = shift;
+
+ $self->{_Req} = VNDB::Util::Request->new($r);
+ $self->{_Res} = VNDB::Util::Response->new($self->{_TPL});
+
+ $self->AuthCheckCookie();
+ $self->checkuri();
+
+ my $res = $self->ResSetModPerl($r);
+ $self->DBCommit();
+
+ return($self, $res);
+}
+
+
+sub checkuri {
+ my $self = shift;
+ (my $uri = lc($self->ReqUri)) =~ s/^\/+//;
+ $uri =~ s/\?.*$//;
+ return $self->ResRedirect("/$uri", 'perm') if $uri =~ s/\/+$//;
+ $uri =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # ugly hack, but we only accept ASCII anyway
+ return $self->ResNotFound() if $uri !~ /^[a-z0-9\-\._~\/]*$/; # rfc3986 section 2.3, "Unreserved Characters"
+ my @uri;
+ defined $_ and push(@uri, $_) for (split(/\/+/, $uri));
+ my @ouri = @uri; # items in @uri can be modified by uri2page
+ $self->uri2page(\%VNDBuris, \@uri, 0);
+ $self->uri2page(\%OLDuris, \@ouri, 0) # provide redirects for old uris
+ if $self->{_Res}->{whattouse} == 4 && $self->{_Res}->{rc} == 404;
+}
+
+
+sub uri2page {
+ my($s, $o, $u, $i) = @_;
+ $u->[$i] = '/' if !defined $u->[$i];
+ my $n = $o->{$u->[$i]} ? $u->[$i] : ((map {
+ if(/[\*\+]/) {
+ my $t = "^$_\$";
+ /\*/ ? ($t =~ s/\*/(.+)/) : ($t =~ s/\+/([1-9][0-9]*)/);
+ $u->[$i] =~ /$t/ ? ($u->[$i] = $1) && $_ : ();
+ } else { () } }
+ sort { length($b) <=> length($a) } keys %$o)[0] || '*');
+ ref($o->{$n}) eq 'HASH' && $n ne '/' ?
+ $s->uri2page($o->{$n}, $u, ++$i) :
+ ref($o->{$n}) eq 'CODE' && $i == $#$u ?
+ &{$o->{$n}}($s, @$u) :
+ $s->ResNotFound();
+}
+
+
+1;
+
+
+__END__
+
+# O L D C O D E - N O T U S E D A N Y M O R E
+
+
+# Apache 2 handler
+sub handler ($$) {
+ my $r = shift;
+
+ # we don't handle internal redirects! (fixes ErrorDocument directives)
+ return Apache2::Const::DECLINED
+ if $r->prev || $r->next;
+
+ my $start = [Time::HiRes::gettimeofday()] if $DEBUG;
+ @WARN = ();
+ my($code, $res, $err);
+ $SIG{__WARN__} = sub { push(@VNDB::WARN, @_); warn @_; };
+
+ $err = eval {
+
+ @Time::CTime::DoW = qw|Sun Mon Tue Wed Thu Fri Sat|;
+ @Time::CTime::DayOfWeek = qw|Sunday Monday Tuesday Wednesday Thursday Friday Saturday|;
+ @Time::CTime::MoY = qw|Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec|;
+ @Time::CTime::MonthOfYear = qw|January February March April May June July August September October November December|;
+
+ $VNDB = VNDB->new(%VNDBopts) if !$VNDB;
+ $VNDB->{r} = $r;
+
+ # let apache handle static files
+ (my $uri = lc($r->uri())) =~ s/\/+//;
+ if(index($uri, '..') == -1 && -f '/www/vndb/www/' . $uri) {
+ $code = Apache2::Const::DECLINED;
+ return $code;
+ }
+
+ $VNDB->DBCheck();
+ ($res, $code) = $VNDB->get_page($r);
+ if($DEBUG) {
+ my($sqlt, $sqlc) = (0, 0);
+ foreach (@{$res->{_DB}->{Queries}}) {
+ if($_->[0]) {
+ $sqlc++;
+ $sqlt += $_->[1];
+ }
+ }
+ my $time = Time::HiRes::tv_interval($start);
+ my $tpl = $res->{_Res}->{_tpltime} ? $res->{_Res}->{_tpltime}/$time*100 : 0;
+ my $gzip = 0;
+ $gzip = 100 - $res->{_Res}->{_gzip}->[1]/$res->{_Res}->{_gzip}->[0]*100
+ if($res->{_Res}->{_gzip} && ref($res->{_Res}->{_gzip}) eq 'ARRAY' && $res->{_Res}->{_gzip}->[0] > 0);
+ printf STDERR "Took %3dms (SQL/TPL/perl: %4.1f%% %4.1f%% %4.1f%%) (GZIP: %4.1f%%) to parse %s\n",
+ $time*1000, $sqlt/$time*100, $tpl, 100-($sqlt/$time*100)-$tpl, $gzip, $r->uri();
+ }
+
+ };
+
+ # error occured, create a dump file
+ if(!defined $err && $@ && $DEBUG) {
+ undef $res->{_Res};
+ undef $res->{_Req};
+ die $@;
+ } elsif(!defined $err && $@) {
+ if(open(my $E, sprintf '>/www/vndb/data/errors/%04d-%02d-%02d-%d',
+ (localtime)[5]+1900, (localtime)[4]+1, (localtime)[3], time)) {
+ print $E 'Error @ ' . scalar localtime;
+
+ print $E "\n\nRequest:\n" . $r->the_request . "\n";
+ print $E "$_: " . $r->headers_in->{$_} . "\n"
+ for (keys %{$r->headers_in});
+
+ print $E "\nParams:\n";
+ my $re = Apache2::Request->new($r);
+ print $E "$_: " . $re->param($_) . "\n"
+ for ($re->param());
+
+ print $E "\nError:\n$@\n\n";
+ print $E "Warnings:\n".join('', @WARN)."\n";
+ close($E);
+ }
+ $VNDB->DBRollBack();
+ undef $res->{_Res};
+ undef $res->{_Req};
+ die "Error, check dumpfile!\n";
+ }
+
+ undef $res->{_Res};
+ undef $res->{_Req};
+ # let apache handle 404's
+ $code = Apache2::Const::DECLINED if $code == 404;
+ return $code;
+}
+
+
+sub mod_perl_init {
+ require Apache2::RequestRec;
+ require Apache2::RequestIO;
+ $VNDB = __PACKAGE__->new(%VNDBopts);
+ return 0;
+}
+
+
+sub mod_perl_exit {
+ $VNDB->DBExit() if defined $VNDB && ref $VNDB eq __PACKAGE__;
+ return 0;
+}
+
diff --git a/lib/VNDB/HomePages.pm b/lib/VNDB/HomePages.pm
new file mode 100644
index 00000000..c79b3ac6
--- /dev/null
+++ b/lib/VNDB/HomePages.pm
@@ -0,0 +1,286 @@
+
+package VNDB::HomePages;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| HomePage FAQ DocPage History HistRevert HistDelete |;
+
+
+sub HomePage {
+ my $self = shift;
+
+ # recent edits
+ # recently added visual novels
+ # recently added producers
+ # random visual novels
+ # recent votes
+ # popular visual novels
+
+ $self->ResAddTpl(home => {
+ recentedits => scalar $self->DBGetHist( results => 10, what => 'iid ititle'),
+ recentvns => scalar $self->DBGetHist( results => 10, what => 'iid ititle', edits => 0, type => 'v'),
+ recentps => scalar $self->DBGetHist( results => 10, what => 'iid ititle', edits => 0, type => 'p'),
+ randomvns => scalar $self->DBGetVN( results => 10, order => 'RANDOM()'),
+ recentvotes => scalar $self->DBGetVotes(results => 10),
+ popular => scalar $self->DBGetVN( results => 10, order => 'v.c_votes DESC'),
+ });
+}
+
+
+sub FAQ {
+ shift->ResAddTpl(faq => {});
+}
+
+sub DocPage {
+ shift->ResAddTpl(docs => { p => shift });
+}
+
+
+sub History { # type(p,v,r,u), id, [rss|/]
+ my($self, $type, $id, $fmt) = @_;
+ $type ||= '';
+ $id ||= 0;
+
+ $fmt = undef if !$fmt || $fmt eq '/';
+ return $self->ResNotFound if $fmt && $fmt ne 'rss';
+
+ my $f = $self->FormCheck(
+ { name => 'p', required => 0, default => 1, template => 'int' },
+ { name => 'ip', required => 0, default => 0 }, # hidden option
+ { name => 't', required => 0, default => 'a', enum => [ qw| v r p a | ] },
+ { name => 'e', required => 0, default => 0, enum => [ 0..2 ] },
+ { name => 'r', required => 0, default => $fmt ? 10 : 50, template => 'int' },
+ { name => 'i', required => 0, default => 0, enum => [ 0..1 ] },
+ { name => 'h', required => 0, default => 0, enum => [ 0..2 ] }, # hidden option
+ );
+
+ my $o =
+ $type eq 'u' ? $self->DBGetUser(uid => $id)->[0] :
+ $type eq 'v' ? $self->DBGetVN(id => $id)->[0] :
+ $type eq 'r' ? $self->DBGetRelease(id => $id)->[0] :
+ $type eq 'p' ? $self->DBGetProducer(id => $id)->[0] :
+ undef;
+ return $self->ResNotFound if $type && !$o;
+ my $t =
+ $type eq 'u' ? $o->{username} :
+ $type eq 'v' ? $o->{title} :
+ $type eq 'r' ? $o->{romaji} || $o->{title} :
+ $type eq 'p' ? $o->{name} :
+ undef;
+
+ my($h, $np, $act);
+
+ if($self->ReqMethod ne 'POST' || $fmt) {
+ ($h, $np) = $self->DBGetHist(
+ what => 'iid ititle user',
+ type => $type,
+ !$type && $f->{t} ne 'a' ? (
+ type => $f->{t} ) : (),
+ $f->{e} ? (
+ edits => $f->{e} == 1 ? 0 : 1 ) : (),
+ id => $id,
+ page => $fmt ? 0 : $f->{p},
+ results => $f->{r},
+ releases => $type eq 'v' ? $f->{i} : 0,
+ showhid => $f->{h},
+ $f->{ip} ? (
+ ip => $f->{ip} ) : (),
+ );
+ }
+ else {
+ my $frm = $self->FormCheck(
+ { name => 'sel', required => 1, multi => 1 },
+ { name => 'post', required => 1, default => 'Mass revert', enum => [ 'Mass revert', 'Mass delete' ] },
+ );
+ my @s = grep /^[0-9]+$/, @{$frm->{sel}};
+ if(!$frm->{_err} && @s) {
+ $np = 0;
+ $h = $frm->{post} =~ /revert/ ? $self->HistRevert(\@s) : $self->HistDelete(\@s);
+ $act = $frm->{post} =~ /revert/ ? 'r' : 'd';
+ }
+ }
+
+ if(!$fmt) {
+ $self->ResAddTpl(hist => {
+ title => $t,
+ selt => $f->{t},
+ sele => $f->{e},
+ seli => $f->{i},
+ type => $type,
+ id => $id,
+ hist => $h,
+ page => $f->{p},
+ npage => $np,
+ obj => $o,
+ act => $act || '',
+ });
+ } else {
+ my $x = $self->ResStartXML;
+ $x->startTag('rss', version => '2.0');
+ $x->startTag('channel');
+ $x->dataElement('language', 'en');
+ $x->dataElement('title', !$type ? 'Recent changes at VNDB.org' : $type eq 'u' ? 'Recent changes by '.$t : 'Edit history of '.$t);
+ $x->dataElement('link', $self->{root_url}.(!$type ? '/hist' : '/'.$type.$id.'/hist'));
+
+ for (@$h) {
+ my $t = (qw| v r p |)[$_->{type}];
+ my $url = $self->{root_url}.'/'.$t.$_->{iid}.'?rev='.$_->{id};
+ $_->{comments} = VNDB::Util::Template::tpl::summary($_->{comments})||'[no summary]';
+ $x->startTag('item');
+ $x->dataElement(title => $_->{ititle});
+ $x->dataElement(link => $url);
+ $x->dataElement(pubDate => VNDB::time2str($_->{requested}));
+ $x->dataElement(guid => $url);
+ $x->dataElement(description => $_->{comments});
+ $x->endTag('item');
+ }
+
+ $x->endTag('channel');
+ $x->endTag('rss');
+ }
+}
+
+
+
+
+1;
+
+__END__
+
+
+#############################################################
+# E X P E R I M E N T A L S T U F F #
+# #
+
+# !WARNING!: this code has not been updated to reflect the recent database changes!
+
+
+# !WARNING!: this code uses rather many large SQL queries, use with care...
+sub HistRevert { # \@ids
+ my($self, $l) = @_;
+ my $comm = 'Mass revert to revision %d by %s';
+
+ # first, get objects, remove newly created items and causedby edits and add original edits
+ $l = $self->DBGetHist(cid => $l, results => 1000, what => 'iid');
+ my @todo;
+ for (@$l) {
+ next if !$_->{prev}; # remove newly created items
+ if($_->{causedby}) { # remove causedby edits
+ push @todo, $self->DBGetHist(cid => [ $_->{causedby} ], what => 'iid')->[0]; # add original edit
+ } else {
+ push @todo, $_;
+ }
+ }
+
+ # second, group all items and remove duplicate edits
+ my %todo; # key=type.iid, value = [objects]
+ for my $t (@todo) {
+ my $k = $t->{type}.$t->{iid};
+ $todo{$k} = [ $t ] and next
+ if !$todo{$k};
+ push @{$todo{$k}}, $t
+ if !grep { $_->{id} == $t->{id} } @{$todo{$k}};
+ }
+
+ # third, make sure we don't revert edits we don't want to revert
+ #TODO
+
+ # fourth, get the lowest revision of each item to revert to (ignoring intermetiate edits)
+ @todo = map { (sort { $a->{id} <=> $b->{id} } @{$todo{$_}})[0] } keys %todo;
+
+ # fifth, actually revert the edits
+ my @relupd;
+ for (@todo) {
+
+ if($_->{type} == 0) { # visual novel
+ my $v = $self->DBGetVN(id => $_->{iid}, rev => $_->{prev}, what => 'extended changes relations')->[0];
+ my $old = $self->DBGetVN(id => $_->{iid}, rev => $_->{id}, what => 'relations')->[0];
+ my $cid = $self->DBEditVN($_->{iid},
+ (map { $_ => $v->{$_} } qw| title desc alias categories comm length l_wp l_cisv l_vnn img_nsfw image|),
+ relations => [ map { [ $_->{relation}, $_->{id} ] } @{$v->{relations}} ],
+ comm => sprintf($comm, $v->{cid}, $v->{username}),
+ );
+ my %old = map { $_->{id} => $_->{relation} } @{$old->{relations}};
+ my %new = map { $_->{id} => $_->{relation} } @{$v->{relations}};
+ push @relupd, $self->VNUpdReverse(\%old, \%new, $_->{iid}, $cid);
+ }
+
+ if($_->{type} == 1) { # release
+ my $r = $self->DBGetRelease(id => $_->{iid}, rev => $_->{prev}, what => 'producers platforms media vn changes')->[0];
+ $self->DBEditRelease($_->{iid},
+ (map { $_ => $r->{$_} } qw| title original language website notes minage type released platforms |),
+ media => [ map { [ $_->{medium}, $_->{qty} ] } @{$r->{media}} ],
+ producers => [ map { $_->{id} } @{$r->{producers}} ],
+ comm => sprintf($comm, $r->{cid}, $r->{username}),
+ vn => [ map { $_->{vid} } @{$r->{vn}} ],
+ );
+ }
+
+ if($_->{type} == 2) { # producer
+ my $p = $self->DBGetProducer(id => $_->{iid}, rev => $_->{prev}, what => 'changes')->[0];
+ $self->DBEditProducer($_->{iid},
+ (map { $_ => $p->{$_} } qw| name original website type lang desc |),
+ comm => sprintf($comm, $p->{cid}, $p->{username}),
+ );
+ }
+ }
+ # update relation graphs
+ $self->VNRecreateRel(@relupd) if @relupd;
+
+ # sixth, create report of what happened
+ my @done;
+ for my $t (@todo, @$l) {
+ next if $t->{_status};
+ $t->{_status} =
+ (scalar grep { $t->{id} == $_->{id} } @todo) ? 'reverted' :
+ $t->{causedby} ? 'automated' :
+ 'skipped';
+ push @done, $t;
+ }
+ return \@done;
+}
+
+
+# ONLY DELETES NEWLY CREATED PAGES (for now...)
+sub HistDelete { # \@ids
+ my ($self, $l) = @_;
+
+ # get objects and add causedby edits
+ $l = $self->DBGetHist(cid => $l, results => 1000, what => 'iid');
+ my @todo = @$l;
+# for (@$l) {
+# if($_->{causedby}) { # remove causedby edits
+# my $n = $self->DBGetHist(cid => [ $_->{causedby} ])->[0]; # add original edit
+# push @todo, $n, $self->DBGetHist(causedby => $n->{id} ])->[0]; # add causedby edits
+# } else {
+# push @todo, $_;
+# }
+# }
+
+ # remove duplicate edit
+ # (not necessary now)
+
+ # completely delete newly created items (sort on type to make sure we delete vn's before releases, which is faster)
+ my @vns;
+ for my $t (sort { $a->{type} <=> $b->{type} } @todo) {
+ next if $t->{prev};
+ $self->DBDelVN($t->{iid}) if $t->{type} == 0;
+ $self->DBDelProducer($t->{iid}) if $t->{type} == 2;
+ if($t->{type} == 1) { # we need to know the vn's to remove a release
+ my $r = $self->DBGetRelease(id => $t->{iid}, what => 'vn')->[0];
+ next if !$r; # we could have deleted this release by deleting the related vn
+ $self->DBDelRelease([ map { $_->{vid} } @{$r->{vn}} ], $t->{iid});
+ }
+ }
+
+ # delete individual edits
+ #TODO
+
+ return \@todo;
+}
+
+
diff --git a/lib/VNDB/Producers.pm b/lib/VNDB/Producers.pm
new file mode 100644
index 00000000..55a02d3d
--- /dev/null
+++ b/lib/VNDB/Producers.pm
@@ -0,0 +1,188 @@
+
+package VNDB::Producers;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| PPage PBrowse PEdit PDel PLock PHide PXML |;
+
+
+sub PPage {
+ my $self = shift;
+ my $id = shift;
+
+
+ my $r = $self->FormCheck(
+ { name => 'rev', required => 0, default => 0, template => 'int' },
+ { name => 'diff', required => 0, default => 0, template => 'int' },
+ );
+
+ my $p = $self->DBGetProducer(
+ id => $id,
+ $r->{rev} ? ( what => 'changes' ) : (),
+ $r->{rev} ? ( rev => $r->{rev} ) : ()
+ )->[0];
+ return $self->ResNotFound if !$p->{id};
+
+ $r->{diff} ||= $p->{prev} if $r->{rev};
+ my $c = $r->{diff} && $self->DBGetProducer(id => $id, rev => $r->{diff}, what => 'changes')->[0];
+ $p->{next} = $self->DBGetHist(type => 'p', id => $id, next => $p->{cid}, showhid => 1)->[0]{id} if $r->{rev};
+
+ return $self->ResAddTpl(ppage => {
+ prod => $p,
+ prev => $c,
+ change => $r->{diff} || $r->{rev},
+ vn => $self->DBGetProducerVN($id),
+ });
+}
+
+
+sub PBrowse {
+ my $self = shift;
+ my $chr = shift;
+ $chr = 'all' if !defined $chr;
+
+ my $p = $self->FormCheck(
+ { name => 'p', required => 0, default => 1, template => 'int' },
+ { name => 'q', required => 0, default => '' }
+ );
+
+ my($r, $np) = $self->DBGetProducer(
+ $chr ne 'all' ? (
+ char => $chr ) : (),
+ $p->{q} ? (
+ search => $p->{q} ) : (),
+ page => $p->{p},
+ results => 50,
+ );
+
+ $self->ResAddTpl(pbrowse => {
+ prods => $r,
+ page => $p->{p},
+ npage => $np,
+ query => $p->{q},
+ chr => $chr,
+ });
+}
+
+
+sub PEdit {
+ my $self = shift;
+ my $id = shift || 0; # 0 = new
+
+ my $rev = $self->FormCheck({ name => 'rev', required => 0, default => 0, template => 'int' })->{rev};
+
+ my $p = $self->DBGetProducer(id => $id, what => 'changes', $rev ? ( rev => $rev ) : ())->[0] if $id;
+ return $self->ResNotFound() if $id && !$p;
+
+ return $self->ResDenied if !$self->AuthCan('edit') || ($p->{locked} && !$self->AuthCan('lock'));
+
+
+ my %b4 = $id ? (
+ map { $_ => $p->{$_} } qw|name original website type lang desc|
+ ) : ();
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'type', required => 1, enum => [ keys %$VNDB::PROT ] },
+ { name => 'name', required => 1, maxlength => 200 },
+ { name => 'original', required => 0, maxlength => 200, default => '' },
+ { name => 'lang', required => 1, enum => [ keys %$VNDB::LANG ] },
+ { name => 'website', required => 0, maxlength => 200, template => 'url', default => '' },
+ { name => 'desc', required => 0, maxlength => 10240, default => '' },
+ { name => 'comm', required => 0, default => '' },
+ );
+
+ return $self->ResRedirect('/p'.$id, 'post')
+ if $id && 6 == scalar grep { $_ ne 'comm' && $b4{$_} eq $frm->{$_} } keys %b4;
+
+ if(!$frm->{_err}) {
+ my $cid;
+ $cid = $self->DBEditProducer($id, %$frm) if $id; # edit
+ ($id, $cid) = $self->DBAddProducer(%$frm) if !$id; # add
+ return $self->ResRedirect('/p'.$id.'?rev='.$cid, 'post');
+ }
+ }
+
+ if($id) {
+ $frm->{$_} ||= $b4{$_} for (keys %b4);
+ $frm->{comm} = sprintf 'Reverted to revision %d by %s.', $p->{cid}, $p->{username} if $p->{cid} != $p->{latest};
+ } else {
+ $frm->{lang} ||= 'ja';
+ }
+
+ $self->ResAddTpl(pedit => {
+ form => $frm,
+ id => $id,
+ prod => $p,
+ });
+}
+
+
+sub PDel {
+ my $self = shift;
+ my $id = shift;
+
+ my $p = $self->DBGetProducer(id => $id)->[0];
+ return $self->ResNotFound if !$p;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBDelProducer($id);
+ return $self->ResRedirect('/p', 'perm');
+}
+
+
+sub PLock {
+ my $self = shift;
+ my $id = shift;
+
+ my $p = $self->DBGetProducer(id => $id)->[0];
+ return $self->ResNotFound() if !$p;
+ return $self->ResDenied if !$self->AuthCan('lock');
+ $self->DBLockItem('producers', $id, $p->{locked}?0:1);
+ return $self->ResRedirect('/p'.$id, 'perm');
+}
+
+
+sub PHide {
+ my $self = shift;
+ my $id = shift;
+
+ my $p = $self->DBGetProducer(id => $id)->[0];
+ return $self->ResNotFound() if !$p;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBHideProducer($id, $p->{hidden}?0:1);
+ return $self->ResRedirect('/p'.$id, 'perm');
+}
+
+sub PXML {
+ my $self = shift;
+
+ my $q = $self->FormCheck(
+ { name => 'q', required => 0, maxlength => 100 }
+ )->{q};
+
+ my $r = [];
+ if($q) {
+ $r = $self->DBGetProducer(results => 10,
+ $q =~ /^p([0-9]+)$/ ? (id => $1) : (search => $q));
+ }
+
+ my $x = $self->ResStartXML;
+ $x->startTag('producers', results => $#$r+1, query => $q);
+ for (@$r) {
+ $x->startTag('item');
+ $x->dataElement(id => $_->{id});
+ $x->dataElement(name => $_->{name});
+ $x->dataElement(original => $_->{original}) if $_->{original};
+ $x->dataElement(website => $_->{website}) if $_->{website};
+ $x->endTag('item');
+ }
+ $x->endTag('producers');
+}
+
+
diff --git a/lib/VNDB/Releases.pm b/lib/VNDB/Releases.pm
new file mode 100644
index 00000000..0012d324
--- /dev/null
+++ b/lib/VNDB/Releases.pm
@@ -0,0 +1,178 @@
+
+package VNDB::Releases;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| RPage REdit RLock RDel RHide |;
+
+
+sub RPage {
+ my $self = shift;
+ my $id = shift;
+
+ my $r = $self->FormCheck(
+ { name => 'rev', required => 0, default => 0, template => 'int' },
+ { name => 'diff', required => 0, default => 0, template => 'int' },
+ );
+
+ my $v = $self->DBGetRelease(
+ id => $id,
+ what => 'producers platforms media vn'.($r->{rev} ? ' changes':''),
+ $r->{rev} ? ( rev => $r->{rev} ) : ()
+ )->[0];
+ return $self->ResNotFound if !$v->{id};
+
+ $r->{diff} ||= $v->{prev} if $r->{rev};
+ my $c = $r->{diff} && $self->DBGetRelease(id => $id, rev => $r->{diff}, what => 'changes producers platforms media vn')->[0];
+ $v->{next} = $self->DBGetHist(type => 'r', id => $id, next => $v->{cid}, showhid => 1)->[0]{id} if $r->{rev};
+
+ $self->ResRedirect('/v'.$v->{vn}[0]{vid})
+ if ($self->ReqHeader('Referer')||'') =~ m{^http://[^/]*(yahoo|google)} && @{$v->{vn}} == 1;
+
+ return $self->ResAddTpl(rpage => {
+ rel => $v,
+ prev => $c,
+ change => $r->{diff}||$r->{rev},
+ });
+}
+
+
+sub REdit {
+ my $self = shift;
+ my $act = shift||'v';
+ my $id = shift || 0;
+
+ my $rid = $act eq 'r' ? $id : 0;
+
+ my $rev = $self->FormCheck({ name => 'rev', required => 0, default => 0, template => 'int' })->{rev};
+
+ my $r = $self->DBGetRelease(id => $rid, what => 'changes producers platforms media vn', $rev ? ( rev => $rev ) : ())->[0] if $rid;
+ my $ivn = $self->DBGetVN(id => $id)->[0] if !$rid;
+ return $self->ResNotFound() if ($rid && !$r) || (!$rid && !$ivn);
+
+ my $vn = $rid ? $r->{vn} : [ { vid => $id, title => $ivn->{title} } ];
+
+ return $self->ResDenied if !$self->AuthCan('edit') || ($r->{locked} && !$self->AuthCan('lock'));
+
+ my %b4 = $rid ? (
+ (map { $_ => $r->{$_} } qw|title original language website notes minage type platforms|),
+ released => $r->{released} =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/ ? [ $1, $2, $3 ] : [ 0, 0, 0 ],
+ media => join(',', map { $_->{medium} =~ /^(cd|dvd|gdr|blr)$/ ? ($_->{medium}.'_'.$_->{qty}) : $_->{medium} } @{$r->{media}}),
+ producers => join('|||', map { $_->{id}.','.$_->{name} } @{$r->{producers}}),
+ ) : ();
+ $b4{vn} = join('|||', map { $_->{vid}.','.$_->{title} } @$vn);
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'type', required => 1, enum => [ 0..$#{$VNDB::RTYP} ] },
+ { name => 'title', required => 1, maxlength => 250 },
+ { name => 'original', required => 0, maxlength => 250, default => '' },
+ { name => 'language', required => 1, enum => [ keys %{$VNDB::LANG} ] },
+ { name => 'website', required => 0, template => 'url', default => '' },
+ { name => 'released', required => 0, multi => 1, template => 'int', default => 0 },
+ { name => 'minage' , required => 0, enum => [ keys %{$VNDB::VRAGES} ], default => -1 },
+ { name => 'notes', required => 0, maxlength => 10240, default => '' },
+ { name => 'platforms', required => 0, multi => 1, enum => [ keys %$VNDB::PLAT ], default => '' },
+ { name => 'media', required => 0, default => '' },
+ { name => 'producers', required => 0, default => '' },
+ { name => 'vn', required => 1, maxlength => 10240 },
+ { name => 'comm', required => 0, default => '' },
+ );
+
+ my $released = !$frm->{released}[0] ? 0 :
+ $frm->{released}[0] == 9999 ? 99999999 :
+ sprintf '%04d%02d%02d', $frm->{released}[0]||0, $frm->{released}[1]||0, $frm->{released}[2]||0;
+ my $media = [ map { /_/ ? [ split /_/ ] : [ $_, 0 ] } split /,/, $frm->{media} ];
+ my $producers = [ map { /^([0-9]+)/ ? $1 : () } split /\|\|\|/, $frm->{producers} ];
+ my $new_vn = [ map { /^([0-9]+)/ ? $1 : () } split /\|\|\|/, $frm->{vn} ];
+
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'vn_1' ] : [ 'vn_1' ]
+ if !@$new_vn;
+
+ # weed out empty string
+ $frm->{platforms} = [ map { $_ ? $_ : () } @{$frm->{platforms}} ];
+
+ return $self->ResRedirect('/r'.$rid, 'post')
+ if $rid && $released == $r->{released} &&
+ (join(',', sort @{$b4{platforms}}) eq join(',', sort @{$frm->{platforms}})) &&
+ 10 == scalar grep { $_ ne 'comm' && $_ ne 'released' && $_ ne 'platforms' && $frm->{$_} eq $b4{$_} } keys %b4;
+
+ if(!$frm->{_err}) {
+ my %opts = (
+ vn => $new_vn,
+ (map { $_ => $frm->{$_} } qw|title original language website notes minage type comm platforms|),
+ released => $released,
+ media => $media,
+ producers => $producers,
+ );
+ my $cid;
+ $cid = $self->DBEditRelease($rid, %opts) if $rid; # edit
+ ($rid, $cid) = $self->DBAddRelease(%opts) if !$rid; # add
+ return $self->ResRedirect('/r'.$rid.'?rev='.$cid, 'post');
+ }
+ }
+
+ if($rid) {
+ $frm->{$_} ||= $b4{$_} for (keys %b4);
+ $frm->{comm} = sprintf 'Reverted to revision %d by %s.', $r->{cid}, $r->{username} if $r->{cid} != $r->{latest};
+ } else {
+ $frm->{language} = 'ja';
+ $frm->{vn} = $b4{vn};
+ }
+
+ $self->AddHid($frm);
+ $frm->{_hid} = {map{$_=>1} qw| info pnm prod |}
+ if !$frm->{_hid} && !$rid;
+ $self->ResAddTpl(redit => {
+ form => $frm,
+ id => $rid,
+ rel => $r,
+ vn => !$rid ? $ivn : $vn,
+ });
+}
+
+
+sub RLock {
+ my $self = shift;
+ my $id = shift;
+
+ my $r = $self->DBGetRelease(id => $id)->[0];
+ return $self->ResNotFound() if !$r;
+ return $self->ResDenied if !$self->AuthCan('lock');
+ $self->DBLockItem('releases', $id, $r->{locked}?0:1);
+ return $self->ResRedirect('/r'.$id, 'perm');
+}
+
+
+sub RDel {
+ my $self = shift;
+ my $id = shift;
+
+ return $self->ResDenied if !$self->AuthCan('del');
+ my $r = $self->DBGetRelease(id => $id, what => 'vn')->[0];
+ return $self->ResNotFound if !$r;
+ $self->DBDelRelease([ map { $_->{vid} } @{$r->{vn}} ], $id);
+ return $self->ResRedirect('/v'.$r->{vn}[0]{id}, 'perm');
+}
+
+
+sub RHide {
+ my $self = shift;
+ my $id = shift;
+
+ return $self->ResDenied if !$self->AuthCan('del');
+ my $r = $self->DBGetRelease(id => $id, what => 'vn')->[0];
+ return $self->ResNotFound if !$r;
+ $self->DBHideRelease($id, $r->{hidden}?0:1, [ map { $_->{vid} } @{$r->{vn}} ]);
+ return $self->ResRedirect('/r'.$id, 'perm');
+}
+
+
+1;
+
diff --git a/lib/VNDB/Users.pm b/lib/VNDB/Users.pm
new file mode 100644
index 00000000..ea4b46ed
--- /dev/null
+++ b/lib/VNDB/Users.pm
@@ -0,0 +1,230 @@
+
+package VNDB::Users;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5 'md5_hex';
+
+our $VERSION = $VNDB::VERSION;
+our @EXPORT = qw| UsrLogin UsrLogout UsrReg UsrPass UsrEdit UsrList UsrPage |;
+
+
+sub UsrLogin {
+ my $self = shift;
+
+ (return $self->ResRedirect('/', 'temp')) if $self->AuthInfo()->{id};
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'username', required => 1, minlength => 2, maxlength => 15, template => 'pname' },
+ { name => 'userpass', required => 1, minlength => 4, maxlength => 15, template => 'asciiprint' },
+ );
+ if(!$frm->{_err}) {
+ (my $ref = $self->ReqHeader('Referer')||'/') =~ s/^$self->{root_url}//;
+ my $r = $self->AuthLogin($frm->{username}, $frm->{userpass}, 1, $ref);
+ $r == 1 ? (return) : ($frm->{_err} = [ 'loginerr' ]);
+ }
+ }
+
+ $self->ResAddTpl(userlogin => {
+ log => $frm,
+ } );
+}
+
+
+sub UsrLogout {
+ shift->AuthLogout();
+}
+
+
+sub UsrReg {
+ my $self = shift;
+
+ (return $self->ResRedirect('/', 'temp')) if $self->AuthInfo()->{id};
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'username', required => 1, minlength => 2, maxlength => 15, template => 'pname' },
+ { name => 'mail', required => 1, template => 'mail' },
+ { name => 'pass1', required => 1, minlength => 4, maxlength => 15, template => 'asciprint' },
+ { name => 'pass2', required => 1, minlength => 4, maxlength => 15, template => 'asciprint' },
+ );
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'badpass' ] : [ 'badpass' ]
+ if $frm->{pass1} ne $frm->{pass2};
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'usrexists' ] : [ 'usrexists' ]
+ if $frm->{username} eq 'anonymous' || $self->DBGetUser(username => $frm->{username})->[0];
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'mailexists' ] : [ 'mailexists' ]
+ if $frm->{mail} && $self->DBGetUser(mail => $frm->{mail})->[0];
+
+ if(!$frm->{_err}) {
+ $self->DBAddUser($frm->{username}, md5_hex($frm->{pass1}), $frm->{mail}, 2);
+ return $self->AuthLogin($frm->{username}, $frm->{pass1}, 1, '/');
+ }
+ }
+ $self->ResAddTpl(userreg => {
+ reg => $frm,
+ });
+}
+
+
+sub UsrPass {
+ my $self = shift;
+
+ (return $self->ResRedirect('/', 'temp')) if $self->AuthInfo()->{id};
+
+ my $d = $self->ReqParam('d');
+
+ my $frm = {};
+ if(!$d && $self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck({ name => 'mail', required => 1, template => 'mail' });
+ my $unfo;
+ if(!$frm->{_err}) {
+ $frm->{mail} =~ s/%//g;
+ $unfo = $self->DBGetUser(mail => $frm->{mail})->[0];
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'nomail' ] : [ 'nomail' ]
+ if !$unfo;
+ }
+ if(!$frm->{_err}) {
+ my @chars = ( 'A'..'Z', 'a'..'z', 0..9 );
+ my $pass = join('', map $chars[int rand $#chars+1], 0..8);
+ $self->DBUpdateUser($unfo->{id}, passwd => md5_hex($pass));
+ $self->SendMail(sprintf(<<__, $unfo->{username}, $unfo->{username}, $pass),
+Hello %s,
+
+Your password has been reset, you can now login at http://vndb.org/ with the
+following information:
+
+Username: %s
+Password: %s
+
+Now don't forget your password again! :-)
+
+vndb.org
+__
+ To => $frm->{mail},
+ Subject => sprintf('Password request for %s', $unfo->{username}),
+ );
+ return $self->ResRedirect('/u/newpass?d=1', 'post');
+ }
+ }
+
+ $self->ResAddTpl(userpass => {
+ pas => $frm,
+ done => $d,
+ });
+}
+
+
+sub UsrEdit {
+ my $self = shift;
+ my $user = shift;
+
+ my $u = $self->AuthInfo();
+ return $self->ResDenied if !$u->{id};
+ my $adm = $u->{id} != $user;
+ return $self->ResDenied if $adm && !$self->AuthCan('useredit');
+ $u = $self->DBGetUser(uid => $user)->[0] if $adm;
+ return $self->ResNotFound if !$u->{id};
+
+ my $d = $self->ReqParam('d');
+
+ my $frm = {};
+ if(!$d && $self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'mail', required => 1, template => 'mail' },
+ { name => 'pass1', required => 0, template => 'asciiprint' },
+ { name => 'pass2', required => 0, template => 'asciiprint' },
+ { name => 'rank', required => $adm, enum => [ '1'..($#{$self->{ranks}}-1) ] },
+ { name => 'pvotes',required => 0 },
+ { name => 'plist', required => 0 },
+ { name => 'pign_nsfw', required => 0 },
+ );
+ if(($frm->{pass1} || $frm->{pass2}) && $frm->{pass1} ne $frm->{pass2}) {
+ $frm->{_err} = [] if !$frm->{_err};
+ push(@{$frm->{_err}}, 'badpass');
+ }
+ if(!$frm->{_err}) {
+ my $pass = $frm->{pass1} ? md5_hex($frm->{pass1}) : '';
+ my %opts = (
+ 'mail' => $frm->{mail},
+ );
+ $opts{passwd} = $pass if $pass;
+ $opts{rank} = $frm->{rank} if $adm;
+ $opts{flags} = $frm->{pvotes} ? $VNDB::UFLAGS->{votes} : 0;
+ $opts{flags} += $VNDB::UFLAGS->{list} if $frm->{plist};
+ $opts{flags} += $VNDB::UFLAGS->{nsfw} if $frm->{pign_nsfw};
+ $self->DBUpdateUser($u->{id}, %opts);
+ return $adm ? $self->ResRedirect('/u'.$user.'/edit?d=1', 'post') :
+ $pass ? $self->AuthLogin($user, $frm->{pass1}, 1, '/u'.$user.'/edit?d=1') :
+ $self->ResRedirect('/u'.$user.'/edit?d=1', 'post');
+ }
+ }
+
+ $frm->{$_} ||= $u->{$_}
+ for (qw| username mail rank |);
+ $frm->{pvotes} ||= $u->{flags} & $VNDB::UFLAGS->{votes};
+ $frm->{plist} ||= $u->{flags} & $VNDB::UFLAGS->{list};
+ $frm->{pign_nsfw} ||= $u->{flags} & $VNDB::UFLAGS->{nsfw};
+ $self->ResAddTpl(useredit => {
+ form => $frm,
+ done => $d,
+ adm => $adm,
+ user => $user,
+ });
+}
+
+
+sub UsrList {
+ my $self = shift;
+ my $chr = shift;
+ $chr = 'all' if !defined $chr;
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 0, default => 'username', enum => [ qw|username mail rank registered| ] },
+ { name => 'o', required => 0, default => 'a', enum => [ 'a','d' ] },
+ { name => 'p', required => 0, default => 1, template => 'int' },
+ );
+
+ my($unfo, $np) = $self->DBGetUser(
+ order => $f->{s}.($f->{o} eq 'a' ? ' ASC' : ' DESC'),
+ $chr ne 'all' ? (
+ firstchar => $chr ) : (),
+ results => 50,
+ page => $f->{p},
+ what => 'list',
+ );
+
+ $self->ResAddTpl(userlist => {
+ users => $unfo,
+ chr => $chr,
+ page => $f->{p},
+ npage => $np,
+ order => [ $f->{s}, $f->{o} ],
+ } );
+}
+
+
+sub UsrPage {
+ my($self, $id) = @_;
+
+ my $u = $self->DBGetUser(uid => $id, what => 'list')->[0];
+ return $self->ResNotFound if !$u;
+
+ $self->ResAddTpl(userpage => {
+ user => $u,
+ lists => {
+ latest => scalar $self->DBGetVNList(uid => $id, results => 7),
+ graph => $self->DBVNListStats(uid => $id),
+ },
+ votes => {
+ latest => scalar $self->DBGetVotes(uid => $id, results => 10),
+ graph => $self->DBVoteStats(uid => $id),
+ },
+ });
+}
+
+1;
+
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm
new file mode 100644
index 00000000..dba5ba72
--- /dev/null
+++ b/lib/VNDB/Util/Auth.pm
@@ -0,0 +1,131 @@
+
+
+
+
+
+# N E E D S M O A R S A L T !
+
+
+package VNDB::Util::Auth;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5 'md5_hex';
+use Crypt::Lite; # simple, small and easy encryption for cookies
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| AuthCheckCookie AuthLogin AuthLogout AuthInfo AuthCan AuthAddTpl |;
+
+
+{ # local data for these 2 methods only
+ my $crl = Crypt::Lite->new(debug => 0);
+ my $scrt = md5_hex("73jkS39Sal2)"); # just a random string, as long as it doesn't change
+
+sub AuthCheckCookie {
+ my $self = shift;
+ my $info = $self->{_Req} || $self;
+ $info->{_auth} = {} if !exists $info->{_auth};
+
+ my $cookie = $self->ReqCookie('vndb_auth');
+ return 0 if !$cookie;
+ my $str = $crl->decrypt($cookie, $scrt);
+ return 0 if length($str) < 36;
+ my $pass = substr($str, 4, 32);
+ my $user = substr($str, 36);
+ return _AuthCheck($self, $user, $pass);
+}
+
+sub AuthLogin {
+ my $self = shift;
+ my $user = lc(scalar shift);
+ my $psbk = shift;
+ my $pass = md5_hex($psbk);
+ my $keep = shift;
+ my $to = shift;
+ my $status = _AuthCheck($self, $user, $pass);
+ if($status == 1) {
+ (my $cookie = $crl->encrypt("VNDB$pass$user", $scrt)) =~ s/\r?\n//g;
+ $self->ResRedirect($to, "post");
+ $self->ResAddHeader('Set-Cookie', "vndb_auth=$cookie; " . ($keep ? 'expires=Sat, 01-Jan-2030 00:00:00 GMT; ' : ' ') . "path=/; domain=$self->{CookieDomain}");
+ return 1;
+ }
+ return $status;
+}
+} # end of local data
+
+sub AuthLogout {
+ my $self = shift;
+ $self->ResRedirect('/', 'temp');
+ $self->ResAddHeader('Set-Cookie', "vndb_auth= ; expires=Sat, 01-Jan-2000 00:00:00 GMT; path=/; domain=$self->{CookieDomain}");
+}
+
+sub AuthInfo {
+ my $self = shift;
+ my $info = $self->{_Req} || shift;
+ return $info->{_auth} || {};
+}
+
+sub AuthCan {
+ my $self = shift;
+ my $act = shift;
+ my $info = $self->{_Req} || shift;
+ return $self->{ranks}[($info->{_auth}{rank}||0)+1]{$act};
+}
+
+sub _AuthCheck {
+ my $self = shift;
+ my $user = shift;
+ my $pass = shift;
+ my $info = $self->{_Req} || shift;
+
+ $info->{_auth} = undef;
+
+ return 2 if !$user || length($user) > 15 || length($user) < 2;
+ return 3 if !$pass || length($pass) != 32;
+
+ my $d = $self->DBGetUser(username => $user, passwd => $pass)->[0];
+ return 4 if !defined $d->{id};
+ return 5 if !$d->{rank};
+
+ $info->{_auth} = $d;
+
+ return 1;
+}
+
+
+# adds the keys AuthLoggedin, AuthRank, AuthUsername, AuthMail, AuthId
+sub AuthAddTpl {
+ my $self = shift;
+ my $info = $self->{_Req} || shift;
+ my %tpl;
+
+ if($info->{_auth}{id}) {
+ %tpl = (
+ AuthLoggedin => 1,
+ AuthRank => $info->{_auth}{rank},
+ AuthRankname => $self->{ranks}[0][0][$info->{_auth}{rank}],
+ AuthUsername => $info->{_auth}{username},
+ AuthMail => $info->{_auth}{mail},
+ AuthId => $info->{_auth}{id},
+ AuthNsfw => $info->{_auth}{flags} & $VNDB::UFLAGS->{nsfw},
+ );
+ } else {
+ %tpl = (
+ AuthLoggedin => 0,
+ AuthRank => '',
+ AuthRankname => '',
+ AuthUsername => '',
+ AuthMail => '',
+ AuthId => 0,
+ AuthNsfw => 0,
+ );
+ }
+ $tpl{'Auth'.$_} = $self->{ranks}[($info->{_auth}{rank}||0)+1]{$_}
+ for (keys %{$self->{ranks}[0][1]});
+ $self->ResAddTpl(%tpl);
+}
+
+1;
+
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;
+
diff --git a/lib/VNDB/Util/Request.pm b/lib/VNDB/Util/Request.pm
new file mode 100644
index 00000000..fe631484
--- /dev/null
+++ b/lib/VNDB/Util/Request.pm
@@ -0,0 +1,46 @@
+
+package VNDB::Util::Request;
+
+use strict;
+use warnings;
+use Encode;
+use Exporter 'import';
+
+our @EXPORT;
+@EXPORT = qw| ReqParam ReqSaveUpload ReqCookie
+ ReqMethod ReqHeader ReqUri ReqIP |;
+
+sub new {
+ return bless {}, ref($_[0]) || $_[0];
+}
+sub ReqParam {
+ my($s,$n) = @_;
+ return wantarray
+ ? map { decode 'UTF-8', defined $_ ? $_ : '' } $FCGI::Handler::c->param($n)
+ : decode 'UTF-8', defined $FCGI::Handler::c->param($n) ? $FCGI::Handler::c->param($n) : '';
+}
+sub ReqSaveUpload {
+ my($s,$n,$f) = @_;
+ open my $F, '>', $f or die "Unable to write to $f: $!";
+ print $F $FCGI::Handler::c->param($n);
+ close $F;
+}
+sub ReqCookie {
+ my $c = Cookie::XS->fetch;
+ return $c && ref($c) eq 'HASH' && $c->{$_[1]} ? $c->{$_[1]}[0] : '';
+}
+sub ReqMethod {
+ return ($ENV{REQUEST_METHOD}||'') =~ /post/i ? 'POST' : 'GET';
+}
+sub ReqHeader {
+ (my $v = uc $_[1]) =~ tr/-/_/;
+ return $ENV{"HTTP_$v"}||'';
+}
+sub ReqUri {
+ return $ENV{REQUEST_URI};
+}
+sub ReqIP {
+ return $ENV{REMOTE_ADDR};
+}
+
+1;
diff --git a/lib/VNDB/Util/Response.pm b/lib/VNDB/Util/Response.pm
new file mode 100644
index 00000000..619429ae
--- /dev/null
+++ b/lib/VNDB/Util/Response.pm
@@ -0,0 +1,238 @@
+
+package VNDB::Util::Response;
+
+
+use strict;
+use warnings;
+use POSIX ();
+use Encode;
+use XML::Writer;
+use Compress::Zlib;
+use Exporter 'import';
+require bytes;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $NTL::VERSION;
+@EXPORT = qw| ResRedirect ResNotFound ResDown ResDenied ResFile
+ ResForceBody ResSetContentType ResAddHeader ResAddTpl ResAddDefaultStuff
+ ResStartXML ResGetXML ResGetBody ResGet ResGetCGI ResSetModPerl |;
+
+sub new {
+ my $self = shift;
+ my $tplo = shift;
+ my $type = ref($self) || $self;
+ my $me = bless {
+ headers => [ ],
+ contenttype => 'text/html; charset=UTF-8',
+ code => 200,
+ tplo => $tplo,
+ tpl => { },
+ body => undef,
+ xmlobj => undef,
+ xmldata => undef,
+ whattouse => 1,
+ rc => 0,
+ }, $type;
+
+ return $me;
+}
+
+
+## Some ready-to-use methods
+sub ResRedirect {
+ my $self = shift;
+ my $url = shift; # should start with '/', if no URL specified, use referer or '/'
+ my $type = shift;
+ my $info = $self->{_Res} || $self;
+
+ if(!$url) {
+ $url = "/";
+ my $ref = $self->ReqHeader('Referer');
+ ($url = $ref) =~ s/^$self->{root_url}// if $ref;
+ }
+
+ my $code = !$type ? 301 :
+ $type eq 'temp' ? 307 :
+ $type eq 'post' ? 303 : 301;
+ $info->{code} = $code;
+ $info->{tpl} = {
+ error => {
+ url => $url,
+ code => $code,
+ }
+ };
+ $info->{headers} = [ 'Location', "$self->{root_url}$url" ];
+ $info->{contenttype} = 'text/html; charset=UTF-8';
+ $info->{whattouse} = 2;
+}
+
+sub ResNotFound {
+ my $s = shift;
+ my $i = $s->{_Res};
+ $i->{code} = 404;
+ $i->{whattouse} = 4;
+ push @{$i->{headers}}, 'X-Sendfile' => '/www/vndb/www/files/notfound.html';
+}
+
+sub ResDown {
+ my $self = shift;
+ my $msg = shift || '';
+ my $info = $self->{_Res} || $self;
+
+ $info->{code} = 200;
+ $info->{tpl} = {
+ error => {
+ code => 1,
+ msg => $msg, # specifies which message should be displayed
+ }
+ };
+ $info->{contenttype} = 'text/html; charset=UTF-8';
+ $info->{whattouse} = 2;
+}
+
+sub ResDenied {
+ my $self = shift;
+ $self->ResRedirect('/u/register?n=1', 'temp');
+}
+
+sub ResFile {
+ my($s,$f,@h) = @_;
+ my $i = $s->{_Res};
+ $i->{whattouse} = 4;
+ $i->{code} = 200;
+ $i->{contenttype} = '';
+ push @{$i->{headers}},
+ 'X-Sendfile' => $f,
+ 'Cache-Control' => sprintf('max-age=%d, public', 7*24*3600),
+ @h;
+}
+
+## And some often-used methods
+sub ResForceBody {
+ my $self = shift;
+ my $body = shift;
+ my $info = $self->{_Res} || $self;
+ $info->{whattouse} = 1;
+ $info->{body} = $body;
+}
+
+sub ResSetContentType {
+ my $self = shift;
+ my $ctype = shift;
+ my $info = $self->{_Res} || $self;
+ $info->{contenttype} = $ctype;
+ return 1;
+}
+
+sub ResAddHeader {
+ my $self = shift;
+ die("Odd number in parameters, must be in key => value format!") unless ((@_ % 2) == 0);
+ my $info = $self->{_Res} || $self;
+ $info->{headers} = [ @{$info->{headers}}, @_ ];
+ return 1;
+}
+
+sub ResAddTpl {
+ my $self = shift;
+ die("Odd number in parameters, must be in key=>value format") unless ((@_ % 2) == 0);
+ my $info = $self->{_Res} || $self;
+ $info->{tpl} = { page => { } } if !$info->{tpl}->{page};
+ $info->{tpl}->{page} = { %{$info->{tpl}->{page}}, @_ };
+ $info->{whattouse} = 2;
+ return 1;
+}
+
+sub ResStartXML {
+ my $self = shift;
+ my $info = $self->{_Res} || $self;
+ $info->{xmldata} = undef;
+ $info->{xmlobj} = XML::Writer->new(
+ OUTPUT => \$info->{xmldata},
+ NEWLINES => 0,
+ ENCODING => 'UTF-8',
+ DATA_MODE => 1,
+ DATA_INDENT => 2,
+ );
+ $info->{xmlobj}->xmlDecl();
+ $info->{contenttype} = "text/xml; charset=UTF-8";
+ # disable caching on XML content, IE < 7 has "some" bugs...
+ $self->ResAddHeader('Cache-Control' => 'must-revalidate, post-check=0, pre-check=0',
+ 'Pragma' => 'public');
+ $info->{whattouse} = 3;
+ return $info->{xmlobj};
+}
+
+## And of course some methods to get the information
+sub ResGetXML {
+ my $self = shift;
+ my $info = $self->{_Res} || $self;
+ return undef if !$info->{xmlobj} || !$info->{xmldata};
+ $info->{xmlobj}->end();
+ my $tmpvar = $info->{xmldata};
+ undef $info->{xmldata};
+ return $tmpvar;
+}
+
+sub ResGetBody {
+ my $self = shift;
+ my $info = $self->{_Res} || $self;
+ my $whattouse = shift || $info->{whattouse};
+ if($whattouse == 1) { return $info->{body}; }
+ if($whattouse == 2) {
+ $self->AddDefaultStuff() if exists $info->{tpl}->{page};
+ my $start = [Time::HiRes::gettimeofday()] if $self->{debug} && $Time::HiRes::VERSION;
+ my $output = $info->{tplo}->compile($info->{tpl});
+ $info->{_tpltime} = Time::HiRes::tv_interval($start) if $self->{debug} && $Time::HiRes::VERSION;
+ return $output;
+ }
+ if($whattouse == 3) { return $self->ResGetXML; }
+}
+
+sub ResGet {
+ my $self = shift;
+ my $info = $self->{_Res} || $self;
+ my $whattouse = shift || $info->{whattouse};
+
+ return ($info->{code}, $info->{headers}, $info->{contenttype}, $self->ResGetBody($whattouse));
+}
+
+
+my %scodes = (
+ # just a few useful codes
+ 200 => 'OK',
+ 301 => 'Moved Permanently',
+ 302 => 'Found',
+ 303 => 'See Other',
+ 304 => 'Not Modified',
+ 307 => 'Temporary Redirect',
+ 403 => 'Forbidden',
+ 404 => 'Not Found',
+ 500 => 'Internal Server Error'
+);
+
+# don't rename!
+sub ResSetModPerl {
+ my $s = shift;
+ my $i = $s->{_Res};
+ printf "Status: %d %s\r\n", $i->{code}, $scodes{$i->{code}};
+ print "X-Powered-By: Perl\r\n";
+ printf "Content-Type: %s\r\n", $i->{contenttype} if $i->{contenttype};
+ my $c=0;
+ printf "%s: %s\r\n", $i->{headers}[$c++], $i->{headers}[$c++]
+ while ($c<$#{$i->{headers}});
+
+ my $b = $s->ResGetBody||'';
+ if($b && $s->ReqHeader('Accept-Encoding') =~ /gzip/ && $i->{contenttype} =~ /^text/) {
+ my $ol = bytes::length($b) if $s->{debug};
+ $b = Compress::Zlib::memGzip(Encode::encode_utf8($b));
+ $i->{_gzip} = [ $ol, bytes::length($b) ];
+ print "Content-Encoding: gzip\n";
+ }
+ my $l = bytes::length($b);
+ printf "Content-Length: %d\r\n", $l if $l;
+ print "\r\n";
+ print $b;
+ $FCGI::Handler::outputted = 1;
+}
+
+1;
diff --git a/lib/VNDB/Util/Template.pm b/lib/VNDB/Util/Template.pm
new file mode 100644
index 00000000..f9c63998
--- /dev/null
+++ b/lib/VNDB/Util/Template.pm
@@ -0,0 +1,235 @@
+# VNDB::Util::Template - A direct copy of NTL::Util::Template
+
+# This file has not been edited for at least a year,
+# and there's probably no need to do so in the near future
+
+# template specific stuff:
+# [[ perl code to execute at the specified place ]]
+# [[= perl code, append return value to the template at the specified place ]]
+# [[: same as above, but escape special HTML chars (<, >, &, " and \n) ]]
+# [[% same as above, but also escape as an URL (expects UTF-8 strings) ]]
+# [[! perl code, append at the top of the script (useful for subroutine-declarations etc) ]]
+# [[+ path to a file to include, relative to $searchdir ]]
+
+package VNDB::Util::Template;
+
+use strict;
+use warnings;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+
+
+sub new {
+ my $pack = shift;
+ my %ops = @_;
+ my $me = bless {
+ namespace => __PACKAGE__ . '::tpl',
+ pre_chomp => 0,
+ post_chomp => 0,
+ rm_newlines => 0,
+ %ops,
+ lastreload => 0
+ }, ref($pack) || $pack;
+
+ $me->{mainfile} = sprintf '%s/%s', $me->{searchdir}, $me->{filename};
+
+ die "No filename specified!" if !$me->{filename};
+ die "No searchdir specified!" if !$me->{searchdir};
+ die "Filename does not exist!" if !-e $me->{mainfile};
+ die "No place for the compiled script specified!" if !$me->{compiled};
+
+ $me->includescript();
+
+ return $me;
+}
+
+sub includescript {
+ my $self = shift;
+
+ my $dt = 0;
+ my $dc = (stat($self->{compiled}))[9] || 0;
+
+ if(-s $self->{compiled} && !exists $INC{$self->{compiled}}) {
+ eval { require $self->{compiled}; };
+ if(!$@) {
+ $self->{lastreload} = $dc;
+ } else {
+ # make sure we can fix the problem and try again
+ $INC{$self->{compiled}} = $self->{compiled};
+ die $@;
+ }
+ }
+
+ my $T_version = eval(sprintf '$%s::VERSION;', $self->{namespace});
+
+ if($dc > $self->{lastreload} || !$T_version) {
+ $dt = 1;
+ }
+ elsif($self->{deep_reload} && $T_version >= 0.1) {
+ my @T_files = @{ eval(sprintf '\@%s::T_FILES;', $self->{namespace}) };
+ if($#T_files >= 0) {
+ foreach (@T_files) {
+ if((stat(sprintf('%s/%s', $self->{searchdir}, $_)))[9] > $dc) {
+ $dt = 2;
+ last;
+ }
+ }
+ }
+ } elsif((stat($self->{mainfile}))[9] > $dc) {
+ $dt = 2;
+ }
+ if($dt) {
+ $self->compiletpl() if $dt == 2 || $dc <= $self->{lastreload};
+ delete $INC{$self->{compiled}};
+ eval { require $self->{compiled}; };
+ if(!$@) {
+ warn "Reloaded template\n";
+ } else {
+ $INC{$self->{compiled}} = $self->{compiled};
+ warn "Template contains errors, not reloading\n";
+ }
+ $self->{lastreload} = (stat($self->{compiled}))[9];
+ }
+}
+
+sub compile {
+ my $self = shift;
+ my $X = shift;
+ $self->includescript();
+
+ return $self->{namespace}->compile($X);
+}
+
+sub compiletpl {
+ my $self = shift;
+ open(my $T, '>', $self->{compiled}) || die sprintf '%s: %s', $self->{compiled}, $!;
+ printf $T <<__, __PACKAGE__, $self->{namespace}, ($self->compilefile());
+# Compiled from a template by %s
+package %s;
+
+use strict;
+use warnings;
+no warnings qw(redefine);
+use URI::Escape \'uri_escape_utf8\';
+
+our \$VERSION = 0.1;
+our \@T_FILES = qw| %s |;
+
+sub _hchar { local\$_=shift||return\'\';s/&/&/g;s/</g;s/>/>/g;s/"/"/g;s/\\r?\\n/ /g;return\$_; }
+sub _huri { _hchar(uri_escape_utf8((scalar shift)||return \'\')) }
+%s
+%s
+%s
+1;
+__
+ close($T);
+ warn "Recompiled template\n";
+}
+
+sub compilefile {
+ my $self = shift;
+ my $file = shift||$self->{filename};
+ my $func = shift||'compile';
+
+ my $files = $file;
+ $file = sprintf('%s/%s', $self->{searchdir}, $file);
+ open(my $F, '<', $file) || die "$file: $!";
+ my $tpl = '';
+ $tpl .= $_ while(<$F>);
+ close($F);
+ my @t = split(//, $tpl);
+ $tpl = undef;
+
+ my $inperl = 0;
+ my $top = '';
+ my $R = '';
+ my $bottom = '';
+ my $dat = '';
+ my $perl = '';
+
+ for(my $i=0; $i<=$#t; $i++) {
+ # [[= (2), [[: (3) and [[% (4)
+ if(!$inperl && $t[$i] eq '[' && $t[$i+1] eq '[' && $t[$i+2] =~ /[=:%]/) {
+ $i+=2;
+ if($t[$i] eq '=') {
+ $inperl=2;
+ $perl = '\' . ( scalar ';
+ } elsif($t[$i] eq ':') {
+ $inperl=3;
+ $perl = '\' . _hchar( scalar ';
+ } else {
+ $inperl=4;
+ $perl = '\' . _huri( scalar ';
+ }
+ $R .= $self->_pd($dat);
+ } elsif($inperl >= 2 && $inperl <= 4 && $t[$i] eq ']' && $t[$i+1] eq ']') {
+ $inperl=0; $i++;
+ $R .= $perl . "\n) . '";
+ $dat = '';
+ # [[! (5)
+ } elsif(!$inperl && $t[$i] eq '[' && $t[$i+1] eq '[' && $t[$i+2] eq '!') {
+ $inperl=5; $i+=2;
+ $perl = '';
+ $R .= $self->_pd($dat);
+ } elsif($inperl == 5 && $t[$i] eq ']' && $t[$i+1] eq ']') {
+ $inperl=0; $i++;
+ $top .= $perl . "\n";
+ $dat = '';
+ # [[+ (6)
+ } elsif(!$inperl && $t[$i] eq '[' && $t[$i+1] eq '[' && $t[$i+2] eq '+') {
+ $inperl=6; $i+=2;
+ $R .= $self->_pd($dat);
+ $perl = '';
+ } elsif($inperl == 6 && $t[$i] eq ']' && $t[$i+1] eq ']') {
+ $inperl=0;$i++;
+ $perl =~ s/[\r\n\s]//g;
+ die "Invalid file specified: $perl\n" if $perl !~ /^[a-zA-Z0-9-_\.\/]+$/;
+ (my $func = $perl) =~ s/[^a-zA-Z0-9_]/_/g;
+ my($ifiles, $itop, $imid, $ibot) = $self->compilefile($perl, "T_$func");
+ $files .= ' ' . $ifiles;
+ $top .= $itop;
+ $bottom .= "\n\n$imid\n$ibot\n";
+ $R .= "' . T_$func(\$X) . '";
+ $dat = '';
+ # [[ (1)
+ } elsif(!$inperl && $t[$i] eq '[' && $t[$i+1] eq '[') {
+ $inperl = 1; $i++;
+ $R .= $self->_pd($dat);
+ $perl = "';\n";
+ } elsif($inperl == 1 && $t[$i] eq ']' && $t[$i+1] eq ']') {
+ $inperl=0; $i++;
+ $R .= $perl . "\n \$R .= '";
+ $dat = '';
+ # data
+ } elsif(!$inperl) {
+ (my $l = $t[$i]) =~ s/'/\\'/;
+ $dat .= $l;
+ } else {
+ $perl .= $t[$i];
+ }
+ }
+ if(!$inperl) {
+ $R .= $self->_pd($dat) . "';\n";
+ } else {
+ die "Error, no ']]' found at $file!\n";
+ }
+ $R = "sub $func {
+ my \$X = \$_[". ($func eq 'compile' ? 1 : 0) . "];
+ my \$R = '".$R."
+ return \$R;
+ }";
+ return($files, $top, $R, $bottom);
+}
+
+sub _pd { # Parse Dat
+ my $self = shift;
+ local $_ = shift;
+
+ s/[\r\n\s]+$//g if $_ !~ s/-$// && $self->{pre_chomp};
+ s/^[\r\n\s]+//g if $_ !~ s/^-// && $self->{post_chomp};
+ s/([\s\t]*)[\r\n]+([\s\t]*)/{ $1||$2?' ':'' }/eg if $self->{rm_newlines};
+ return $_;
+}
+
+1;
diff --git a/lib/VNDB/Util/Tools.pm b/lib/VNDB/Util/Tools.pm
new file mode 100644
index 00000000..4c873b55
--- /dev/null
+++ b/lib/VNDB/Util/Tools.pm
@@ -0,0 +1,145 @@
+
+package VNDB::Util::Tools;
+
+use strict;
+use warnings;
+use Encode;
+use Exporter 'import';
+
+our $VERSION = $VNDB::VERSION;
+our @EXPORT = qw| FormCheck AddHid SendMail AddDefaultStuff |;
+
+
+# Improved version of ParamsCheck
+# - hashref instead of hash
+# - parameters don't start with form*
+sub FormCheck {
+ my $self = shift;
+ my @ps = @_;
+ my %hash; my @err;
+
+ foreach my $i (0..$#ps) {
+ next if !$ps[$i] || ref($ps[$i]) ne 'HASH';
+ my $k = $ps[$i]{name};
+ $hash{$k} = [ ( $self->ReqParam($k) ) ];
+ $hash{$k}[0] = '' if !defined $hash{$k}[0];
+ foreach my $j (0..$#{$hash{$k}}) {
+ my $val = \$hash{$k}[$j]; my $e = 0;
+ $e = 1 if !$e && $ps[$i]{required} && !$$val && length($$val) < 1 && $$val ne '0';
+ $e = 2 if !$e && $ps[$i]{minlength} && length($$val) < $ps[$i]{minlength};
+ $e = 3 if !$e && $ps[$i]{maxlength} && length($$val) > $ps[$i]{maxlength};
+ if(!$e && $ps[$i]{template}) {
+ my $t = $ps[$i]{template};
+ $hash{$k}[$j] = lc $hash{$k}[$j] if $t eq 'pname';
+ $e = 4 if ($t eq 'mail' && $$val !~ # From regexlib.com, author: Gavin Sharp
+ /^(([A-Za-z0-9]+_+)|([A-Za-z0-9]+\-+)|([A-Za-z0-9]+\.+)|([A-Za-z0-9]+\++))*[A-Za-z0-9]+\@((\w+\-+)|(\w+\.))*\w{1,63}\.[a-zA-Z]{2,6}$/)
+ || ($t eq 'url' && $$val !~ # From regexlib.com, author: M H
+ /^(http|https):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&:\/~\+#]*[\w\-\@?^=%&\/~\+#])?$/)
+ || ($t eq 'pname' && $$val !~ /^[a-z0-9][a-z0-9\-]*$/)
+ || ($t eq 'asciiprint' && $$val !~ /^[\x20-\x7E]*$/)
+ || ($t eq 'int' && $$val !~ /^\-?[0-9]+$/)
+ || ($t eq 'date' && $$val !~ /^[0-9]{4}(-[0-9]{2}(-[0-9]{2})?)?$/);
+ }
+ $e = 5 if !$e && $ps[$i]{enum} && ref($ps[$i]{enum}) eq "ARRAY" && !_inarray($$val, $ps[$i]{enum});
+ if($e) {
+ if($ps[$i]{required}) {
+ my $errc = $ps[$i]{name}.'_'.$e;
+ $errc .= '_'.$ps[$i]{minlength} if $e == 2;
+ $errc .= '_'.$ps[$i]{maxlength} if $e == 3;
+ $errc .= '_'.$ps[$i]{template} if $e == 4;
+ push(@err, $errc);
+ last;
+ } else {
+ $hash{$k}[$j] = exists $ps[$i]{default} ? $ps[$i]{default} : undef;
+ }
+ }
+ last if !$ps[$i]{multi};
+ }
+ $hash{$k} = $hash{$k}[0] if !$ps[$i]{multi};
+ }
+ $hash{_err} = $#err >= 0 ? \@err : 0;
+
+ return \%hash;
+}
+
+sub AddHid {
+ my $fh = $_[0]->FormCheck({ name => 'fh', required => 0, maxlength => 30 })->{fh};
+ $_[1]->{_hid} = { map { $_ => 1 } 'com', 'mod', split /,/, $fh }
+ if $fh;
+}
+
+sub _inarray { # errr... this is from when I didn't know about grep
+ foreach (@{$_[1]}) {
+ (return 1) if $_[0] eq $_;
+ }
+ return 0;
+}
+
+
+sub SendMail {
+ my $self = shift;
+ my $body = shift;
+ my %hs = @_;
+
+ die "No To: specified!\n" if !$hs{To};
+ die "No Subject specified!\n" if !$hs{Subject};
+ $hs{'Content-Type'} ||= 'text/plain; charset=\'UTF-8\'';
+ $hs{From} ||= 'vndb ';
+ $hs{'X-mailer'} ||= "VNDB $VERSION";
+ $body =~ s/\r?\n/\n/g; # force a '\n'-linebreak
+
+ my $mail = '';
+ foreach (keys %hs) {
+ $hs{$_} =~ s/[\r\n]//g;
+ $mail .= sprintf "%s: %s\n", $_, $hs{$_};
+ }
+ $mail .= sprintf "\n%s", $body;
+
+ if(open(my $mailer, "|/usr/sbin/sendmail -t -f '$hs{From}'")) {
+ print $mailer encode('UTF-8', $mail);
+ die "Error running sendmail ($!)"
+ if !close($mailer);
+ } else {
+ die "Error opening sendail: $!";
+ }
+}
+
+sub AddDefaultStuff {
+ my $self = shift;
+
+ $self->AuthAddTpl;
+ $self->ResAddTpl(st => $self->{static_url});
+
+ $self->ResAddTpl('Stat'.$_, $self->DBTableCount($_))
+ for (qw|users producers vn releases votes|);
+
+ # development shit
+ if($self->{debug}) {
+ my $sqls;
+ for (@{$self->{_DB}->{Queries}}) {
+ $_->[0] =~ s/^\s//g;
+ $sqls .= sprintf("[%6.2fms] %s\n", $_->[1]*1000, $_->[0] || '[undef]');
+ }
+ $self->ResAddTpl(devshit => $sqls);
+ }
+}
+
+1;
+
+__END__
+# from HTTP::Date, small function, so why load an entire module?
+{
+ my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
+ my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+
+ sub time2str {
+ my $time = shift;
+ $time = time unless defined $time;
+ my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
+ sprintf('%s, %02d %s %04d %02d:%02d:%02d GMT',
+ $DoW[$wday],
+ $mday, $MoY[$mon], $year+1900,
+ $hour, $min, $sec);
+ }
+}
+
diff --git a/lib/VNDB/VN.pm b/lib/VNDB/VN.pm
new file mode 100644
index 00000000..f2340037
--- /dev/null
+++ b/lib/VNDB/VN.pm
@@ -0,0 +1,380 @@
+
+package VNDB::VN;
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5;
+require bytes;
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| VNPage VNEdit VNLock VNDel VNHide VNBrowse VNXML VNUpdReverse VNRecreateRel |;
+
+
+sub VNPage {
+ my $self = shift;
+ my $id = shift;
+ my $page = shift || '';
+
+ my $r = $self->FormCheck(
+ { name => 'rev', required => 0, default => 0, template => 'int' },
+ { name => 'diff', required => 0, default => 0, template => 'int' },
+ );
+
+ my $v = $self->DBGetVN(
+ id => $id,
+ what => 'extended relations categories'.($r->{rev} ? ' changes' : ''),
+ $r->{rev} ? ( rev => $r->{rev} ) : ()
+ )->[0];
+ return $self->ResNotFound if !$v->{id};
+
+ $r->{diff} ||= $v->{prev} if $r->{rev};
+ my $c = $r->{diff} && $self->DBGetVN(id => $id, rev => $r->{diff}, what => 'extended changes relations categories')->[0];
+ $v->{next} = $self->DBGetHist(type => 'v', id => $id, next => $v->{cid}, showhid => 1)->[0]{id} if $r->{rev};
+
+ if($page eq 'rg' && $v->{rgraph}) {
+ open(my $F, '<', sprintf '%s/%02d/%d.cmap', $self->{mappath}, $v->{rgraph}%50, $v->{rgraph}) || die $!;
+ $v->{rmap} = join('', (<$F>));
+ close($F);
+ }
+
+ $self->ResAddTpl(vnpage => {
+ vote => $self->AuthInfo->{id} ? $self->DBGetVotes(uid => $self->AuthInfo->{id}, vid => $id)->[0] : {},
+ list => $self->AuthInfo->{id} ? $self->DBGetVNList(uid => $self->AuthInfo->{id}, vid => $id)->[0] : {},
+ rel => scalar $self->DBGetRelease(vid => $id, what => 'producers platforms'),
+ vn => $v,
+ prev => $c,
+ page => $page,
+ change => $r->{diff}||$r->{rev},
+ $page eq 'stats' ? (
+ lists => {
+ latest => scalar $self->DBGetVNList(vid => $id, results => 7),
+ graph => $self->DBVNListStats(vid => $id),
+ },
+ votes => {
+ latest => scalar $self->DBGetVotes(vid => $id, results => 10),
+ graph => $self->DBVoteStats(vid => $id),
+ },
+ ) : (),
+ });
+}
+
+
+sub VNEdit {
+ my $self = shift;
+ my $id = shift; # 0 = new
+
+ my $rev = $self->FormCheck({ name => 'rev', required => 0, default => 0, template => 'int' })->{rev};
+
+ my $v = $self->DBGetVN(id => $id, what => 'extended changes relations categories', $rev ? ( rev => $rev ) : ())->[0] if $id;
+ return $self->ResNotFound() if $id && !$v;
+
+ return $self->ResDenied if !$self->AuthCan('edit') || ($v->{locked} && !$self->AuthCan('lock'));
+
+ my %b4 = $id ? (
+ ( map { $_ => $v->{$_} } qw| title desc alias img_nsfw length l_wp l_cisv l_vnn | ),
+ relations => join('|||', map { $_->{relation}.','.$_->{id}.','.$_->{title} } @{$v->{relations}}),
+ categories => join(',', map { $_->[0].$_->[1] } sort { $a->[0] cmp $b->[0] } @{$v->{categories}}),
+ ) : ();
+
+ my $frm = {};
+ if($self->ReqMethod() eq 'POST') {
+ $frm = $self->FormCheck(
+ { name => 'title', required => 1, maxlength => 250 },
+ { name => 'alias', required => 0, maxlength => 500, default => '' },
+ { name => 'desc', required => 1, maxlength => 10240 },
+ { name => 'length', required => 0, enum => [ 0..($#$VNDB::VNLEN+1) ], default => 0 },
+ { name => 'l_wp', required => 0, default => '', maxlength => 150 },
+ { name => 'l_cisv', required => 0, default => 0, template => 'int' },
+ { name => 'l_vnn', required => 0, default => 0, template => 'int' },
+ { name => 'img_nsfw', required => 0 },
+ { name => 'categories', required => 0, default => '' },
+ { name => 'relations', required => 0, default => 0 },
+ { name => 'comm', required => 0, default => '' },
+ );
+ $frm->{img_nsfw} = $frm->{img_nsfw} ? 1 : 0;
+
+ return $self->ResRedirect('/v'.$id, 'post')
+ if $id && !$self->ReqParam('img') && 10 == scalar grep { $b4{$_} eq $frm->{$_} } keys %b4;
+
+ my $relations = [ map { /^([0-9]+),([0-9]+)/ && $2 != $id ? ( [ $1, $2 ] ) : () } split /\|\|\|/, $frm->{relations} ];
+ my $cat = [ map { [ substr($_,0,3), substr($_,3,1) ] } split /,/, $frm->{categories} ];
+
+ # upload image
+ my $imgid = '';
+ if($self->ReqParam('img')) {
+ my $tmp = sprintf '%s/00/tmp.%d.jpg', $self->{imgpath}, $$*int(rand(1000)+1);
+ $self->ReqSaveUpload('img', $tmp);
+
+ my $l;
+ open(my $T, '<:raw:bytes', $tmp) || die $1;
+ read $T, $l, 2;
+ seek $T, 0, 0;
+ my($x, $y) = jpegsize($T);
+ close($T);
+
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'nojpeg' ] : [ 'nojpeg' ]
+ if $l ne pack('H*', 'ffd8');
+ if(!$frm->{_err}) {
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'toolarge' ] : [ 'toolarge' ]
+ if -s $tmp > 51200; # 50 KB max.
+ $frm->{_err} = $frm->{_err} ? [ @{$frm->{_err}}, 'imgsize' ] : [ 'imgsize' ]
+ if $x > 256 || $y > 400; # 256x400 max
+ }
+
+ if($frm->{_err}) {
+ unlink $tmp;
+ } else {
+ $imgid = $self->DBIncId('covers_seq');
+ my $new = sprintf '%s/%02d/%d.jpg', $self->{imgpath}, $imgid%50, $imgid;
+ rename $tmp, $new or die $!;
+ chmod 0666, $new;
+ }
+ } elsif($id) {
+ $imgid = $v->{image};
+ }
+
+ my %args = (
+ ( map { $_ => $frm->{$_} } qw| title desc alias comm length l_wp l_cisv l_vnn img_nsfw| ),
+ image => $imgid,
+ relations => $relations,
+ categories => $cat,
+ );
+
+ if(!$frm->{_err}) {
+ my($oid, $cid) = ($id, 0);
+ $cid = $self->DBEditVN($id, %args) if $id; # edit
+ ($id, $cid) = $self->DBAddVN(%args) if !$id; # add
+
+ # update reverse relations and relation graph
+ if((!$oid && $#$relations >= 0) || ($oid && $frm->{relations} ne $b4{relations})) {
+ my %old = $oid ? (map { $_->{id} => $_->{relation} } @{$v->{relations}}) : ();
+ my %new = map { $_->[1] => $_->[0] } @$relations;
+ $self->VNRecreateRel($id, $self->VNUpdReverse(\%old, \%new, $id, $cid));
+ }
+
+ return $self->ResRedirect('/v'.$id.'?rev='.$cid, 'post');
+ }
+ }
+
+ if($id) {
+ $frm->{$_} ||= $b4{$_} for (keys %b4);
+ $frm->{comm} = sprintf 'Reverted to revision %d by %s.', $v->{cid}, $v->{username} if $v->{cid} != $v->{latest};
+ } else {
+ $frm->{categories} = 0;
+ }
+
+ $self->AddHid($frm);
+ $frm->{_hid} = {map{$_=>1} qw| info cat img |}
+ if !$frm->{_hid} && !$id;
+ $self->ResAddTpl(vnedit => {
+ form => $frm,
+ id => $id,
+ vn => $v,
+ });
+}
+
+
+sub VNDel {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id)->[0];
+ return $self->ResNotFound if !$v;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBDelVN($id);
+ return $self->ResRedirect('/v', 'perm');
+}
+
+
+sub VNLock {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id)->[0];
+ return $self->ResNotFound() if !$v;
+ return $self->ResDenied if !$self->AuthCan('lock');
+ $self->DBLockItem('vn', $id, $v->{locked}?0:1);
+ $self->DBLockItem('releases', $_->{id}, $v->{locked}?0:1)
+ for (@{$self->DBGetRelease(vid => $id)});
+ return $self->ResRedirect('/v'.$id, 'perm');
+}
+
+
+sub VNHide {
+ my $self = shift;
+ my $id = shift;
+
+ my $v = $self->DBGetVN(id => $id, what => 'relations')->[0];
+ return $self->ResNotFound() if !$v;
+ return $self->ResDenied if !$self->AuthCan('del');
+ $self->DBHideVN($id, $v->{hidden}?0:1);
+ $self->VNRecreateRel($id, $self->VNUpdReverse({ map { $_->{id} => $_->{relation} } @{$v->{relations}} }, {}, $id, 0))
+ if @{$v->{relations}};
+ return $self->ResRedirect('/v'.$id, 'perm');
+}
+
+
+sub VNBrowse {
+ my $self = shift;
+ my $chr = shift;
+ $chr = 'all' if !defined $chr;
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 0, default => 'title', enum => [ qw|title released votes| ] },
+ { name => 'o', required => 0, default => 'a', enum => [ 'a','d' ] },
+ { name => 'i', required => 0, default => '' },
+ { name => 'e', required => 0, default => '' },
+ { name => 'l', required => 0, default => '' },
+ { name => 'q', required => 0},
+ { name => 'p', required => 0, template => 'int', default => 1},
+ );
+
+ my($r, $np) = $chr ne 'cat' || $f->{e} || $f->{i} || $f->{l} ? ($self->DBGetVN(
+ $chr =~ /^[a-z0]$/ ? (
+ char => $chr ) : (),
+ $chr eq 'search' && $f->{q} ? (
+ search => $f->{q} ) : (),
+ page => $f->{p},
+ $chr eq 'cat' ? (
+ cati => [ split /,/, $f->{i} ],
+ cate => [ split /,/, $f->{e} ],
+ lang => [ grep { $VNDB::LANG->{$_} } split /,/, $f->{l} ],
+ ) : (),
+ results => 50,
+ order => {title => 'vr.title', released => 'v.c_released', votes => 'v.c_votes'
+ }->{$f->{s}}.{a=>' ASC',d=>' DESC'}->{$f->{o}},
+ )) : ([], 0);
+
+ $self->ResRedirect('/v'.$r->[0]{id}, 'temp')
+ if $chr eq 'search' && $#$r == 0;
+
+ $self->ResAddTpl(vnbrowse => {
+ vn => $r,
+ npage => $np,
+ page => $f->{p},
+ chr => $chr,
+ $chr eq 'cat' ? (
+ incl => $f->{i},
+ excl => $f->{e},
+ cat => $self->DBCategoryCount,
+ lang => $self->DBLanguageCount,
+ slang => $f->{l},
+ ) : (),
+ order => [ $f->{s}, $f->{o} ],
+ },
+ searchquery => $f->{q});
+}
+
+
+sub VNXML {
+ my $self = shift;
+
+ my $q = $self->FormCheck(
+ { name => 'q', required => 0, maxlength => 100 }
+ )->{q};
+
+ my $r = [];
+ if($q) {
+ ($r,undef) = $self->DBGetVN(results => 10,
+ $q =~ /^v([0-9]+)$/ ? (id => $1) : (search => $q));
+ }
+
+ my $x = $self->ResStartXML;
+ $x->startTag('vn', results => $#$r+1, query => $q);
+ for (@$r) {
+ $x->startTag('item');
+ $x->dataElement(id => $_->{id});
+ $x->dataElement(title => $_->{title});
+ $x->endTag('item');
+ }
+ $x->endTag('vn');
+}
+
+
+
+sub jpegsize {
+ my $stream = shift;
+
+ my $MARKER = "\xFF"; # Section marker.
+
+ my $SIZE_FIRST = 0xC0; # Range of segment identifier codes
+ my $SIZE_LAST = 0xC3; # that hold size info.
+
+ my ($x, $y, $id) = (undef, undef, "could not determine JPEG size");
+
+ my ($marker, $code, $length, $data);
+ my $segheader;
+
+ seek $stream, 2, 0;
+ while (1) {
+ $length = 4;
+ read $stream, $segheader, $length;
+
+ ($marker, $code, $length) = unpack("a a n", $segheader);
+
+ if ($marker ne $MARKER) {
+ $id = "JPEG marker not found";
+ last;
+ } elsif((ord($code) >= $SIZE_FIRST) && (ord($code) <= $SIZE_LAST)) {
+ $length = 5;
+ read $stream, $data, $length;
+ ($y, $x) = unpack("xnn", $data);
+ $id = 'JPG';
+ last;
+ } else {
+ seek $stream, ($length - 2), 1;
+ }
+ }
+ return ($x, $y, $id);
+}
+
+
+# Update reverse relations
+sub VNUpdReverse { # old, new, id, cid
+ my($self, $old, $new, $id, $cid) = @_;
+ my %upd;
+ for (keys %$old, keys %$new) {
+ if(exists $$old{$_} and !exists $$new{$_}) {
+ $upd{$_} = -1;
+ } elsif((!exists $$old{$_} and exists $$new{$_}) || ($$old{$_} != $$new{$_})) {
+ $upd{$_} = $$new{$_};
+ if($VNDB::VRELW->{$upd{$_}}) { $upd{$_}-- }
+ elsif($VNDB::VRELW->{$upd{$_}+1}) { $upd{$_}++ }
+ }
+ }
+
+ for my $i (keys %upd) {
+ my $r = $self->DBGetVN(id => $i, what => 'extended relations categories')->[0];
+ my @newrel;
+ $_->{id} != $id && push @newrel, [ $_->{relation}, $_->{id} ]
+ for (@{$r->{relations}});
+ push @newrel, [ $upd{$i}, $id ] if $upd{$i} != -1;
+ $self->DBEditVN($i,
+ relations => \@newrel,
+ comm => 'Reverse relation update caused by revision '.$cid.' of v'.$id,
+ causedby => $cid,
+ uid => 1, # Multi - hardcoded
+ ( map { $_ => $r->{$_} } qw| title desc alias categories img_nsfw length l_wp l_cisv l_vnn image | )
+ );
+ }
+
+ return keys %upd;
+}
+
+
+sub VNRecreateRel { # @ids
+ my($s, @id) = @_;
+ $s->DBCommit; # creates deadlock otherwise
+ my $c = sprintf "%s %s", $s->{grapher}, join(' ', @id);
+ my $o = `$c`;
+ chomp $o;
+ warn "$$s{grapher}: $o\n" if $o;
+}
+
+
+
+1;
+
+
diff --git a/lib/VNDB/VNLists.pm b/lib/VNDB/VNLists.pm
new file mode 100644
index 00000000..c0f1ac1d
--- /dev/null
+++ b/lib/VNDB/VNLists.pm
@@ -0,0 +1,96 @@
+
+package VNDB::VNLists;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| VNListMod VNMyList |;
+
+
+sub VNListMod {
+ my $self = shift;
+ my $vid = shift;
+
+ my $uid = $self->AuthInfo()->{id};
+ return $self->ResDenied() if !$uid;
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 1, enum => [ -1..$#$VNDB::LSTAT ] },
+ { name => 'c', required => 0, default => '', maxlength => 500 },
+ );
+ return $self->ResNotFound if $f->{_err};
+
+ if($f->{s} == -1) {
+ $self->DBDelVNList($uid, $vid);
+ } elsif($self->DBGetVNList(uid => $uid, vid => $vid)->[0]{vid}) {
+ $self->DBEditVNList(uid => $uid, status => $f->{s}, vid => [ $vid ],
+ $f->{s} == 6 ? ( comments => $f->{c} ) : ());
+ } else {
+ $self->DBAddVNList($uid, $vid, $f->{s}, $f->{c});
+ }
+
+ $self->ResRedirect('/v'.$vid, 'temp');
+}
+
+
+sub VNMyList {
+ my $self = shift;
+ my $user = shift;
+
+ my $u = $self->DBGetUser(uid => $user)->[0];
+ return $self->ResNotFound if !$user || !$u || (($self->AuthInfo->{id}||0) != $user && !($u->{flags} & $VNDB::UFLAGS->{list}));
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 0, default => 'title', enum => [ qw|title date| ] },
+ { name => 'o', required => 0, default => 'a', enum => [ 'a','d' ] },
+ { name => 'p', required => 0, template => 'int', default => 1 },
+ { name => 't', required => 0, enum => [ -1..$#$VNDB::LSTAT ], default => -1 },
+ );
+
+ if($self->ReqMethod eq 'POST') {
+ my $frm = $self->FormCheck(
+ { name => 'vnlistchange', required => 1, enum => [ -2..$#$VNDB::LSTAT ] },
+ { name => 'comments', required => 0, default => '', maxlength => 500 },
+ { name => 'sel', required => 1, multi => 1 },
+ );
+ if(!$frm->{_err}) {
+ my @change = map { /^[0-9]+$/ ? $_ : () } @{$frm->{sel}};
+ $self->DBDelVNList($user, @change) if @change && $frm->{vnlistchange} eq '-1';
+ $self->DBEditVNList(
+ uid => $user,
+ vid => \@change,
+ $frm->{vnlistchange} eq '-2' ? (
+ comments => $frm->{comments}
+ ) : (
+ status => $frm->{vnlistchange}
+ ),
+ ) if @change && $frm->{vnlistchange} ne '-1';
+ }
+ }
+
+ my $order = $f->{s} . ($f->{o} eq 'a' ? ' ASC' : ' DESC');
+ my($list, $np) = $self->DBGetVNList(
+ uid => $u->{id},
+ order => $order,
+ results => 50,
+ page => $f->{p},
+ $f->{t} >= 0 ? (
+ status => $f->{t} ) : ()
+ );
+
+ $self->ResAddTpl(vnlist => {
+ npage => $np,
+ page => $f->{p},
+ list => $list,
+ order => [ $f->{s}, $f->{o} ],
+ user => $u,
+ status => $f->{t},
+ });
+}
+
+
+
+1;
diff --git a/lib/VNDB/Votes.pm b/lib/VNDB/Votes.pm
new file mode 100644
index 00000000..a6089b3d
--- /dev/null
+++ b/lib/VNDB/Votes.pm
@@ -0,0 +1,61 @@
+
+package VNDB::Votes;
+
+use strict;
+use warnings;
+use Exporter 'import';
+
+use vars ('$VERSION', '@EXPORT');
+$VERSION = $VNDB::VERSION;
+@EXPORT = qw| VNVote VNVotes |;
+
+
+sub VNVote {
+ my $self = shift;
+ my $id = shift;
+
+ my $uid = $self->AuthInfo()->{id};
+ return $self->ResDenied() if !$uid;
+
+ my $f = $self->FormCheck(
+ { name => 'v', required => 0, default => 0, enum => [ '-1','1'..'10'] }
+ );
+ return $self->ResNotFound() if !$f->{v};
+
+
+ $self->DBDelVote($uid, $id) if $f->{v} == -1 || $self->DBGetVotes(uid => $uid, vid => $id)->[0]{vid};
+ $self->DBAddVote($id, $uid, $f->{v}) if $f->{v} > 0;
+
+ $self->ResRedirect('/v'.$id, 'temp');
+}
+
+
+sub VNVotes {
+ my $self = shift;
+ my $user = shift;
+
+ my $u = $self->DBGetUser(uid => $user)->[0];
+ return $self->ResNotFound if !$user || !$u || (($self->AuthInfo->{id}||0) != $user && !($u->{flags} & $VNDB::UFLAGS->{votes}));
+
+ my $f = $self->FormCheck(
+ { name => 's', required => 0, default => 'date', enum => [ qw|date title vote| ] },
+ { name => 'o', required => 0, default => 'd', enum => [ 'a','d' ] },
+ { name => 'p', required => 0, default => 1, template => 'int' },
+ );
+
+ my $order = $f->{s} . ($f->{o} eq 'a' ? ' ASC' : ' DESC');
+ my ($votes, $np) = $self->DBGetVotes(
+ uid => $u->{id},
+ order => $order,
+ results => 50,
+ page => $f->{p}
+ );
+
+ $self->ResAddTpl(myvotes => {
+ user => $u,
+ votes => $votes,
+ page => $f->{p},
+ npage => $np,
+ order => [ $f->{s}, $f->{o} ],
+ });
+}
diff --git a/lib/global.pl b/lib/global.pl
new file mode 100644
index 00000000..aea66f75
--- /dev/null
+++ b/lib/global.pl
@@ -0,0 +1,569 @@
+package VNDB;
+
+our $PLAT = {
+ win => 'Windows',
+ lin => 'Linux',
+ mac => 'Mac OS',
+ dvd => 'DVD Player',
+ gba => 'Game Boy Advanced',
+ nds => 'Nintendo DS',
+ psp => 'Playstation Portable',
+ ps => 'Playstation',
+ ps2 => 'Playstation 2',
+ dc => 'Dreamcast',
+ sfc => 'Super Nintendo',
+ wii => 'Nintendo Wii',
+ oth => 'Other'
+};
+
+# NOTE: don't forget to update dyna.js
+our $MED = {
+ cd => 'CD',
+ dvd => 'DVD',
+ gdr => 'GD-ROM',
+ blr => 'Blu-Ray disk',
+ in => 'Internet download',
+ pa => 'Patch',
+ otc => 'Other (console)',
+};
+
+our $PROT = {
+ co => 'Company',
+ in => 'Individual',
+ ng => 'Amateur group',
+};
+
+our $RTYP = [
+ 'Complete',
+ 'Partial',
+ 'Trial'
+];
+
+# Yes, this is the category list. No, changing something here may
+# not change it on the entire site - many things are still hardcoded
+our $CAT = {
+ g => [ 'Gameplay', {
+ aa => 'Visual Novel', # 0..1
+ ab => 'Adventure', # 0..1
+ ac => 'Action',
+ rp => 'RPG',
+ st => 'Strategy',
+ si => 'Simulation',
+ } ],
+ p => [ 'Plot', {
+ li => 'Linear', # 0..1
+ br => 'Branching', # 0..1
+ } ],
+ e => [ 'Elements', {
+ ac => 'Action',
+ co => 'Comedy',
+ dr => 'Drama',
+ fa => 'Fantasy',
+ ho => 'Horror',
+ my => 'Mystery',
+ ro => 'Romance',
+ sf => 'SciFi',
+ sj => 'Shoujo Ai',
+ sn => 'Shounen Ai',
+ } ],
+ t => [ 'Time', {
+ fu => 'Future',
+ pa => 'Past',
+ pr => 'Present',
+ } ],
+ l => [ 'Place', {
+ ea => 'Earth',
+ fa => 'Fantasy World',
+ sp => 'Space',
+ } ],
+ s => [ 'Sexual content', {
+ aa => 'Sexual content',
+ be => 'Bestiality',
+ in => 'Incest',
+ lo => 'Lolicon',
+ sh => 'Shotacon',
+ ya => 'Yaoi',
+ yu => 'Yuri',
+ ra => 'Rape',
+ } ],
+};
+
+
+our $LSTAT = [
+ 'Wishlist',
+ 'Blacklist',
+ 'Playing',
+ 'Finished',
+ 'Stalled',
+ 'Dropped',
+ 'Other', # XXX: hardcoded at 6
+];
+
+our $VREL = [
+ 'Sequel',
+ 'Prequel', # 1
+ 'Same setting',
+ 'Alternative setting',
+ 'Alternative version',
+ 'Same characters',
+ 'Side story',
+ 'Parent story',# 7
+ 'Summary',
+ 'Full story', # 9
+ 'Other',
+];
+# these reverse relations need a [relation]-1
+our $VRELW = {map{$_=>1}qw| 1 7 9 |};
+
+
+# users.flags
+our $UFLAGS = {
+ votes => 1,
+ list => 4,
+ nsfw => 8,
+};
+
+
+our $VNLEN = [
+ [ 'Unkown', '', '' ],
+ [ 'Very short', '< 2 hours', 'OMGWTFOTL, A Dream of Summer' ],
+ [ 'Short', '2 - 10 hours', 'Narcissu, Planetarian' ],
+ [ 'Medium', '10 - 30 hours', 'Kana: Little Sister' ],
+ [ 'Long', '30 - 50 hours', 'Tsukihime' ],
+ [ 'Very long', '> 50 hours', 'Clannad' ],
+];
+
+
+our $VRAGES = {
+ -1 => 'Unknown',
+ 0 => 'All ages',
+ map { $_ => $_.'+' } 6..18
+};
+
+
+
+
+
+
+
+our $LANG = {
+# 'aa' => q|Afar|,
+# 'ab' => q|Abkhazian|,
+# 'ace' => q|Achinese|,
+# 'ach' => q|Acoli|,
+# 'ada' => q|Adangme|,
+# 'ady' => q|Adyghe|,
+# 'ae' => q|Avestan|,
+# 'af' => q|Afrikaans|,
+# 'afh' => q|Afrihili|,
+# 'ak' => q|Akan|,
+# 'akk' => q|Akkadian|,
+# 'ale' => q|Aleut|,
+# 'alg' => q|Algonquian languages|,
+# 'am' => q|Amharic|,
+# 'an' => q|Aragonese|,
+# 'apa' => q|Apache languages|,
+# 'ar' => q|Arabic|,
+# 'arc' => q|Aramaic|,
+# 'arn' => q|Araucanian|,
+# 'arp' => q|Arapaho|,
+# 'arw' => q|Arawak|,
+# 'as' => q|Assamese|,
+# 'ast' => q|Asturian|,
+# 'ath' => q|Athapascan languages|,
+# 'aus' => q|Australian languages|,
+# 'av' => q|Avaric|,
+# 'awa' => q|Awadhi|,
+# 'ay' => q|Aymara|,
+# 'az' => q|Azerbaijani|,
+# 'ba' => q|Bashkir|,
+# 'bad' => q|Banda|,
+# 'bai' => q|Bamileke languages|,
+# 'bal' => q|Baluchi|,
+# 'ban' => q|Balinese|,
+# 'bas' => q|Basa|,
+# 'be' => q|Belarusian|,
+# 'bej' => q|Beja|,
+# 'bem' => q|Bemba|,
+# 'bg' => q|Bulgarian|,
+# 'bh' => q|Bihari|,
+# 'bho' => q|Bhojpuri|,
+# 'bi' => q|Bislama|,
+# 'bik' => q|Bikol|,
+# 'bin' => q|Bini|,
+# 'bla' => q|Siksika|,
+# 'bm' => q|Bambara|,
+# 'bn' => q|Bengali|,
+# 'bo' => q|Tibetan|,
+# 'br' => q|Breton|,
+# 'bra' => q|Braj|,
+# 'bs' => q|Bosnian|,
+# 'btk' => q|Batak (Indonesia)|,
+# 'bua' => q|Buriat|,
+# 'bug' => q|Buginese|,
+# 'ca' => q|Catalan|,
+# 'cad' => q|Caddo|,
+# 'car' => q|Carib|,
+# 'ce' => q|Chechen|,
+# 'ceb' => q|Cebuano|,
+# 'ch' => q|Chamorro|,
+# 'chb' => q|Chibcha|,
+# 'chg' => q|Chagatai|,
+# 'chk' => q|Chuukese|,
+# 'chm' => q|Mari|,
+# 'chn' => q|Chinook Jargon|,
+# 'cho' => q|Choctaw|,
+# 'chp' => q|Chipewyan|,
+# 'chr' => q|Cherokee|,
+# 'chy' => q|Cheyenne|,
+# 'cmc' => q|Chamic languages|,
+# 'co' => q|Corsican|,
+# 'cop' => q|Coptic|,
+# 'cr' => q|Cree|,
+# 'crh' => q|Crimean Turkish|,
+ 'cs' => q|Czech|,
+# 'csb' => q|Kashubian|,
+# 'cu' => q|Church Slavic|,
+# 'cv' => q|Chuvash|,
+# 'cy' => q|Welsh|,
+ 'da' => q|Danish|,
+# 'dak' => q|Dakota|,
+# 'dar' => q|Dargwa|,
+# 'day' => q|Dayak|,
+ 'de' => q|German|,
+# 'del' => q|Delaware|,
+# 'dgr' => q|Dogrib|,
+# 'din' => q|Dinka|,
+# 'doi' => q|Dogri|,
+# 'dua' => q|Duala|,
+# 'dv' => q|Divehi|,
+# 'dyu' => q|Dyula|,
+# 'dz' => q|Dzongkha|,
+# 'ee' => q|Ewe|,
+# 'efi' => q|Efik|,
+# 'eka' => q|Ekajuk|,
+# 'el' => q|Modern Greek|,
+# 'elx' => q|Elamite|,
+ 'en' => q|English|,
+# 'eo' => q|Esperanto|,
+ 'es' => q|Spanish|,
+# 'et' => q|Estonian|,
+# 'eu' => q|Basque|,
+# 'ewo' => q|Ewondo|,
+# 'fa' => q|Persian|,
+# 'fan' => q|Fang|,
+# 'fat' => q|Fanti|,
+# 'ff' => q|Fulah|,
+ 'fi' => q|Finnish|,
+# 'fj' => q|Fijian|,
+# 'fo' => q|Faroese|,
+# 'fon' => q|Fon|,
+ 'fr' => q|French|,
+# 'fur' => q|Friulian|,
+# 'fy' => q|Frisian|,
+ 'ga' => q|Irish|,
+# 'gaa' => q|Ga|,
+# 'gay' => q|Gayo|,
+# 'gba' => q|Gbaya|,
+# 'gd' => q|Scots Gaelic|,
+# 'gez' => q|Geez|,
+# 'gil' => q|Gilbertese|,
+# 'gl' => q|Gallegan|,
+# 'gn' => q|Guarani|,
+# 'gon' => q|Gondi|,
+# 'gor' => q|Gorontalo|,
+# 'got' => q|Gothic|,
+# 'grb' => q|Grebo|,
+# 'grc' => q|Ancient Greek|,
+# 'gu' => q|Gujarati|,
+# 'gv' => q|Manx|,
+# 'gwi' => q|Gwich'in|,
+# 'ha' => q|Hausa|,
+# 'hai' => q|Haida|,
+# 'haw' => q|Hawaiian|,
+# 'he' => q|Hebrew|,
+# 'hi' => q|Hindi|,
+# 'hil' => q|Hiligaynon|,
+# 'him' => q|Himachali|,
+# 'hit' => q|Hittite|,
+# 'hmn' => q|Hmong|,
+# 'ho' => q|Hiri Motu|,
+# 'hr' => q|Croatian|,
+# 'ht' => q|Haitian|,
+# 'hu' => q|Hungarian|,
+# 'hup' => q|Hupa|,
+# 'hy' => q|Armenian|,
+# 'hz' => q|Herero|,
+# 'i-ami' => q|Ami|,
+# 'i-bnn' => q|Bunun|,
+# 'i-klingon' => q|Klingon|,
+# 'i-mingo' => q|Mingo|,
+# 'i-pwn' => q|Paiwan|,
+# 'i-tao' => q|Tao|,
+# 'i-tay' => q|Tayal|,
+# 'i-tsu' => q|Tsou|,
+# 'iba' => q|Iban|,
+# 'id' => q|Indonesian|,
+# 'ie' => q|Interlingue|,
+# 'ig' => q|Igbo|,
+# 'ii' => q|Sichuan Yi|,
+# 'ijo' => q|Ijo|,
+# 'ik' => q|Inupiaq|,
+# 'ilo' => q|Iloko|,
+# 'inh' => q|Ingush|,
+# 'io' => q|Ido|,
+# 'iro' => q|Iroquoian languages|,
+# 'is' => q|Icelandic|,
+ 'it' => q|Italian|,
+# 'iu' => q|Inuktitut|,
+ 'ja' => q|Japanese|,
+# 'jpr' => q|Judeo-Persian|,
+# 'jrb' => q|Judeo-Arabic|,
+# 'jv' => q|Javanese|,
+# 'ka' => q|Georgian|,
+# 'kaa' => q|Kara-Kalpak|,
+# 'kab' => q|Kabyle|,
+# 'kac' => q|Kachin|,
+# 'kam' => q|Kamba|,
+# 'kar' => q|Karen|,
+# 'kaw' => q|Kawi|,
+# 'kbd' => q|Kabardian|,
+# 'kg' => q|Kongo|,
+# 'kha' => q|Khasi|,
+# 'kho' => q|Khotanese|,
+# 'ki' => q|Kikuyu|,
+# 'kj' => q|Kuanyama|,
+# 'kk' => q|Kazakh|,
+# 'kl' => q|Kalaallisut|,
+# 'km' => q|Khmer|,
+# 'kmb' => q|Kimbundu|,
+# 'kn' => q|Kannada|,
+ 'ko' => q|Korean|,
+# 'kok' => q|Konkani|,
+# 'kos' => q|Kosraean|,
+# 'kpe' => q|Kpelle|,
+# 'kr' => q|Kanuri|,
+# 'krc' => q|Karachay-Balkar|,
+# 'kro' => q|Kru|,
+# 'kru' => q|Kurukh|,
+# 'ks' => q|Kashmiri|,
+# 'ku' => q|Kurdish|,
+# 'kum' => q|Kumyk|,
+# 'kut' => q|Kutenai|,
+# 'kv' => q|Komi|,
+# 'kw' => q|Cornish|,
+# 'ky' => q|Kirghiz|,
+# 'la' => q|Latin|,
+# 'lad' => q|Ladino|,
+# 'lah' => q|Lahnda|,
+# 'lam' => q|Lamba|,
+# '#lb' => q|Letzeburgesch|,
+# 'lez' => q|Lezghian|,
+# 'lg' => q|Ganda|,
+# 'li' => q|Limburgish|,
+# 'ln' => q|Lingala|,
+# 'lo' => q|Lao|,
+# 'lol' => q|Mongo|,
+# 'loz' => q|Lozi|,
+# 'lt' => q|Lithuanian|,
+# 'lu' => q|Luba-Katanga|,
+# 'lua' => q|Luba-Lulua|,
+# 'lui' => q|Luiseno|,
+# 'lun' => q|Lunda|,
+# 'luo' => q|Luo (Kenya and Tanzania)|,
+# 'lus' => q|Lushai|,
+# 'lv' => q|Latvian|,
+# 'mad' => q|Madurese|,
+# 'mag' => q|Magahi|,
+# 'mai' => q|Maithili|,
+# 'mak' => q|Makasar|,
+# 'man' => q|Mandingo|,
+# 'mas' => q|Masai|,
+# 'mdf' => q|Moksha|,
+# 'mdr' => q|Mandar|,
+# 'men' => q|Mende|,
+# 'mg' => q|Malagasy|,
+# 'mh' => q|Marshall|,
+# 'mi' => q|Maori|,
+# 'mic' => q|Micmac|,
+# 'min' => q|Minangkabau|,
+# 'mk' => q|Macedonian|,
+# 'ml' => q|Malayalam|,
+# 'mn' => q|Mongolian|,
+# 'mnc' => q|Manchu|,
+# 'mni' => q|Manipuri|,
+# 'mno' => q|Manobo languages|,
+# 'mo' => q|Moldavian|,
+# 'moh' => q|Mohawk|,
+# 'mos' => q|Mossi|,
+# 'mr' => q|Marathi|,
+# 'ms' => q|Malay|,
+# 'mt' => q|Maltese|,
+# 'mul' => q|Multiple languages|,
+# 'mun' => q|Munda languages|,
+# 'mus' => q|Creek|,
+# 'mwr' => q|Marwari|,
+# 'my' => q|Burmese|,
+# 'myn' => q|Mayan languages|,
+# 'myv' => q|Erzya|,
+# 'na' => q|Nauru|,
+# 'nah' => q|Nahuatl|,
+# 'nap' => q|Neapolitan|,
+# 'nb' => q|Norwegian Bokmal|,
+# 'nd' => q|North Ndebele|,
+# 'ne' => q|Nepali|,
+# 'new' => q|Newari|,
+# 'ng' => q|Ndonga|,
+# 'nia' => q|Nias|,
+# 'niu' => q|Niuean|,
+ 'nl' => q|Dutch|,
+ 'no' => q|Norwegian|,
+# 'nog' => q|Nogai|,
+# 'non' => q|Old Norse|,
+# 'nr' => q|South Ndebele|,
+# 'nso' => q|Northern Sotho|,
+# 'nub' => q|Nubian languages|,
+# 'nv' => q|Navajo|,
+# 'ny' => q|Chichewa|,
+# 'nym' => q|Nyamwezi|,
+# 'nyn' => q|Nyankole|,
+# 'nyo' => q|Nyoro|,
+# 'nzi' => q|Nzima|,
+# 'oj' => q|Ojibwa|,
+# 'om' => q|Oromo|,
+# 'or' => q|Oriya|,
+# 'os' => q|Ossetian; Ossetic|,
+# 'osa' => q|Osage|,
+# 'oto' => q|Otomian languages|,
+# 'pa' => q|Panjabi|,
+# 'pag' => q|Pangasinan|,
+# 'pal' => q|Pahlavi|,
+# 'pam' => q|Pampanga|,
+# 'pap' => q|Papiamento|,
+# 'pau' => q|Palauan|,
+# 'phn' => q|Phoenician|,
+# 'pi' => q|Pali|,
+ 'pl' => q|Polish|,
+# 'pon' => q|Pohnpeian|,
+# 'pra' => q|Prakrit languages|,
+# 'ps' => q|Pushto|,
+ 'pt' => q|Portuguese|,
+# 'pt-br' => q|Brazilian Portuguese|,
+# 'pt-pt' => q|Portugal Portuguese|,
+# 'qu' => q|Quechua|,
+# 'raj' => q|Rajasthani|,
+# 'rap' => q|Rapanui|,
+# 'rar' => q|Rarotongan|,
+# 'rm' => q|Raeto-Romance|,
+# 'rn' => q|Rundi|,
+# 'ro' => q|Romanian|,
+# 'rom' => q|Romany|,
+ 'ru' => q|Russian|,
+# 'rw' => q|Kinyarwanda|,
+# 'sa' => q|Sanskrit|,
+# 'sad' => q|Sandawe|,
+# 'sah' => q|Yakut|,
+# 'sal' => q|Salishan languages|,
+# 'sam' => q|Samaritan Aramaic|,
+# 'sas' => q|Sasak|,
+# 'sat' => q|Santali|,
+# 'sc' => q|Sardinian|,
+# 'sco' => q|Scots|,
+# 'sd' => q|Sindhi|,
+# 'se' => q|Northern Sami|,
+# 'sel' => q|Selkup|,
+# 'sg' => q|Sango|,
+# 'shn' => q|Shan|,
+# 'si' => q|Sinhalese|,
+# 'sid' => q|Sidamo|,
+# 'sio' => q|Siouan languages|,
+# 'sk' => q|Slovak|,
+# 'sl' => q|Slovenian|,
+# 'sm' => q|Samoan|,
+# 'sma' => q|Southern Sami|,
+# 'smj' => q|Lule Sami|,
+# 'smn' => q|Inari Sami|,
+# 'sms' => q|Skolt Sami|,
+# 'sn' => q|Shona|,
+# 'snk' => q|Soninke|,
+# 'so' => q|Somali|,
+# 'sog' => q|Sogdian|,
+# 'son' => q|Songhai|,
+# 'sq' => q|Albanian|,
+# 'sr' => q|Serbian|,
+# 'srr' => q|Serer|,
+# 'ss' => q|Swati|,
+# 'st' => q|Southern Sotho|,
+# 'su' => q|Sundanese|,
+# 'suk' => q|Sukuma|,
+# 'sus' => q|Susu|,
+# 'sux' => q|Sumerian|,
+ 'sv' => q|Swedish|,
+# 'sw' => q|Swahili|,
+# 'syr' => q|Syriac|,
+# 'ta' => q|Tamil|,
+# 'te' => q|Telugu|,
+# 'tem' => q|Timne|,
+# 'ter' => q|Tereno|,
+# 'tet' => q|Tetum|,
+# 'tg' => q|Tajik|,
+# 'th' => q|Thai|,
+# 'ti' => q|Tigrinya|,
+# 'tig' => q|Tigre|,
+# 'tiv' => q|Tiv|,
+# 'tk' => q|Turkmen|,
+# 'tkl' => q|Tokelau|,
+# 'tl' => q|Tagalog|,
+# 'tli' => q|Tlingit|,
+# 'tmh' => q|Tamashek|,
+# 'tn' => q|Tswana|,
+# 'to' => q|Tonga (Tonga Islands)|,
+# 'tog' => q|Tonga (Nyasa)|,
+# 'tpi' => q|Tok Pisin|,
+ 'tr' => q|Turkish|,
+# 'ts' => q|Tsonga|,
+# 'tsi' => q|Tsimshian|,
+# 'tt' => q|Tatar|,
+# 'tum' => q|Tumbuka|,
+# 'tup' => q|Tupi languages|,
+# 'tvl' => q|Tuvalu|,
+# 'tw' => q|Twi|,
+# 'ty' => q|Tahitian|,
+# 'tyv' => q|Tuvinian|,
+# 'udm' => q|Udmurt|,
+# 'ug' => q|Uighur|,
+# 'uga' => q|Ugaritic|,
+# 'uk' => q|Ukrainian|,
+# 'umb' => q|Umbundu|,
+# 'ur' => q|Urdu|,
+# 'uz' => q|Uzbek|,
+# 'vai' => q|Vai|,
+# 've' => q|Venda|,
+# 'vi' => q|Vietnamese|,
+# 'vo' => q|Volapuk|,
+# 'vot' => q|Votic|,
+# 'wa' => q|Walloon|,
+# 'wak' => q|Wakashan languages|,
+# 'wal' => q|Walamo|,
+# 'war' => q|Waray|,
+# 'was' => q|Washo|,
+# 'wen' => q|Sorbian languages|,
+# 'wo' => q|Wolof|,
+# 'xal' => q|Kalmyk|,
+# 'xh' => q|Xhosa|,
+# 'yao' => q|Yao|,
+# 'yap' => q|Yapese|,
+# 'yi' => q|Yiddish|,
+# 'yo' => q|Yoruba|,
+# 'ypk' => q|Yupik languages|,
+# 'za' => q|Zhuang|,
+# 'zap' => q|Zapotec|,
+# 'zen' => q|Zenaga|,
+ 'zh' => q|Chinese|,
+# 'znd' => q|Zande|,
+# 'zu' => q|Zulu|,
+# 'zun' => q|Zuni|,
+};
+
+1;
+
diff --git a/static/files/def.js b/static/files/def.js
new file mode 100644
index 00000000..fcb98421
--- /dev/null
+++ b/static/files/def.js
@@ -0,0 +1,239 @@
+
+
+/* G L O B A L S T U F F */
+
+function x(y){return document.getElementById(y)}
+function cl(o,f){if(x(o))x(o).onclick=f}
+function DOMLoad(y){var d=0;var f=function(){if(d++)return;y()};
+if(document.addEventListener)document.addEventListener("DOMCont"
++"entLoaded",f,false);document.write("