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/\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;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 = '
'. + ($$y{next} ? qq|later revision ->| : ''). + ($x ? qq|<- earlier revision| : ''). + qq|$type$$y{id} 
|; + + 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|'. + qq|'. + ''. + join('',map{ + '' + } @c).'
 Revision $$x{cid} (edit)
By $$x{username} on |.formatdate('%Y-%m-%d at %R', $$x{added}).'
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]').'

'.$_->[1].''.$_->[4].''.$_->[5].'
'; +} + + +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/]+)\]//) { + $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|, + $_->{action}, $_->{upload} ? ' enctype="multipart/form-data"' : ''; + $ret .= sprintf qq| \n|, + $frm->{_hid} ? _hchar(join(',', keys %{$frm->{_hid}})) : '' if $_->{fh}; + $ret .= qq|

Items denoted by a red asterisk (*) are required.

\n| + if scalar grep { $_->{r} } @$obj; + $ret .= "
    \n"; + # endform + } elsif($_->{type} eq 'endform') { + $ret .= qq|
\n|; + # input + } elsif($_->{type} eq 'input') { + $ret .= sprintf qq|\n \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 \n \n\n|, + $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}; + # upload + } elsif($_->{type} eq 'upload') { + $ret .= sprintf qq|\n \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 \n \n\n|, + $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}, $_->{rows}||15, $_->{cols}||70, txt($frm->{$_->{short}}); + # select + } elsif($_->{type} eq 'select') { + $ret .= sprintf qq|\n \n \n\n|, + $_->{class} ? ' class="'.$_->{class}.'"' : '', $_->{short}, $_->{name}, eval { + my $r=''; + for my $s (@{$_->{options}}) { + $r .= sprintf qq| \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| \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 \n
  • \n|, + $_->{class} ? ' '.$_->{class} : '', + $_->{short}, $_->{value} || 'true', $frm->{$_->{short}} ? ' checked="checked"' : '', $_->{name}; + # static + } elsif($_->{type} eq 'static') { + $ret .= $_->{name} + ? sprintf qq|\n \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 \n|, + $_->{class} ? ' '.$_->{class} : '', $_->{short}, $_->{name}; + $ret .= sprintf qq| \n|, + $_->{short}, $_->{short}, eval { + my $r=''; + for my $s (0, 1990..((localtime())[5]+1905), 9999) { + $r .= sprintf qq| \n|, + $s, $frm->{$_->{short}} && ($frm->{$_->{short}}[0]||0) == $s ? ' selected="selected"' : '', + !$s ? '-year-' : $s < 9999 ? $s : 'TBA'; + } + return $r; + }; + $ret .= sprintf qq| \n|, + $_->{short}, $_->{short}, eval { + my $r=''; + for my $s (0..12) { + $r .= sprintf qq| \n|, + $s, $frm->{$_->{short}} && ($frm->{$_->{short}}[1]||0) == $s ? ' selected="selected"' : '', + $s ? $Time::CTime::MonthOfYear[$s-1] : '-month-'; + } + return $r; + }; + $ret .= sprintf qq| \n
  • \n|, + $_->{short}, $_->{short}, eval { + my $r=''; + for my $s (0..31) { + $r .= sprintf qq| \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') : '' ]]- +

    [[: $p{PageTitle} ]]

    +[[ 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. + +[[ } ]]- + + +RSS +[[= pagebut($purl) ]] +[[ if(0 and $p{Authmod} || $p{Authdel}) { ]] +
    +[[ } ]] + + + + + [[ if($d{type} ne 'u' || $d{act}) { ]]- + [[ } ]]- + [[ if(!$d{type} || $d{type} eq 'u' || $d{act} || ($d{type} eq 'v' && $d{seli})) { ]]- + [[ } ]]- + [[ if($d{type} && !$d{act}) { ]]- + [[ } ]]- + [[ if($d{act} eq 'r') { ]]- + [[ } ]]- + [[ if(0 and $p{Authmod}) { ]]- + [[ } ]]- + + + [[ for (@{$d{hist}}) { my $t = (qw|v r p|)[$_->{type}]; ]]- + + + + [[ if($d{type} ne 'u' || $d{act}) { ]]- + [[ } ]]- + [[ if(!$d{type} || $d{type} eq 'u' || $d{act}) { ]]- + [[ } ]]- + [[ if($d{type} eq 'v' && $d{seli}) { ]]- + [[ } ]]- + [[ if($d{type} && !$d{act}) { ]]- + [[ } ]]- + [[ if($d{act} eq 'r') { ]]- + [[ } ]]- + [[ if(0 and $p{Authmod} && !$d{act}) { ]]- + [[ } ]]- + + [[ } ]] + +
    Rev.DateUserPageSummaryAction
    [[= $_->{id} ]][[= formatdate('%Y-%m-%d %R', $_->{added}, 'dh') ]][[: $_->{username} ]][[= $_->{prev} ? $t.$_->{iid} : ''.$t.$_->{iid}.'' ]]:[[: length($_->{ititle}) > 30 ? substr($_->{ititle},0,27).'...' : $_->{ititle} ]][[= $_->{prev} ? $t.$_->{iid} : ''.$t.$_->{iid}.'' ]][[= summary($_->{comments}, $d{type} eq 'u' ? 40 : 60)||'[empty]' ]][[: $_->{_status} ]]
    +[[ if(0 and $p{Authmod}) { ]][[ } ]] +[[ if(0 and $p{Authdel}) { ]][[ } ]] +[[ 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) ]]- + + + + + + + [[ for (@{$d{votes}}) { ]]- + + + + + + [[ } ]]- +
    Title [[= sortbut($url, 'title') ]]Vote [[= sortbut($url, 'vote') ]]Date [[= sortbut($url, 'date') ]]
    [[: $_->{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

    +
    +
    + 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) ]] + + + + + + + +[[ for (@{$d{prods}}) { ]]- + + + + + + +[[ } ]]- +
    NameTypeMain languageWebsite
    [[: $_->{name} ]][[: $VNDB::PROT->{$_->{type}} ]][[: $VNDB::LANG->{$_->{lang}} ]] + [[ if($_->{website}) { ]] + [[: length($_->{website}) > 30 ? substr($_->{website}, 0, 27).'...' : $_->{website} ]] + [[ } else { ]]---[[ } ]] +
    +[[= 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 => '
      '.join('', map { my $p = $_; + '
    • '. + ''.$_.''. + '
    • ' + } sort { $VNDB::PLAT->{$a} cmp $VNDB::PLAT->{$b} } keys %$VNDB::PLAT).'
    ' }, + + { 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) ]]- + + + +[[ if($p{Authuserlist}) { ]]- + + [[ } ]]- + + + + +[[ if($p{Authuseredit}) { ]]- + [[ } ]]- + + [[ for (@{$d{users}}) { ]]- + + +[[ if($p{Authuserlist}) { ]]- + + [[ } ]]- + + + + +[[ if($p{Authuseredit}) { ]]- + [[ } ]]- + + [[ } ]]- +
    Username [[= sortbut($url, 'username') ]]Mail [[= sortbut($url, 'mail') ]]Rank [[= sortbut($url, 'rank') ]]Registered [[= sortbut($url, 'registered') ]]VN listVotesChanges 
    [[: $_->{username} ]][[: $_->{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[[ } ]]( 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}{$_}; ]]- + + +[[ } ]]- +
    +
    + +
    +
    +
    + +[[ } 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) ]] + + + + + + + + [[ 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 [[= sortbut($url, 'title') ]]Released [[= sortbut($url, 'released') ]]LanguagesRating [[= sortbut($url, 'votes') ]]
    [[: $_->{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}) { ]] +
    +[[ } ]] + + + + + + [[ if($d{user}{username} eq $p{AuthUsername}) { ]]- + + [[ } ]]- + + [[ for (@{$d{list}}) { ]]- + + + + + [[ if($d{user}{username} eq $p{AuthUsername}) { ]] + + [[ } ]] + + [[ } ]]- +
    Title [[= sortbut($sourl, 'title') ]]StatusAdded [[= sortbut($sourl, 'date') ]]Personal note 
    [[: length($_->{title})>40 ? substr($_->{title},0, 37).'...' : $_->{title} ]][[= $VNDB::LSTAT->[$_->{status}] ]][[= formatdate('%Y-%m-%d', $_->{date}, 'dh') ]][[: $_->{comments}||'-' ]]
    +[[ 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; + } + +]] + + +
    +
    +[[ if($d{vn}{image}) { ]] + [[ if($d{vn}{img_nsfw} && !$p{AuthNsfw}) { ]] + + [[ } else { ]] + [[: $p{PageTitle} ]] + [[ } ]] +[[ } else { ]]- + No image uploaded yet... +[[ } ]]- +
    + + +-[[ if($p{AuthLoggedin}) { ]] +

    < user options - + [[= $d{vote}{vid} ? 'your vote: '.$d{vote}{vote} : 'vote' ]] +- [[= !$d{list}{vid} ? 'add to vn list' : 'status: '.lc $VNDB::LSTAT->[$d{list}{status}] ]] +>

    +[[ } ]]- + +-[[ + $d{vn}{c_votes} =~ s#^([0-9]{2}.[0-9]{2})\|([0-9]{4})$#$2 == 0 ? 'No votes yet' : + $1 == 0 ? sprintf 'N/A (%d vote%s)', $2, $2>1?'s':'' : sprintf '%.2f (%d vote%s)', $1, $2, $2>1?'s':''#e; + + my @links = ( + $d{vn}{l_wp} ? [ 'Wikipedia', 'http://en.wikipedia.org/wiki/%s', $d{vn}{l_wp} ] : (), + $d{vn}{l_vnn} ? [ 'V-N.net', 'http://visual-novels.net/vn/index.php?option=com_content&task=view&id=%d', $d{vn}{l_vnn} ] : (), + $d{vn}{l_cisv} ? [ 'CISVisual', 'http://cisvisual.net/title/%d', $d{vn}{l_cisv} ] : (), + ); + +if($d{vn}{length} || $d{vn}{alias} || @links) { ]] +

    General info

    +
    + [[ if($d{vn}{length}) { ]]- +
    Length
    [[: $VNDB::VNLEN->[$d{vn}{length}][0] ]]- ([[: $VNDB::VNLEN->[$d{vn}{length}][1] ]])
    [[ } ]]- + [[ if($d{vn}{alias}) { ]]- +
    Aliases
    [[: $d{vn}{alias} ]]
    [[ } ]]- + [[ if(@links > 0) { ]] +
    Links
    [[= join(', ', map { ''.$_->[0].'' } @links) ]]
    [[ } ]]- +
    +[[ } ]]- + + [[ if(@{$d{vn}{categories}}) { my %nolvl = (pli=>1,pbr=>1,gaa=>1,gab=>1); ]]- +

    Categories

    +
    + [[ for (sort keys %$VNDB::CAT) { + my $c = $_; + my @c = map { my $s=$_; + my ($cs) = grep { $_->[0] eq $c.$s } @{$d{vn}{categories}}; + $cs ? sprintf('%s', $nolvl{$c.$_}?0:$cs->[1], $VNDB::CAT->{$c}[1]{$s}) + : () + } sort keys %{$VNDB::CAT->{$c}[1]}; + if(@c) { ]]- +
    [[: $VNDB::CAT->{$c}[0] ]]
    [[= join(', ', @c) ]]
    + [[ } } ]] +
    + [[ } ]]- + + [[ if($#{$d{vn}{relations}} >= 0) { ]]- +

    [[= $d{page} eq 'rg' ? 'Relations' : 'Relations' ]]

    +
    + [[ my $lrel = -1; my $i=0; for (sort { $a->{relation} <=> $b->{relation} } @{$d{vn}{relations}}) { + if($_->{relation} != $lrel) { $lrel=$_->{relation}; if($i) { ]][[ } ]]- +
    [[: $VNDB::VREL->[$lrel] ]]
    [[: $_->{title} ]] + [[ } else { ]]
    [[: shorten $_->{title}, 40 ]][[ } + ++$i;} ]] +
    + [[ } ]]- + + [[ if(@lang && grep { @{$_->{producers}} } @{$d{rel}}) { ]]- +

    Producers

    +
    + [[ for my $l (@lang) { my %l; + $_->{language} eq $l && (%l = ( %l, map { + sprintf('%s', + $_->{id}, _hchar($_->{name}), _hchar shorten $_->{name}, 30) => 1 + } @{$_->{producers}} )) for (@{$d{rel}}); + if(keys %l) { ]]- +
    [[: $VNDB::LANG->{$l} ]]
    [[= join(' & ', keys %l) ]]
    + [[ } } ]] +
    + [[ } ]]- + +

    [[= $d{page} eq 'stats' ? 'User stats' : 'User stats' ]]

    +
    +
    Rating
    [[: $d{vn}{c_votes} ]]
    +
    +
    + +-[[ + 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}) { ]]- + + + + + +[[ } ]] + + +[[ } ]] 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 = $_; ]]- + + + +[[ for (@{$d{rel}}) { next if $l ne $_->{language}; ]]- + + + + + + + + + +[[ } ]]- +[[ } ]]- +
    [[: $VNDB::LANG->{$l} ]]
    [[= 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

      + +[[ for (@{$d{votes}{latest}}) { ]]- + + [[ if(!$d{user}) { ]]- + + [[ } else { ]]- + + [[ } ]]- + + + +[[ } ]]- +
      [[: $_->{username} ]][[: length($_->{title})>30?substr($_->{title},0,27).'...':$_->{title} ]][[= $_->{vote} ]][[= formatdate('%Y-%m-%d %R', $_->{date}, 'dh') ]]
    • +[[ } } ]]- + +-[[ $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

      + +[[ for (@{$d{lists}{latest}}) { ]]- + + [[ if(!$d{user}) { ]]- + + [[ } else { ]]- + + [[ } ]]- + + + +[[ } ]]- +
      [[: $_->{username} ]][[: length($_->{title})>25?substr($_->{title},0,23).'...':$_->{title} ]][[= $VNDB::LSTAT->[$_->{status}] ]][[= formatdate('%Y-%m-%d %R', $_->{date}, 'dh') ]]
    • +[[ } } ]]- +
    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/\\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("