summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/VN3/BBCode.pm300
-rw-r--r--lib/VN3/Char/Edit.pm168
-rw-r--r--lib/VN3/Char/JS.pm55
-rw-r--r--lib/VN3/Char/Page.pm330
-rw-r--r--lib/VN3/DB.pm287
-rw-r--r--lib/VN3/Docs/Edit.pm54
-rw-r--r--lib/VN3/Docs/JS.pm15
-rw-r--r--lib/VN3/Docs/Lib.pm86
-rw-r--r--lib/VN3/Docs/Page.pm23
-rw-r--r--lib/VN3/ElmGen.pm197
-rw-r--r--lib/VN3/HTML.pm375
-rw-r--r--lib/VN3/Misc/Homepage.pm31
-rw-r--r--lib/VN3/Misc/ImageUpload.pm70
-rw-r--r--lib/VN3/Prelude.pm104
-rw-r--r--lib/VN3/Producer/Edit.pm136
-rw-r--r--lib/VN3/Producer/JS.pm47
-rw-r--r--lib/VN3/Producer/Page.pm117
-rw-r--r--lib/VN3/Release/Edit.pm130
-rw-r--r--lib/VN3/Release/JS.pm32
-rw-r--r--lib/VN3/Release/Page.pm184
-rw-r--r--lib/VN3/Staff/Edit.pm108
-rw-r--r--lib/VN3/Staff/JS.pm43
-rw-r--r--lib/VN3/Staff/Page.pm213
-rw-r--r--lib/VN3/Trait/JS.pm44
-rw-r--r--lib/VN3/Types.pm171
-rw-r--r--lib/VN3/User/Lib.pm31
-rw-r--r--lib/VN3/User/Login.pm50
-rw-r--r--lib/VN3/User/Page.pm207
-rw-r--r--lib/VN3/User/RegReset.pm137
-rw-r--r--lib/VN3/User/Settings.pm98
-rw-r--r--lib/VN3/User/VNList.pm325
-rw-r--r--lib/VN3/VN/Edit.pm187
-rw-r--r--lib/VN3/VN/JS.pm46
-rw-r--r--lib/VN3/VN/Lib.pm20
-rw-r--r--lib/VN3/VN/Page.pm631
-rw-r--r--lib/VN3/Validation.pm168
36 files changed, 0 insertions, 5220 deletions
diff --git a/lib/VN3/BBCode.pm b/lib/VN3/BBCode.pm
deleted file mode 100644
index a9922b4c..00000000
--- a/lib/VN3/BBCode.pm
+++ /dev/null
@@ -1,300 +0,0 @@
-package VN3::BBCode;
-
-use strict;
-use warnings;
-use v5.10;
-use Exporter 'import';
-use TUWF::XML 'xml_escape';
-
-our @EXPORT = qw/bb2html bb2text bb_subst_links/;
-
-# Supported BBCode:
-# [spoiler] .. [/spoiler]
-# [quote] .. [/quote]
-# [code] .. [/code]
-# [url=..] [/url]
-# [raw] .. [/raw]
-# link: http://../
-# dblink: v+, v+.+, d+#+, d+#+.+
-#
-# Permitted nesting of formatting codes:
-# spoiler -> url, raw, link, dblink
-# quote -> anything
-# code -> nothing
-# url -> raw
-# raw -> nothing
-
-
-# State action function usage:
-# _state_action \@stack, $match, $char_pre, $char_post
-# Returns: ($token, @arg) on successful parse, () otherwise.
-
-# Trivial open and close actions
-sub _spoiler_start { if(lc$_[1] eq '[spoiler]') { push @{$_[0]}, 'spoiler'; ('spoiler_start') } else { () } }
-sub _quote_start { if(lc$_[1] eq '[quote]') { push @{$_[0]}, 'quote'; ('quote_start') } else { () } }
-sub _code_start { if(lc$_[1] eq '[code]') { push @{$_[0]}, 'code'; ('code_start') } else { () } }
-sub _raw_start { if(lc$_[1] eq '[raw]') { push @{$_[0]}, 'raw'; ('raw_start') } else { () } }
-sub _spoiler_end { if(lc$_[1] eq '[/spoiler]') { pop @{$_[0]}; ('spoiler_end') } else { () } }
-sub _quote_end { if(lc$_[1] eq '[/quote]' ) { pop @{$_[0]}; ('quote_end' ) } else { () } }
-sub _code_end { if(lc$_[1] eq '[/code]' ) { pop @{$_[0]}; ('code_end' ) } else { () } }
-sub _raw_end { if(lc$_[1] eq '[/raw]' ) { pop @{$_[0]}; ('raw_end' ) } else { () } }
-sub _url_end { if(lc$_[1] eq '[/url]' ) { pop @{$_[0]}; ('url_end' ) } else { () } }
-
-sub _url_start {
- if($_[1] =~ m{^\[url=((https?://|/)[^\]>]+)\]$}i) {
- push @{$_[0]}, 'url';
- (url_start => $1)
- } else { () }
-}
-
-sub _link {
- my(undef, $match, $char_pre, $char_post) = @_;
-
- # Tags arent links
- return () if $match =~ /^\[/;
-
- # URLs (already "validated" in the parsing regex)
- return ('link') if $match =~ /^[hf]t/;
-
- # Now we're left with various forms of IDs, just need to make sure it's not surrounded by word characters
- return ('dblink') if $char_pre !~ /\w/ && $char_post !~ /\w/;
-
- ();
-}
-
-
-# Permitted actions to take in each state. The actions are run in order, if
-# none succeed then the token is passed through as text.
-# The "current state" is the most recent tag in the stack, or '' if no tags are open.
-my %STATE = (
- '' => [ \&_link, \&_url_start, \&_raw_start, \&_spoiler_start, \&_quote_start, \&_code_start],
- spoiler => [\&_spoiler_end, \&_link, \&_url_start, \&_raw_start],
- quote => [\&_quote_end, \&_link, \&_url_start, \&_raw_start, \&_spoiler_start, \&_quote_start, \&_code_start],
- code => [\&_code_end ],
- url => [\&_url_end, \&_raw_start],
- raw => [\&_raw_end ],
-);
-
-
-# Usage:
-#
-# parse $input, sub {
-# my($raw, $token, @arg) = @_;
-# return 1; # to continue processing, 0 to stop. (Note that _close tokens may still follow after stopping)
-# };
-#
-# $raw = the raw part that has been parsed
-# $token = name of the parsed bbcode token, with some special cases (see below)
-# @arg = $token-specific arguments.
-#
-# Tags:
-# text -> literal text, $raw is the text to display
-# spoiler_start -> start a spoiler
-# spoiler_end -> end
-# quote_start -> start a quote
-# quote_end -> end
-# code_start -> code block
-# code_end -> end
-# url_start -> [url=..], $arg[0] contains the url
-# url_end -> [/url]
-# raw_start -> [raw]
-# raw_end -> [/raw]
-# link -> http://.../, $raw is the link
-# dblink -> v123, t13.1, etc. $raw is the dblink
-#
-# This function will ensure correct nesting of _start and _end tokens.
-sub parse {
- my($raw, $sub) = @_;
- $raw =~ s/\r//g;
- return if !$raw && $raw ne '0';
-
- my $last = 0;
- my @stack;
-
- while($raw =~ m{(?:
- \[ \/? (?i: spoiler|quote|code|url|raw ) [^\s\]]* \] | # tag
- d[1-9][0-9]* \# [1-9][0-9]* (?: \.[1-9][0-9]* )? | # d+#+[.+]
- [tdvprcs][1-9][0-9]*\.[1-9][0-9]* | # v+.+
- [tdvprcsugi][1-9][0-9]* | # v+
- (?:https?|ftp)://[^><"\n\s\]\[]+[\d\w=/-] # link
- )}xg) {
- my $token = $&;
- my $pre = substr $raw, $last, $-[0]-$last;
- my $char_pre = $-[0] ? substr $raw, $-[0]-1, 1 : '';
- $last = pos $raw;
- my $char_post = substr $raw, $last, 1;
-
- # Pass through the unformatted text before the match
- $sub->($pre, 'text') || goto FINAL if length $pre;
-
- # Call the state functions. Arguments to these functions are implicitely
- # passed through @_, which avoids allocating a new stack for each function
- # call.
- my $state = $STATE{ $stack[$#stack]||'' };
- my @ret;
- @_ = (\@stack, $token, $char_pre, $char_post);
- for(@$state) {
- @ret = &$_;
- last if @ret;
- }
- $sub->($token, @ret ? @ret : ('text')) || goto FINAL;
- }
-
- $sub->(substr($raw, $last), 'text') if $last < length $raw;
-
-FINAL:
- # Close all tags. This code is a bit of a hack, as it bypasses the state actions.
- $sub->('', "${_}_end") for reverse @stack;
-}
-
-
-sub bb2html {
- my($input, $maxlength, $charspoil) = @_;
-
- my $incode = 0;
- my $rmnewline = 0;
- my $length = 0;
- my $ret = '';
-
- # escapes, returns string, and takes care of $length and $maxlength; also
- # takes care to remove newlines and double spaces when necessary
- my $e = sub {
- local $_ = shift;
-
- s/^\n// if $rmnewline && $rmnewline--;
- s/\n{5,}/\n\n/g if !$incode;
- s/ +/ /g if !$incode;
- $length += length $_;
- if($maxlength && $length > $maxlength) {
- $_ = substr($_, 0, $maxlength-$length);
- s/\W+\w*$//; # cleanly cut off on word boundary
- }
- s/&/&amp;/g;
- s/>/&gt;/g;
- s/</&lt;/g;
- s/\n/<br>/g if !$maxlength;
- s/\n/ /g if $maxlength;
- $_;
- };
-
- parse $input, sub {
- my($raw, $tag, @arg) = @_;
-
- #$ret .= "$tag {$raw}\n";
- #return 1;
-
- if($tag eq 'text') {
- $ret .= $e->($raw);
-
- } elsif($tag eq 'spoiler_start') {
- $ret .= !$charspoil
- ? '<b class="spoiler">'
- : '<b class="grayedout charspoil charspoil_-1">&lt;hidden by spoiler settings&gt;</b><span class="charspoil charspoil_2 hidden">';
- } elsif($tag eq 'spoiler_end') {
- $ret .= !$charspoil ? '</b>' : '</span>';
-
- } elsif($tag eq 'quote_start') {
- $ret .= '<div class="quote">' if !$maxlength;
- $rmnewline = 1;
- } elsif($tag eq 'quote_end') {
- $ret .= '</div>' if !$maxlength;
- $rmnewline = 1;
-
- } elsif($tag eq 'code_start') {
- $ret .= '<pre>' if !$maxlength;
- $rmnewline = 1;
- $incode = 1;
- } elsif($tag eq 'code_end') {
- $ret .= '</pre>' if !$maxlength;
- $rmnewline = 1;
- $incode = 0;
-
- } elsif($tag eq 'url_start') {
- $ret .= sprintf '<a href="%s" rel="nofollow">', xml_escape($arg[0]);
- } elsif($tag eq 'url_end') {
- $ret .= '</a>';
-
- } elsif($tag eq 'link') {
- $ret .= sprintf '<a href="%s" rel="nofollow">%s</a>', xml_escape($raw), $e->('link');
-
- } elsif($tag eq 'dblink') {
- (my $link = $raw) =~ s/^d(\d+)\.(\d+)\.(\d+)$/d$1#$2.$3/;
- $ret .= sprintf '<a href="/%s">%s</a>', $link, $e->($raw);
- }
-
- !$maxlength || $length < $maxlength;
- };
- $ret;
-}
-
-
-# Convert bbcode into plain text, stripping all tags and spoilers. [url] tags
-# only display the title.
-sub bb2text {
- my $input = shift;
-
- my $inspoil = 0;
- my $ret = '';
- parse $input, sub {
- my($raw, $tag, @arg) = @_;
- if($tag eq 'spoiler_start') {
- $inspoil = 1;
- } elsif($tag eq 'spoiler_end') {
- $inspoil = 0;
- } else {
- $ret .= $raw if !$inspoil && $tag !~ /_(start|end)$/;
- }
- 1;
- };
- $ret;
-}
-
-
-# Turn (most) 'dblink's into [url=..] links. This function relies on TUWF to do
-# the database querying, so can't be used from Multi.
-# Doesn't handle:
-# - d+, t+, r+ and u+ links
-# - item revisions
-sub bb_subst_links {
- my $msg = shift;
-
- # Parse a message and create an index of links to resolve
- my %lookup;
- parse $msg, sub {
- my($code, $tag) = @_;
- $lookup{$1}{$2} = 1 if $tag eq 'dblink' && $code =~ /^(.)(\d+)/;
- 1;
- };
- return $msg unless %lookup;
-
- # Now resolve the links
- state $types = { # Query must return 'id' and 'name' columns, list of IDs will be appended to it.
- v => 'SELECT id, title AS name FROM vn WHERE id IN',
- c => 'SELECT id, name FROM chars WHERE id IN',
- p => 'SELECT id, name FROM producers WHERE id IN',
- g => 'SELECT id, name FROM tags WHERE id IN',
- i => 'SELECT id, name FROM traits WHERE id IN',
- s => 'SELECT s.id, sa.name FROM staff_alias sa JOIN staff s ON s.aid = sa.id WHERE s.id IN',
- };
- my %links;
- for my $type (keys %$types) {
- next if !$lookup{$type};
- my $lst = $TUWF::OBJ->dbAlli($types->{$type}, [keys %{$lookup{$type}}]);
- $links{$type . $_->{id}} = $_->{name} for @$lst;
- }
- return $msg unless %links;
-
- # Now substitute
- my $result = '';
- parse $msg, sub {
- my($code, $tag) = @_;
- $result .= $tag eq 'dblink' && $links{$code}
- ? sprintf '[url=/%s]%s[/url]', $code, $links{$code}
- : $code;
- 1;
- };
- return $result;
-}
-
-
-1;
diff --git a/lib/VN3/Char/Edit.pm b/lib/VN3/Char/Edit.pm
deleted file mode 100644
index e711eb17..00000000
--- a/lib/VN3/Char/Edit.pm
+++ /dev/null
@@ -1,168 +0,0 @@
-package VN3::Char::Edit;
-
-use VN3::Prelude;
-
-
-my $FORM = {
- alias => { required => 0, default => '', maxlength => 500 },
- desc => { required => 0, default => '', maxlength => 5000 },
- hidden => { anybool => 1 },
- locked => { anybool => 1 },
- original => { required => 0, default => '', maxlength => 200 },
- name => { maxlength => 200 },
- b_day => { uint => 1, range => [ 0, 31 ] },
- b_month => { uint => 1, range => [ 0, 12 ] },
- s_waist => { uint => 1, range => [ 0, 99999 ] },
- s_bust => { uint => 1, range => [ 0, 99999 ] },
- s_hip => { uint => 1, range => [ 0, 99999 ] },
- height => { uint => 1, range => [ 0, 99999 ] },
- weight => { uint => 1, range => [ 0, 99999 ], required => 0 },
- gender => { gender => 1 },
- bloodt => { blood_type => 1 },
- image => { required => 0, default => 0, id => 1 }, # X
- main => { id => 1, required => 0 }, # X
- main_spoil => { spoiler => 1 },
- main_name => { _when => 'out' },
- main_is => { _when => 'out', anybool => 1 }, # If true, this character is already a "main" character for other character(s)
- traits => { maxlength => 200, sort_keys => 'tid', aoh => {
- tid => { id => 1 }, # X
- spoil => { spoiler => 1 },
- group => { _when => 'out' },
- name => { _when => 'out' },
- } },
- vns => { maxlength => 50, sort_keys => ['vid', 'rid'], aoh => {
- vid => { id => 1 }, # X
- rid => { id => 1, required => 0 }, # X
- role => { char_role => 1 },
- spoil => { spoiler => 1 },
- title => { _when => 'out' },
- } },
-
- vnrels => { _when => 'out', aoh => {
- id => { id => 1 },
- releases => { aoh => {
- id => { id => 1 },
- title => { },
- lang => { type => 'array', values => {} },
- } }
- } },
-
- id => { _when => 'out', required => 0, id => 1 },
- authmod => { _when => 'out', anybool => 1 },
- editsum => { _when => 'in out', editsum => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form CharEdit => $FORM_OUT, $FORM_IN;
-
-
-sub vnrels {
- my @vns = @_;
- my $v = [ map +{ id => $_ }, @vns ];
- enrich_list releases => id => vid => sub {
- sql q{SELECT rv.vid, r.id, r.title FROM releases r JOIN releases_vn rv ON rv.id = r.id WHERE NOT r.hidden AND rv.vid IN}, $_[0], q{ORDER BY r.id}
- }, $v;
- enrich_list1 lang => id => id => sub { sql 'SELECT id, lang FROM releases_lang WHERE id IN', $_[0], 'ORDER BY id, lang' }, map $_->{releases}, @$v;
- $v
-}
-
-
-TUWF::get qr{/$CREV_RE/(?<type>edit|copy)} => sub {
- my $c = entry c => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit c => $c;
- my $copy = tuwf->capture('type') eq 'copy';
-
- $c->{main_name} = $c->{main} ? tuwf->dbVali('SELECT name FROM chars WHERE id =', \$c->{main}) : '';
- $c->{main_is} = !$copy && tuwf->dbVali('SELECT 1 FROM chars WHERE main =', \$c->{id})||0;
-
- enrich tid => q{SELECT t.id AS tid, t.name, g.name AS group, g.order FROM traits t JOIN traits g ON g.id = t.group WHERE t.id IN} => $c->{traits};
- $c->{traits} = [ sort { $a->{order} <=> $b->{order} || $a->{name} cmp $b->{name} } @{$c->{traits}} ];
-
- enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $c->{vns};
- $c->{vns} = [ sort { $a->{vid} <=> $b->{vid} } @{$c->{vns}} ];
-
- my %vids = map +($_->{vid}, 1), @{$c->{vns}};
- $c->{vnrels} = vnrels keys %vids;
-
- $c->{authmod} = auth->permDbmod;
- $c->{editsum} = $copy ? "Copied from c$c->{id}.$c->{chrev}" : $c->{chrev} == $c->{maxrev} ? '' : "Reverted to revision c$c->{id}.$c->{chrev}";
-
- my $title = sprintf '%s %s', $copy ? 'Copy' : 'Edit', $c->{name};
- Framework index => 0, title => $title,
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit c => $c;
- Div class => 'detail-page-title', sub {
- Txt $title;
- Debug $c;
- };
- };
- }, sub {
- FullPageForm module => 'CharEdit.Main', schema => $FORM_OUT, data => { %$c, $copy ? (id => undef) : () }, sections => [
- general => 'General info',
- traits => 'Traits',
- vns => 'Visual novels',
- ];
- };
-};
-
-
-TUWF::get qr{/$VID_RE/addchar}, sub {
- return tuwf->resDenied if !auth->permEdit;
-
- my $vn = tuwf->dbRowi('SELECT id, title FROM vn WHERE NOT hidden AND id =', \tuwf->capture('id'));
- return tuwf->resNotFound if !$vn->{id};
-
- my $data = {
- vns => [ { vid => $vn->{id}, rid => undef, role => 'primary', spoil => 0, title => $vn->{title} } ],
- vnrels => vnrels $vn->{id}
- };
-
- Framework index => 0, title => "Add a new character to $vn->{title}", narrow => 1, sub {
- FullPageForm module => 'CharEdit.New', schema => $FORM_OUT, data => $data, sections => [
- general => 'General info',
- format => 'Format',
- relations => 'Relations'
- ];
- };
-};
-
-
-json_api qr{/(?:$CID_RE/edit|c/add)}, $FORM_IN, sub {
- my $data = shift;
- my $new = !tuwf->capture('id');
- my $c = $new ? { id => 0 } : entry c => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit c => $c;
-
- if(!auth->permDbmod) {
- $data->{hidden} = $c->{hidden}||0;
- $data->{locked} = $c->{locked}||0;
- }
- $data->{main} = undef if $data->{hidden};
- $data->{main_spoil} = 0 if !$data->{main};
-
- die "Image not found" if $data->{image} && !-e tuwf->imgpath(ch => $data->{image});
- if($data->{main}) {
- die "Relation with self" if $data->{main} == $c->{id};
- die "Invalid main" if !tuwf->dbVali('SELECT 1 FROM chars WHERE main IS NULL AND id =', \$data->{main});
- die "Main set when self is main" if $c->{id} && tuwf->dbVali('SELECT 1 FROM chars WHERE main =', \$c->{id});
- }
- validate_dbid 'SELECT id FROM traits WHERE id IN', map $_->{tid}, @{$data->{traits}};
- validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{vns}};
- for (grep $_->{rid}, @{$data->{vns}}) {
- die "Invalid release $_->{rid}" if !tuwf->dbVali('SELECT 1 FROM releases_vn WHERE', { id => $_->{rid}, vid => $_->{vid} });
- }
-
- $data->{desc} = bb_subst_links $data->{desc};
-
- return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $c;
-
- my($id,undef,$rev) = update_entry c => $c->{id}, $data;
- $elm_Changed->($id, $rev);
-};
-
-1;
diff --git a/lib/VN3/Char/JS.pm b/lib/VN3/Char/JS.pm
deleted file mode 100644
index eafda3ad..00000000
--- a/lib/VN3/Char/JS.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package VN3::Char::JS;
-
-use VN3::Prelude;
-
-
-my $elm_CharResult = elm_api CharResult => { aoh => {
- id => { id => 1 },
- name => {},
- original => {},
- main => { type => 'hash', required => 0, keys => {
- id => { id => 1 },
- name => {},
- original => {},
- }},
-}};
-
-json_api '/js/char.json', {
- search => { maxlength => 500 }
-}, sub {
- my $q = shift->{search};
-
- # XXX: This query is kinda slow
- my $qs = $q =~ s/[%_]//gr;
- my $r = tuwf->dbAlli(
- 'SELECT c.id, c.name, c.original, c.main, c2.name AS main_name, c2.original AS main_original',
- 'FROM (',
- # ID search
- $q =~ /^$CID_RE$/ ? ('SELECT 1, id FROM chars WHERE id =', \"$1", 'UNION ALL') : (),
- # exact match
- 'SELECT 2, id FROM chars WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')',
- 'UNION ALL',
- # prefix match
- 'SELECT 3, id FROM chars WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%",
- 'UNION ALL',
- # substring match
- 'SELECT 4, id FROM chars WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%",
- ') AS ct (ord, id)',
- 'JOIN chars c ON c.id = ct.id',
- 'LEFT JOIN chars c2 ON c2.id = c.main',
- 'WHERE NOT c.hidden',
- 'GROUP BY c.id, c.name, c.original, c.main, c2.name, c2.original',
- 'ORDER BY MIN(ct.ord), c.name',
- 'LIMIT 20'
- );
-
- for (@$r) {
- $_->{main} = $_->{main} ? { id => $_->{main}, name => $_->{main_name}, original => $_->{main_original} } : undef;
- delete $_->{main_name};
- delete $_->{main_original};
- }
-
- $elm_CharResult->($r);
-};
-
-1;
diff --git a/lib/VN3/Char/Page.pm b/lib/VN3/Char/Page.pm
deleted file mode 100644
index 11939060..00000000
--- a/lib/VN3/Char/Page.pm
+++ /dev/null
@@ -1,330 +0,0 @@
-package VN3::Char::Page;
-
-use VN3::Prelude;
-use List::Util 'all', 'min';
-
-sub Top {
- my $e = shift;
-
- my $img = $e->{image} && tuwf->imgurl(ch => $e->{image});
-
- Div class => 'fixed-size-left-sidebar-md', sub {
- Img class => 'page-header-img-mobile img img--rounded d-md-none', src => $img;
- Div class => 'detail-header-image-container', sub {
- Img class => 'img img--fit img--rounded elevation-1 d-none d-md-block detail-header-image', src => $img;
- };
- } if $img;
-
- Div class => 'col-md', sub {
- EntryEdit c => $e;
- Div class => 'detail-page-title', sub {
- Txt $e->{name};
- Txt ' '.gender_icon $e->{gender};
- Txt ' '.blood_type_display $e->{bloodt} if $e->{bloodt} ne 'unknown';
- Debug $e;
- };
- Div class => 'detail-page-subtitle', $e->{original} if $e->{original};
- };
-}
-
-
-sub Settings {
- my $spoil = auth->pref('spoilers') || 0;
- my $ero = auth->pref('traits_sexual');
-
- Div class => 'page-inner-controls', id => 'charpage_settings', sub {
- Div class => 'page-inner-controls__option dropdown', sub {
- A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub {
- Span class => 'page-inner-controls__option-spoil', spoil_display $spoil;
- Lit ' ';
- Span class => 'caret', '';
- };
- Div class => 'dropdown-menu', sub {
- A class => 'dropdown-menu__item page-inner-controls__option-spoil-0', href => 'javascript:;', spoil_display 0;
- A class => 'dropdown-menu__item page-inner-controls__option-spoil-1', href => 'javascript:;', spoil_display 1;
- A class => 'dropdown-menu__item page-inner-controls__option-spoil-2', href => 'javascript:;', spoil_display 2;
- };
- };
- Div class => 'page-inner-controls__option', sub {
- Switch 'Sexual traits', $ero, 'page-inner-controls__option-ero' => 1;
- };
- };
-}
-
-
-sub Description {
- my $e = shift;
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- if($e->{image}) {
- # second copy of image to ensure there's enough space (uh, mkay)
- Img class => 'img img--fit d-none d-md-block detail-header-image-push', src => tuwf->imgurl(ch => $e->{image});
- } else {
- H3 class => 'detail-page-sidebar-section-header', 'Description';
- }
- };
- Div class => 'col-md', sub {
- Div class => 'description serif mb-5', sub {
- P sub { Lit bb2html $e->{desc} };
- };
- };
- } if $e->{desc};
-}
-
-
-sub DetailsTable {
- my $e = shift;
-
- my(%groups, @groups);
- for(@{$e->{traits}}) {
- push @groups, $_->{gid} if !$groups{$_->{gid}};
- push @{$groups{$_->{gid}}}, $_;
- }
-
- # TODO: This was copy-pasted from VN::Page, need to consolidate (...once we figure out how to actually display chars on the VN page)
- my @list = (
- $e->{alias} ? sub {
- Dt 'Aliases';
- Dd $e->{alias} =~ s/\n/, /gr;
- } : (),
-
- defined $e->{weight} || $e->{height} || $e->{s_bust} || $e->{s_waist} || $e->{s_hip} ? sub {
- Dt 'Measurements';
- Dd join ', ',
- $e->{height} ? "Height: $e->{height}cm" : (),
- defined $e->{weight} ? "Weight: $e->{weight}kg" : (),
- $e->{s_bust} || $e->{s_waist} || $e->{s_hip} ?
- sprintf 'Bust-Waist-Hips: %s-%s-%scm', $e->{s_bust}||'??', $e->{s_waist}||'??', $e->{s_hip}||'??' : ();
- } : (),
-
- $e->{b_month} && $e->{b_day} ? sub {
- Dt 'Birthday';
- Dd sprintf '%d %s', $e->{b_day}, [qw{January February March April May June July August September October November December}]->[$e->{b_month}-1];
- } : (),
-
- # XXX: Group visibility is determined by the same 'charpage--x' classes
- # as the individual traits (group is considered 'ero' if all traits are
- # ero, and the lowest trait spoiler determines group spoiler level).
- # But this has an unfortunate special case that isn't handled: A trait
- # with (ero && spoil>0) in a group that isn't itself (ero && spoil>0)
- # will display an empty group if settings are (ero && spoil==0).
- # XXX#2: I'd rather have the traits delimited by a comma, but that's a
- # hard problem to solve in combination with the dynamic hiding of
- # traits.
- (map { my $g = $_; sub {
- my @c = mkclass
- 'charpage--ero' => (all { $_->{sexual} } @{$groups{$g}}),
- sprintf('charpage--spoil-%d', min map $_->{spoil}, @{$groups{$g}}) => 1;
-
- Dt @c, sub { A href => "/i$g", $groups{$g}[0]{group} };
- Dd @c, sub {
- Join ' ', sub {
- A mkclass('trait-summary--trait' => 1, 'charpage--ero' => $_[0]{sexual}, sprintf('charpage--spoil-%d', $_[0]{spoil}), 1),
- style => 'padding-right: 15px; white-space: nowrap',
- href => "/i$_[0]{tid}", $_[0]{name}
- }, @{$groups{$g}};
- };
- } } @groups),
- );
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Details';
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Div class => 'card__section fs-medium', sub {
- Div class => 'row', sub {
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] };
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] };
- }
- }
- }
- }
- } if @list;
-}
-
-
-sub VNs {
- my $e = shift;
-
- # TODO: Maybe this table should be full-width?
- # TODO: Improved styling of release rows
-
- my $rows = sub {
- for my $vn (@{$e->{vns}}) {
- Tr class => sprintf('charpage--spoil-%d', $vn->{spoil}), sub {
- Td class => 'tabular-nums muted', sub { ReleaseDate $vn->{c_released} };
- Td sub {
- A href => "/v$vn->{vid}", title => $vn->{original}||$vn->{title}, $vn->{title};
- };
- Td $vn->{releases}[0]{rid} ? '' : join ', ', map char_role_display($_->{role}), @{$vn->{releases}};
- Td sub {
- Join ', ', sub {
- A href => "/s$_[0]{sid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name};
- Span class => 'muted', " ($_[0]{note})" if $_[0]{note};
- }, @{$vn->{seiyuu}};
- }
- };
- for my $rel ($vn->{releases}[0]{rid} ? @{$vn->{releases}} : ()) {
- Tr class => sprintf('charpage--spoil-%d', $rel->{spoil}), sub {
- Td class => 'tabular-nums muted', $rel->{rid} ? sub { Lit '&nbsp;&nbsp;'; ReleaseDate $rel->{released} } : '';
- Td sub {
- Span class => 'muted', 'ยป ';
- A href => "/r$rel->{rid}", title => $rel->{title}||$rel->{original}, $rel->{title} if $rel->{rid};
- Span class => 'muted', 'Other releases' if !$rel->{rid};
- };
- Td char_role_display $rel->{role};
- Td '';
- };
- }
- }
- };
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Visual Novels';
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Table class => 'table table--responsive-single-sm fs-medium', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', 'Date';
- Th width => '40%', 'Title';
- Th width => '20%', 'Role';
- Th width => '25%', 'Voiced by';
- };
- };
- Tbody $rows;
- };
- }
- }
- }
-}
-
-
-sub Instances {
- my $e = shift;
-
- return if !@{$e->{instances}};
-
- my $minspoil = min map $_->{spoiler}, @{$e->{instances}};
-
- Div class => sprintf('row charpage--spoil-%d', $minspoil), sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Other instances';
- };
- Div class => 'col-md', sub {
- for my $c (@{$e->{instances}}) {
- A class => sprintf('card card--white character-card mb-3 charpage--spoil-%d', $c->{spoiler}), href => "/c$c->{id}", sub {
- Div class => 'character-card__left', sub {
- Div class => 'character-card__image-container', sub {
- Img class => 'character-card__image', src => tuwf->imgurl(ch => $c->{image}) if $c->{image};
- };
- Div class => 'character-card__main', sub {
- Div class => 'character-card__name', sub {
- Txt $c->{name};
- Txt ' '.gender_icon $c->{gender};
- Txt ' '.blood_type_display $c->{bloodt} if $c->{bloodt} ne 'unknown';
- };
- Div class => 'character-card__sub-name', $c->{original} if $c->{original};
- Div class => 'character-card__vns muted single-line', join ', ', map $_->{title}, @{$c->{vns}} if @{$c->{vns}};
- };
- Div class => 'character-card__right serif semi-muted', sub {
- Lit bb2text $c->{desc}; # TODO: maxlength?
- };
- }
- }
- }
- };
- };
-}
-
-
-TUWF::get qr{/$CREV_RE}, sub {
- my $e = entry c => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resNotFound if !$e->{id} || $e->{hidden};
-
- enrich tid => q{
- SELECT t.id AS tid, t.name, t.sexual, g.id AS gid, g.name AS group, g.order
- FROM traits t
- JOIN traits g ON g.id = t.group
- WHERE t.id IN
- }, $e->{traits};
-
- $e->{traits} = [ sort { $a->{order} <=> $b->{order} || $a->{name} cmp $b->{name} } @{$e->{traits}} ];
-
- $e->{vns} = tuwf->dbAlli(q{
- SELECT cv.vid, v.title, v.original, v.c_released, MIN(cv.spoil) AS spoil
- FROM chars_vns_hist cv
- JOIN vn v ON cv.vid = v.id
- WHERE cv.chid =}, \$e->{chid}, q{
- GROUP BY v.c_released, cv.vid, v.title, v.original
- ORDER BY v.c_released, cv.vid
- });
-
- enrich_list releases => vid => vid => sub {sql q{
- SELECT cv.rid, cv.vid, cv.role, cv.spoil, r.title, r.original, r.released
- FROM chars_vns_hist cv
- LEFT JOIN releases r ON r.id = cv.rid
- WHERE cv.chid =}, \$e->{chid}, q{
- ORDER BY r.released, r.id
- }}, $e->{vns};
-
- enrich_list seiyuu => vid => vid => sub {sql q{
- SELECT vs.id AS vid, vs.note, sa.id AS sid, sa.aid, sa.name, sa.original
- FROM vn_seiyuu vs
- JOIN staff_alias sa ON vs.aid = sa.aid
- WHERE vs.cid =}, \$e->{id}, q{
- ORDER BY sa.name, sa.aid
- }}, $e->{vns};
-
- $e->{instances} = tuwf->dbAlli(q{
- SELECT id, name, original, image, gender, bloodt, "desc",
- (CASE WHEN id =}, \$e->{main}, THEN => \$e->{main_spoil}, q{ELSE main_spoil END) AS spoiler
- FROM chars
- WHERE NOT hidden
- AND id <>}, \$e->{id}, q{
- AND ( main =}, \$e->{id}, q{
- OR main =}, \$e->{main}, q{
- OR id =}, \$e->{main}, q{
- )
- ORDER BY name, id
- });
- enrich_list vns => id => cid => sub {sql q{
- SELECT cv.id AS cid, v.id, v.title
- FROM chars_vns cv
- JOIN vn v ON v.id = cv.vid
- WHERE cv.id IN}, $_[0], q{
- AND cv.spoil = 0
- GROUP BY v.id, cv.id, v.title
- ORDER BY MIN(cv.role), v.title, v.id
- }}, $e->{instances};
-
- my $spoil = auth->pref('spoilers') || 0;
- my $ero = auth->pref('traits_sexual');
-
- Framework
- og => {
- description => bb2text($e->{desc}),
- $e->{image} ? (image => tuwf->imgurl(ch => $e->{image})) : ()
- },
- title => $e->{name},
- main_classes => {
- 'charpage--hide-spoil-1' => $spoil < 1,
- 'charpage--hide-spoil-2' => $spoil < 2,
- 'charpage--hide-ero' => !$ero
- },
- top => sub { Top $e },
- sub {
- Settings $e;
- Description $e;
- DetailsTable $e;
- VNs $e;
- Instances $e;
- };
-};
-
-1;
diff --git a/lib/VN3/DB.pm b/lib/VN3/DB.pm
deleted file mode 100644
index 35b31660..00000000
--- a/lib/VN3/DB.pm
+++ /dev/null
@@ -1,287 +0,0 @@
-package VN3::DB;
-
-use v5.10;
-use strict;
-use warnings;
-use TUWF;
-use SQL::Interp ':all';
-use Carp 'carp';
-use VNWeb::DB (); # For the tuwf->dbVali etc methods
-use base 'Exporter';
-
-our @EXPORT = qw/
- sql
- sql_join sql_comma sql_and sql_array sql_func sql_fromhex sql_tohex sql_fromtime sql_totime
- enrich enrich_list enrich_list1
- entry update_entry
-/;
-
-
-
-# sql_* are macros for SQL::Interp use
-
-# join(), but for sql objects.
-sub sql_join {
- my $sep = shift;
- my @args = map +($sep, $_), @_;
- shift @args;
- return @args;
-}
-
-# Join multiple arguments together with a comma, for use in a SELECT or IN
-# clause or function arguments.
-sub sql_comma { sql_join ',', @_ }
-
-sub sql_and { sql_join 'AND', map sql('(', $_, ')'), @_ }
-
-# Construct a PostgreSQL array type from the function arguments.
-sub sql_array { 'ARRAY[', sql_join(',', map \$_, @_), ']' }
-
-# Call an SQL function
-sub sql_func {
- my($funcname, @args) = @_;
- sql $funcname, '(', sql_comma(@args), ')';
-}
-
-# Convert a Perl hex value into Postgres bytea
-sub sql_fromhex($) {
- sql_func decode => \$_[0], "'hex'";
-}
-
-# Convert a Postgres bytea into a Perl hex value
-sub sql_tohex($) {
- sql_func encode => $_[0], "'hex'";
-}
-
-# Convert a Perl time value (UNIX timestamp) into a Postgres timestamp
-sub sql_fromtime($) {
- sql_func to_timestamp => \$_[0];
-}
-
-# Convert a Postgres timestamp into a Perl time value
-sub sql_totime($) {
- sql "extract('epoch' from ", $_[0], ')';
-}
-
-
-
-# Helper function for the enrich functions below.
-sub _enrich {
- my($merge, $key, $sql, @array) = @_;
-
- # 'flatten' the given array, so that you can also give arrayrefs as argument
- @array = map +(ref $_ eq 'ARRAY' ? @$_ : $_), @array;
-
- # Create a list of unique identifiers to fetch, do nothing if there's nothing to fetch
- my %ids = map +($_->{$key},1), @array;
- return if !keys %ids;
-
- # Fetch the data
- $sql = ref $sql eq 'CODE' ? $sql->([keys %ids]) : sql $sql, [keys %ids];
- my $data = tuwf->dbAlli($sql);
-
- # And merge
- $merge->($data, \@array);
-}
-
-
-# This function is slightly magical: It is used to fetch information from the
-# database and add it to an existing data structure. Usage:
-#
-# enrich $key, $sql, $object1, $object2, [$more_objects], ..;
-#
-# Where each $object is an hashref that will be modified in-place. $key is the
-# name of a key that should be present in each $object, and indicates the value
-# that should be used as database identifier to fetch more information. $sql is
-# the SQL query that is used to fetch more information for each identifier. If
-# $sql is a subroutine, then it is given an arrayref of keys (to be used in an
-# WHERE x IN() clause), and should return a sql() query. If $sql is a string
-# or sql() query itself, then the arrayref of keys is appended to it. The
-# generated SQL query should return a column named $key, so that the other
-# columns can be merged back into the $objects.
-sub enrich {
- my($key, $sql, @array) = @_;
- _enrich sub {
- my($data, $array) = @_;
- my %ids = map +(delete($_->{$key}), $_), @$data;
- # Copy the key to a temp variable to prevent stringifycation of integer keys
- %$_ = (%$_, %{$ids{ (my $v = $_->{$key}) }}) for @$array;
- }, $key, $sql, @array;
-}
-
-
-# Similar to enrich(), but instead of requiring a one-to-one mapping between
-# $object->{$key} and the row returned by $sql, this function allows multiple
-# rows to be returned by $sql. $object->{$key} is compared with $merge_col
-# returned by the SQL query, the rows are stored as an arrayref in
-# $object->{$name}.
-sub enrich_list {
- my($name, $key, $merge_col, $sql, @array) = @_;
- _enrich sub {
- my($data, $array) = @_;
- my %ids = ();
- push @{$ids{ delete $_->{$merge_col} }}, $_ for @$data;
- $_->{$name} = $ids{ (my $v = $_->{$key}) }||[] for @$array;
- }, $key, $sql, @array;
-}
-
-
-# Similar to enrich_list(), instead of returning each row as a hash, each row
-# is taken to be a single value.
-sub enrich_list1 {
- my($name, $key, $merge_col, $sql, @array) = @_;
- _enrich sub {
- my($data, $array) = @_;
- my %ids = ();
- push @{$ids{ delete $_->{$merge_col} }}, values %$_ for @$data;
- $_->{$name} = $ids{ (my $v = $_->{$key}) }||[] for @$array;
- }, $key, $sql, @array;
-}
-
-
-
-
-# Database entry API: Intended to provide a low-level read/write interface for
-# versioned database entires. The same data structure is used for reading and
-# updating entries, and should support easy diffing/comparison.
-# Probably not very convenient for general querying & searching, but we'll see.
-
-my %entry_prefixes = (qw{
- c chars
- d docs
- p producers
- r releases
- s staff
- v vn
-});
-
-# Reads the database schema and creates a hash of
-# 'table' => [versioned item-specific columns]
-# for a particular entry prefix, where each column is a hash.
-#
-# These functions assume a specific table layout for versioned database
-# entries, as documented in util/sql/schema.sql.
-sub _entry_tables {
- my $prefix = shift;
- my $tables = tuwf->dbh->column_info(undef, undef, "$prefix%_hist", undef)->fetchall_arrayref({});
- my %tables;
- for (@$tables) {
- (my $t = $_->{TABLE_NAME}) =~ s/_hist$//;
- next if $_->{COLUMN_NAME} eq 'chid';
- push @{$tables{$t}}, {
- name => $_->{pg_column}, # Raw name, as it appears in the data structure
- type => $_->{TYPE_NAME}, # Postgres type name
- sql_ref => $_->{COLUMN_NAME}, # SQL to refer to this column
- sql_read => $_->{COLUMN_NAME}, # SQL to read this column (could be used to transform the data to something perl likes)
- sql_write => sub { \$_[0] }, # SQL to convert Perl data into something that can be assigned to the column
- };
- }
- \%tables;
-}
-
-
-sub _entry_type {
- # Store the cached result of _entry_tables() for each entry type
- state $types = {
- map +($_, _entry_tables $entry_prefixes{$_}),
- keys %entry_prefixes
- };
- $types->{ shift() };
-}
-
-
-# Returns everything for a specific entry ID. The top-level hash also includes
-# the following keys:
-#
-# id, chid, rev, maxrev, hidden, locked, entry_hidden, entry_locked
-#
-# (Ordering of arrays is unspecified)
-sub entry {
- my($type, $id, $rev) = @_;
-
- my $prefix = $entry_prefixes{$type}||die;
- my $t = _entry_type $type;
-
- my $maxrev = tuwf->dbVali('SELECT MAX(rev) FROM changes WHERE type =', \$type, ' AND itemid =', \$id);
- return undef if !$maxrev;
- $rev ||= $maxrev;
- my $entry = tuwf->dbRowi(q{
- SELECT itemid AS id, id AS chid, rev AS chrev, ihid AS hidden, ilock AS locked
- FROM changes
- WHERE}, { type => $type, itemid => $id, rev => $rev }
- );
- return undef if !$entry->{id};
- $entry->{maxrev} = $maxrev;
-
- if($maxrev == $rev) {
- $entry->{entry_hidden} = $entry->{hidden};
- $entry->{entry_locked} = $entry->{locked};
- } else {
- enrich id => "SELECT id, hidden AS entry_hidden, locked AS entry_locked FROM $prefix WHERE id IN", $entry;
- }
-
- enrich chid => sql(
- SELECT => sql_comma(chid => map $_->{sql_read}, @{$t->{$prefix}}),
- FROM => "${prefix}_hist",
- 'WHERE chid IN'
- ), $entry;
-
- for my $tbl (grep /^${prefix}_/, keys %$t) {
- (my $name = $tbl) =~ s/^${prefix}_//;
- $entry->{$name} = tuwf->dbAlli(
- SELECT => sql_comma(map $_->{sql_read}, @{$t->{$tbl}}),
- FROM => "${tbl}_hist",
- WHERE => { chid => $entry->{chid} });
- }
- $entry
-}
-
-
-# Update or create an entry, usage:
-# ($id, $chid, $rev) = update_entry $type, $id, $data, $uid;
-#
-# $id should be undef to create a new entry.
-# $uid should be undef to use the currently logged in user.
-# $data should have the same format as returned by entry(), but instead with
-# the following additional keys in the top-level hash:
-#
-# hidden, locked, editsum
-sub update_entry {
- my($type, $id, $data, $uid) = @_;
- $id ||= undef;
-
- my $prefix = $entry_prefixes{$type}||die;
- my $t = _entry_type $type;
-
- tuwf->dbExeci("SELECT edit_${type}_init(", \$id, ', (SELECT MAX(rev) FROM changes WHERE type = ', \$type, ' AND itemid = ', \$id, '))');
- tuwf->dbExeci('UPDATE edit_revision SET', {
- requester => $uid // scalar VNWeb::Auth::auth()->uid(),
- ip => scalar tuwf->reqIP(),
- comments => $data->{editsum},
- ihid => $data->{hidden},
- ilock => $data->{locked},
- });
-
- tuwf->dbExeci("UPDATE edit_${prefix} SET ",
- sql_comma(map sql($_->{sql_ref}, ' = ', $_->{sql_write}->($data->{$_->{name}})), @{$t->{$prefix}}));
-
- for my $tbl (grep /^${prefix}_/, keys %$t) {
- (my $name = $tbl) =~ s/^${prefix}_//;
-
- my @rows = map {
- my $d = $_;
- sql '(', sql_comma(map $_->{sql_write}->($d->{$_->{name}}), @{$t->{$tbl}}), ')'
- } @{$data->{$name}};
-
- tuwf->dbExeci("DELETE FROM edit_${tbl}");
- tuwf->dbExeci("INSERT INTO edit_${tbl} ",
- '(', sql_comma(map $_->{sql_ref}, @{$t->{$tbl}}), ')',
- ' VALUES ', sql_comma(@rows)
- ) if @rows;
- }
-
- my $r = tuwf->dbRow("SELECT * FROM edit_${type}_commit()");
- ($r->{itemid}, $r->{chid}, $r->{rev})
-}
-
-1;
diff --git a/lib/VN3/Docs/Edit.pm b/lib/VN3/Docs/Edit.pm
deleted file mode 100644
index a93be5b2..00000000
--- a/lib/VN3/Docs/Edit.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-package VN3::Docs::Edit;
-
-use VN3::Prelude;
-use VN3::Docs::Lib;
-
-
-my $FORM = {
- title => { maxlength => 200 },
- content => { required => 0, default => '' },
- hidden => { anybool => 1 },
- locked => { anybool => 1 },
-
- editsum => { _when => 'in out', editsum => 1 },
- id => { _when => 'out', id => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form DocEdit => $FORM_OUT, $FORM_IN;
-
-
-TUWF::get qr{/$DREV_RE/edit} => sub {
- my $d = entry d => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit d => $d;
-
- $d->{editsum} = $d->{chrev} == $d->{maxrev} ? '' : "Reverted to revision d$d->{id}.$d->{chrev}";
-
- Framework title => "Edit $d->{title}", index => 0,
- sub {
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md doc-list', \&Sidebar;
- Div class => 'col-md col-md--4', sub {
- Div 'data-elm-module' => 'DocEdit',
- 'data-elm-flags' => JSON::XS->new->encode($FORM_OUT->analyze->coerce_for_json($d)), '';
- };
- };
- };
-};
-
-
-json_api qr{/$DOC_RE/edit}, $FORM_IN, sub {
- my $data = shift;
- my $doc = entry d => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit d => $doc;
- return $elm_Unchanged->() if !form_changed $FORM_CMP, $data, $doc;
-
- my($id,undef,$rev) = update_entry d => $doc->{id}, $data;
- $elm_Changed->($id, $rev);
-};
-
-1;
diff --git a/lib/VN3/Docs/JS.pm b/lib/VN3/Docs/JS.pm
deleted file mode 100644
index 397842fd..00000000
--- a/lib/VN3/Docs/JS.pm
+++ /dev/null
@@ -1,15 +0,0 @@
-package Docs::JS;
-
-use VN3::Prelude;
-use VN3::Docs::Lib;
-
-my $elm_Content = elm_api Content => {};
-
-json_api '/js/markdown.json', {
- content => { required => 0, default => '' }
-}, sub {
- return $elm_Unauth->() if !auth->permDbmod;
- $elm_Content->(md2html shift->{content});
-};
-
-1;
diff --git a/lib/VN3/Docs/Lib.pm b/lib/VN3/Docs/Lib.pm
deleted file mode 100644
index e9239499..00000000
--- a/lib/VN3/Docs/Lib.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-package VN3::Docs::Lib;
-
-use VN3::Prelude;
-use Text::MultiMarkdown 'markdown';
-
-our @EXPORT = qw/md2html Sidebar/;
-
-
-sub md2html {
- my $content = shift;
-
- $content =~ s{^:MODERATORS:$}{
- my %modperms = map auth->listPerms->{$_} & auth->defaultPerms ? () : ($_, auth->listPerms->{$_}), keys %{ auth->listPerms };
- my $l = tuwf->dbAlli('SELECT id, username, perm FROM users WHERE (perm & ', \(auth->allPerms &~ auth->defaultPerms), ') > 0 ORDER BY id LIMIT 100');
- '<dl>'.join('', map {
- my $u = $_;
- my $p = $u->{perm} >= auth->allPerms ? 'admin'
- : join ', ', sort grep $u->{perm} & $modperms{$_}, keys %modperms;
- sprintf '<dt><a href="/u%d">%s</a></dt><dd>%s</dd>', $_->{id}, $_->{username}, $p;
- } @$l).'</dl>';
- }me;
-
- my $html = markdown $content, {
- strip_metadata => 1,
- img_ids => 0,
- disable_footnotes => 1,
- disable_bibliography => 1,
- };
-
- # Number sections and turn them into links
- my($sec, $subsec) = (0,0);
- $html =~ s{<h([1-2])[^>]+>(.*?)</h\1>}{
- if($1 == 1) {
- $sec++;
- $subsec = 0;
- qq{<h2><a href="#$sec" name="$sec">$sec. $2</a></h2>}
- } elsif($1 == 2) {
- $subsec++;
- qq|<h3><a href="#$sec.$subsec" name="$sec.$subsec">$sec.$subsec. $2</a></h3>\n|
- }
- }ge;
-
- # Text::MultiMarkdown doesn't handle fenced code blocks properly. The
- # following solution breaks inline code blocks, but I don't use those anyway.
- $html =~ s/<code>/<pre>/g;
- $html =~ s#</code>#</pre>#g;
-
- $html
-}
-
-
-sub Cat {
- Div class => 'doc-list__title', $_[0];
-}
-
-sub Doc {
- A mkclass('doc-list__doc' => 1, 'doc-list__doc--active' => tuwf->capture('id') == $_[0]),
- href => "/d$_[0]", $_[1];
-}
-
-
-sub Sidebar {
- # TODO: Turn this into a nav-sidebar for better mobile viewing?
- Cat 'About VNDB';
- Doc 7, 'About us';
- Doc 6, 'FAQ';
- Doc 9, 'Discussion board';
- Doc 17, 'Privacy Policy & Licensing';
- Doc 11, 'Database API';
- Doc 14, 'Database Dumps';
- Doc 18, 'Database Querying';
- Doc 8, 'Development';
-
- Cat 'Guidelines';
- Doc 5, 'Editing guidelines';
- Doc 2, 'Visual novels';
- Doc 15, 'Special games';
- Doc 3, 'Releases';
- Doc 4, 'Producers';
- Doc 16, 'Staff';
- Doc 12, 'Characters';
- Doc 10, 'Tags & Traits';
- Doc 13, 'Capturing screenshots';
-}
-
-1;
diff --git a/lib/VN3/Docs/Page.pm b/lib/VN3/Docs/Page.pm
deleted file mode 100644
index 0392434b..00000000
--- a/lib/VN3/Docs/Page.pm
+++ /dev/null
@@ -1,23 +0,0 @@
-package VN3::Docs::Page;
-
-use VN3::Prelude;
-use VN3::Docs::Lib;
-
-TUWF::get qr{/$DREV_RE} => sub {
- my $d = entry d => tuwf->capture('id'), tuwf->capture('rev');
- return tuwf->resNotFound if !$d || $d->{hidden};
-
- Framework title => $d->{title},
- sub {
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md doc-list', \&Sidebar;
- Div class => 'col-md doc', sub {
- EntryEdit d => $d;
- H1 $d->{title};
- Lit md2html $d->{content};
- };
- };
- };
-};
-
-1;
diff --git a/lib/VN3/ElmGen.pm b/lib/VN3/ElmGen.pm
deleted file mode 100644
index fefc154e..00000000
--- a/lib/VN3/ElmGen.pm
+++ /dev/null
@@ -1,197 +0,0 @@
-# This module is responsible for generating elm3/Lib/Gen.elm. Variables and
-# type definitions can be added from any Perl module by calling def(),
-# elm_form() and elm_api() at file load time.
-
-package VN3::ElmGen;
-
-use strict;
-use warnings;
-use TUWF;
-use Exporter 'import';
-use List::Util 'max';
-use VNWeb::Auth;
-use VN3::Types;
-use VNDB::Types;
-
-our @EXPORT = qw/
- elm_form elm_api
- $elm_Unauth $elm_Unchanged $elm_Changed $elm_Success $elm_CSRF
-/;
-
-
-my $data = <<_;
--- This file is automatically generated from lib/VN3/ElmGen.pm
--- DO NOT EDIT!
-module Lib.Gen exposing (..)
-
-import Http
-import Json.Encode as JE
-import Json.Decode as JD
-
-type alias Medium =
- { qty : Bool
- , single : String
- , plural : String
- }
-_
-
-
-
-# Formatting functions
-sub indent($) { $_[0] =~ s/\n/\n /gr }
-sub list { indent "\n[ ".join("\n, ", @_)."\n]" }
-sub string($) { '"'.($_[0] =~ s/([\\"])/\\$1/gr).'"' }
-sub tuple { '('.join(', ', @_).')' }
-sub bool($) { $_[0] ? 'True' : 'False' }
-sub to_camel { (ucfirst $_[0]) =~ s/_([a-z])/'_'.uc $1/egr; }
-
-# Output a variable definition: name, type, value
-sub def($$$) { $data .= sprintf "\n%s : %s\n%1\$s = %s\n", @_; }
-
-
-# Define an Elm type corresponding to a TUWF::Validate schema
-sub def_type {
- my($name, $obj) = @_;
- my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys %{$obj->{keys}} : ();
-
- def_type($name . to_camel($_), $obj->{keys}{$_}{values} || $obj->{keys}{$_}) for @keys;
-
- $data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type(
- keys => +{ map +($_, ($obj->{keys}{$_}{values} ? 'List ' : '') . $name . to_camel($_)), @keys }
- );
-}
-
-
-# Define an Elm JSON encoder taking a corresponding def_type() as input
-sub encoder {
- my($name, $type, $obj) = @_;
- def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.');
-}
-
-
-# Create type definitions and a JSON encoder for a typical form.
-# Usage:
-#
-# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA;
-#
-# That will define:
-#
-# type alias FormName = { .. }
-# type alias FormNameSend = { .. }
-# formnameSendEncode : FormNameSend -> JE.Value
-#
-sub elm_form {
- my($name, $out, $in) = @_;
- def_type $name, $out->analyze;
- def_type $name.'Send', $in->analyze;
- encoder lc($name).'SendEncode', $name.'Send', $in->analyze;
-}
-
-
-my %apis;
-
-# Define an API response. This will be added to the 'Lib.Api.Response' union type.
-# Usage:
-#
-# # At file scope:
-# my $json_generator = elm_api_response UnionName => $SCHEMA1, $SCHEMA2, ..;
-#
-# # Later, to actually generate a JSON response:
-# $json_generator->($data1, $data2, ..);
-#
-# Limitation: There may be only a single $SCHEMA with an embedded {type => 'hash'}.
-sub elm_api {
- my($name, @schema) = @_;
- @schema = map tuwf->compile($_), @schema;
- $apis{$name} = \@schema;
- sub {
- # TODO: Validate $data? Easier to catch bugs that way
- tuwf->resJSON({$name, @schema ? [map $schema[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject'), 0..$#schema] : 1})
- }
-}
-
-# Common API responses.
-our $elm_Unauth = elm_api 'Unauth';
-our $elm_Unchanged = elm_api 'Unchanged';
-our $elm_Changed = elm_api 'Changed', { id => 1 }, { uint => 1 };
-our $elm_Success = elm_api 'Success';
-our $elm_CSRF = elm_api 'CSRF';
-
-
-sub print {
- # Generate the ApiResponse type and decoder.
- #
- # Extract all { type => 'hash' } schemas and give them their own
- # definition, so that it's easy to refer to those records in other places
- # of the Elm code, similar to def_type().
- my(@union, @decode);
- my $len = max map length, keys %apis;
- for (sort keys %apis) {
- my($name, $schema) = ($_, $apis{$_});
- my $def = $name;
- my $dec = sprintf 'JD.field "%s"%s <| %s', $name,
- ' 'x($len-(length $name)),
- @$schema == 0 ? "JD.succeed $name" :
- @$schema == 1 ? "JD.map $name" : sprintf 'JD.map%d %s', scalar @$schema, $name;
- my $tname = "Api$name";
- for my $argn (0..$#$schema) {
- my $arg = $schema->[$argn]->analyze();
- my $jd = $arg->elm_decoder(json_decode => 'JD.', level => 3);
- $dec .= " (JD.index $argn $jd)";
- if($arg->{keys}) {
- def_type $tname, $arg;
- $def .= " $tname";
- #$dec .= $jd;
- } elsif($arg->{values} && $arg->{values}{keys}) {
- def_type $tname, $arg->{values};
- $def .= " (List $tname)";
- #$dec .= "(JD.list $jd)";
- } else {
- $def .= ' '.$arg->elm_type();
- #$dec .= $jd;
- }
- #$dec .= ')';
- }
- push @union, $def;
- push @decode, $dec;
- }
- $data .= sprintf "\ntype ApiResponse\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union;
- $data .= sprintf "\ndecodeApiResponse : JD.Decoder ApiResponse\ndecodeApiResponse = JD.oneOf\n [ %s\n ]", join "\n , ", @decode;
-
- print $data;
-};
-
-
-my $perms = VNWeb::Auth::listPerms();
-
-def urlStatic => String => string tuwf->conf->{url_static};
-def userPerms => 'List (Int, String)' => list map tuple($perms->{$_}, string $_), sort keys %$perms;
-def vnLengths => 'List (Int, String)' => list map tuple($_, string vn_length_display $_), keys %VN_LENGTH;
-def vnRelations => 'List (String, String)' => list map tuple(string $_, string vn_relation_display $_), keys %VN_RELATION;
-def producerRelations => 'List (String, String)' => list map tuple(string $_, string producer_relation_display $_), keys %PRODUCER_RELATION;
-def creditType => 'List (String, String)' => list map tuple(string $_, string $CREDIT_TYPE{$_}), keys %CREDIT_TYPE;
-def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}), sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE;
-def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORM{$_}), keys %PLATFORM;
-def releaseTypes => 'List String' => list map string($_), release_types;
-def producerTypes => 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPE{$_}), keys %PRODUCER_TYPE;
-def minAges => 'List (Int, String)' => list map tuple($_, string minage_display_full $_), keys %AGE_RATING;
-def resolutions => 'List (String, String)' => list map tuple(string $_, string resolution_display_full $_), keys %RESOLUTION;
-def voiced => 'List (Int, String)' => list map tuple($_, string($VOICED{$_})), keys %VOICED;
-def animated => 'List (Int, String)' => list map tuple($_, string($ANIMATED{$_})), keys %ANIMATED;
-def genders => 'List (String, String)' => list map tuple(string $_, string gender_display $_), keys %GENDER;
-def bloodTypes => 'List (String, String)' => list map tuple(string $_, string blood_type_display $_), keys %BLOOD_TYPE;
-def charRoles => 'List (String, String)' => list map tuple(string $_, string char_role_display $_), keys %CHAR_ROLE;
-def vnlistStatus => 'List (Int, String)' => list map tuple($_, string $VNLIST_STATUS{$_}), keys %VNLIST_STATUS;
-
-def emailPattern => String => string { tuwf->compile({ email => 1 })->analyze->html5_validation() }->{pattern};
-def weburlPattern => String => string { tuwf->compile({ weburl => 1 })->analyze->html5_validation() }->{pattern};
-def vnvotePattern => String => string { tuwf->compile({ vnvote => 1 })->analyze->html5_validation() }->{pattern};
-
-def media => 'List (String, Medium)' =>
- list map tuple(
- string($_),
- sprintf('{ qty = %s, single = %s, plural = %s }', bool($MEDIUM{$_}{qty}), string($MEDIUM{$_}{txt}), string($MEDIUM{$_}{plural}))
- ), keys %MEDIUM;
-
-
-1;
diff --git a/lib/VN3/HTML.pm b/lib/VN3/HTML.pm
deleted file mode 100644
index 0dcd7241..00000000
--- a/lib/VN3/HTML.pm
+++ /dev/null
@@ -1,375 +0,0 @@
-# Convention:
-# All HTML-generating functions are in CamelCase
-#
-# TODO: HTML generation for dropdowns can be abstracted more nicely.
-
-package VN3::HTML;
-
-use strict;
-use warnings;
-use v5.10;
-use utf8;
-use List::Util 'pairs', 'max', 'sum';
-use TUWF ':Html5', 'mkclass', 'uri_escape';
-use VNWeb::Auth;
-use VN3::Types;
-use VN3::Validation;
-use base 'Exporter';
-
-our @EXPORT = qw/Framework EntryEdit Switch Debug Join FullPageForm VoteGraph ListIcon GridIcon/;
-
-
-sub Navbar {
- Div class => 'nav navbar__nav navbar__main-nav', sub {
- Div class => 'nav__item navbar__menu dropdown', sub {
- A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt 'Database '; Span class => 'caret', '' };
- Div class => 'dropdown-menu database-menu', sub {
- A class => 'dropdown-menu__item', href => '/v/all', 'Visual novels';
- A class => 'dropdown-menu__item', href => '/g', 'Tags';
- A class => 'dropdown-menu__item', href => '/c/all', 'Characters';
- A class => 'dropdown-menu__item', href => '/i', 'Traits';
- A class => 'dropdown-menu__item', href => '/p/all', 'Producers';
- A class => 'dropdown-menu__item', href => '/s/all', 'Staff';
- A class => 'dropdown-menu__item', href => '/r', 'Releases';
- };
- };
- Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/d6', 'FAQ' };
- Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/t', 'Forums' };
- Div class => 'nav__item navbar__menu dropdown', sub {
- A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt 'Contribute '; Span class => 'caret', '' };
- Div class => 'dropdown-menu', sub {
- A class => 'dropdown-menu__item', href => '/hist', 'Recent changes';
- A class => 'dropdown-menu__item', href => '/v/add', 'Add Visual Novel';
- A class => 'dropdown-menu__item', href => '/p/add', 'Add Producer';
- A class => 'dropdown-menu__item', href => '/s/new', 'Add Staff';
- };
- };
- Div class => 'nav__item navbar__menu', sub {
- A href => '/v/all', class => 'nav__link', sub {
- Span class => 'icon-desc d-md-none', 'Search ';
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/search.svg';
- };
- };
- };
-
- Div class => 'nav navbar__nav', sub {
- my $notifies = auth && tuwf->dbVali('SELECT count(*) FROM notifications WHERE uid =', \auth->uid, 'AND read IS NULL');
- Div class => 'nav__item navbar__menu', sub {
- A href => '/'.auth->uid.'/notifies', class => 'nav__link notification-icon', sub {
- Span class => 'icon-desc d-md-none', 'Notifications ';
- Div class => 'icon-group', sub {
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/bell.svg';
- Div class => 'notification-icon__indicator', $notifies;
- };
- };
- } if $notifies;
- Div class => 'nav__item navbar__menu dropdown', sub {
- A href => 'javascript:;', class => 'nav__link dropdown__toggle', sub { Txt auth->username.' '; Span class => 'caret'; };
- Div class => 'dropdown-menu dropdown-menu--right', sub {
- my $id = auth->uid;
- A class => 'dropdown-menu__item', href => "/u$id", 'Profile';
- A class => 'dropdown-menu__item', href => "/u$id/edit", 'Settings';
- A class => 'dropdown-menu__item', href => "/u$id/list", 'List';
- A class => 'dropdown-menu__item', href => "/u$id/wish", 'Wishlist';
- A class => 'dropdown-menu__item', href => "/u$id/hist", 'Recent changes';
- A class => 'dropdown-menu__item', href => "/g/links?u=$id", 'Tags';
- Div class => 'dropdown__separator', '';
- A class => 'dropdown-menu__item', href => "/u$id/logout", 'Log out';
- };
- } if auth;
- if(!auth) {
- Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/u/register', 'Register'; };
- Div class => 'nav__item navbar__menu', sub { A class => 'nav__link', href => '/u/login', 'Login'; };
- }
- };
-}
-
-
-sub Top {
- my($opt) = @_;
- Div class => 'raised-top-container', sub {
- Div class => 'raised-top', sub {
- Div class => 'container', sub {
- Div class => 'navbar navbar--expand-md', sub {
- Div class => 'navbar__logo', sub {
- A href => '/', 'vndb';
- };
- A href => 'javascript:;', class => 'navbar__toggler', sub {
- Div class => 'navbar__toggler-icon', '';
- };
- Div class => 'navbar__collapse', \&Navbar;
- };
- Div class => 'row', $opt->{top} if $opt->{top};
- };
- };
- };
-}
-
-
-sub Bottom {
- Div class => 'col-md col-md--1', sub {
- Div class => 'footer__logo', sub {
- A href => '/', class => 'link-subtle', 'vndb';
- };
- };
-
- state $sep = sub { Span class => 'footer__sep', sub { Lit '&middot;'; }; };
- state $lnk = sub { A href => $_[0], class => 'link--subtle', $_[1]; };
- state $root = tuwf->root;
- state $ver = `git -C "$root" describe` =~ /^(.+)$/ ? $1 : '';
-
- Div class => 'col-md col-md--4', sub {
- Div class => 'footer__nav', sub {
- $lnk->('/d7', 'about us');
- $sep->();
- $lnk->('irc://irc.synirc.net/vndb', '#vndb');
- $sep->();
- $lnk->('mailto:contact@vndb.org', 'contact@vndb.org');
- $sep->();
- $lnk->('https://code.blicky.net/yorhel/vndb/src/branch/v3', 'source');
- $sep->();
- A href => '/v/rand', class => 'link--subtle footer__random', sub {
- Txt 'random vn ';
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/random.svg';
- };
- $sep->();
- Txt $ver;
- };
-
- my $q = tuwf->dbRow('SELECT vid, quote FROM quotes ORDER BY random() LIMIT 1');
- Div class => 'footer__quote', sub {
- $lnk->('/v'.$q->{vid}, $q->{quote});
- } if $q;
- };
-}
-
-
-sub Framework {
- my $body = pop;
- my %opt = @_;
- Html sub {
- Head prefix => 'og: http://ogp.me/ns#', sub {
- Meta name => 'viewport', content => 'width=device-width, initial-scale=1, shrink-to-fit=no';
- Meta name => 'csrf-token', content => auth->csrftoken;
- Meta charset => 'utf-8';
- Meta name => 'robots', content => 'noindex, follow' if exists $opt{index} && !$opt{index};
- Title $opt{title} . ' | vndb';
- Link rel => 'stylesheet', href => tuwf->conf->{url_static}.'/v3/style.css';
- Link rel => 'shortcut icon', href => '/favicon.ico', type => 'image/x-icon';
- Link rel => 'search', type => 'application/opensearchdescription+xml', title => 'VNDB VN Search', href => tuwf->reqBaseURI().'/opensearch.xml';
-
- # TODO: Link to RSS feeds.
-
- # Opengraph metadata
- if($opt{og}) {
- $opt{og}{site_name} ||= 'The Visual Novel Database';
- $opt{og}{type} ||= 'object';
- $opt{og}{image} ||= 'https://s.vndb.org/s/angel/bg.jpg'; # TODO: Something better
- $opt{og}{url} ||= tuwf->reqURI;
- $opt{og}{title} ||= $opt{title};
- Meta property => "og:$_", content => ($opt{og}{$_} =~ s/\n/ /gr) for sort keys %{$opt{og}};
- }
- };
- Body sub {
- Div class => 'top-bar', id => 'top', '';
- Top \%opt;
- Div class => 'page-container', sub {
- Div mkclass(
- container => 1,
- 'main-container' => 1,
- 'container--narrow' => $opt{narrow},
- 'flex-center-container' => $opt{center},
- 'main-container--single-col' => $opt{single_col},
- $opt{main_classes} ? %{$opt{main_classes}} :()
- ), $body;
- Div class => 'container', sub {
- Div class => 'footer', sub {
- Div class => 'row', \&Bottom;
- };
- };
- };
- Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/elm.js', '';
- Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/vndb.js', '';
- #Script type => 'text/javascript', src => tuwf->conf->{url_static}.'/v3/min.js', '';
- };
- };
- if(tuwf->debug) {
- tuwf->dbCommit; # Hack to measure the commit time
-
- my $sql = uri_escape join "\n", map {
- my($sql, $params, $time) = @$_;
- sprintf " [%6.2fms] %s | %s", $time*1000, $sql,
- join ', ', map "$_:".DBI::neat($params->{$_}),
- sort { $a =~ /^[0-9]+$/ && $b =~ /^[0-9]+$/ ? $a <=> $b : $a cmp $b }
- keys %$params;
- } @{ tuwf->{_TUWF}{DB}{queries} };
- A href => 'data:text/plain,'.$sql, 'SQL';
-
- my $modules = uri_escape join "\n", sort keys %INC;
- A href => 'data:text/plain,'.$modules, 'Modules';
- }
-}
-
-
-sub EntryEdit {
- my($type, $e) = @_;
-
- return if $type eq 'u' && !auth->permUsermod;
-
- Div class => 'dropdown pull-right', sub {
- A href => 'javascript:;', class => 'btn d-block dropdown__toggle', sub {
- Div class => 'opacity-muted', sub {
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/edit.svg';
- Span class => 'caret', '';
- };
- };
- Div class => 'dropdown-menu dropdown-menu--right database-menu', sub {
- A class => 'dropdown-menu__item', href => "/$type$e->{id}", 'Details';
- A class => 'dropdown-menu__item', href => "/$type$e->{id}/hist", 'History' if $type ne 'u';
- A class => 'dropdown-menu__item', href => "/$type$e->{id}/edit", 'Edit' if can_edit $type, $e;
- A class => 'dropdown-menu__item', href => "/$type$e->{id}/add", 'Add release' if $type eq 'v' && can_edit $type, $e;
- A class => 'dropdown-menu__item', href => "/$type$e->{id}/addchar",'Add character' if $type eq 'v' && can_edit $type, $e;
- A class => 'dropdown-menu__item', href => "/$type$e->{id}/copy", 'Copy' if $type =~ /[cr]/ && can_edit $type, $e;
- };
- }
-}
-
-
-sub Switch {
- my $label = shift;
- my $on = shift;
- my @class = mkclass
- 'switch' => 1,
- 'switch--on' => $on,
- @_;
-
- A @class, href => 'javascript:;', sub {
- Div class => 'switch__label', $label;
- Div class => 'switch__toggle', '';
- };
-}
-
-
-# Throw any data structure on the page for inspection.
-sub Debug {
- return if !tuwf->debug;
- require JSON::XS;
- # This provides a nice JSON browser in FF, not sure how other browsers render it.
- my $data = uri_escape(JSON::XS->new->canonical->encode($_[0]));
- A style => 'margin: 0 5px', title => 'Debug', href => 'data:application/json,'.$data, ' โš™ ';
-}
-
-
-# Similar to join($sep, map $item->($_), @list), but works for HTML generation functions.
-# Join ', ', sub { A href => '#', $_[0] }, @list;
-# Join \&Br, \&Txt, @list;
-sub Join {
- my($sep, $item, @list) = @_;
- for my $i (0..$#list) {
- ref $sep ? $sep->() : Txt $sep if $i > 0;
- $item->($list[$i]);
- }
-}
-
-
-# Full-page form, optionally with sections. Options:
-#
-# module => '', # Elm module to load
-# data => $form_data,
-# schema => $tuwf_validate_schema, # Optional TUWF::Validate schema to use to encode the data
-# sections => [ # Optional list of sections
-# anchor1 => 'Section 1',
-# ..
-# ]
-#
-# If no sections are given, the parent Framework() should have narrow => 1.
-sub FullPageForm {
- my %o = @_;
-
- my $form = sub { Div
- 'data-elm-module' => $o{module},
- 'data-elm-flags' => JSON::XS->new->encode($o{schema} ? $o{schema}->analyze->coerce_for_json($o{data}) : $o{data}),
- ''
- };
-
- Div class => 'row', $o{sections} ? sub {
-
- Div class => 'col-md col-md--1', sub {
- Div class => 'nav-sidebar nav-sidebar--expand-md', sub {
- A href => 'javascript:;', class => 'nav-sidebar__selection', sub {
- Txt $o{sections}[1];
- Div class => 'caret', '';
- };
- Div class => 'nav nav--vertical', sub {
- my $x = 0;
- for my $s (pairs @{$o{sections}}) {
- Div mkclass(nav__item => 1, 'nav__item--active' => !$x++), sub {
- A class => 'nav__link', href => '#'.$s->key, $s->value;
- }
- }
- };
- }
- };
- Div class => 'col-md col-md--4', $form;
- } : sub {
- Div class => 'col-md col-md--1', $form;
- };
-}
-
-
-sub VoteGraph {
- my($type, $id) = @_;
-
- my %histogram = map +($_->{vote}, $_), @{ tuwf->dbAlli(q{
- SELECT (vote::numeric/10)::int AS vote, COUNT(vote) as votes, SUM(vote) AS total
- FROM votes},
- $type eq 'v' ? (q{
- JOIN users ON id = uid AND NOT ign_votes
- WHERE vid =}, \$id
- ) : (q{
- WHERE uid =}, \$id
- ), q{
- GROUP BY (vote::numeric/10)::int
- })};
-
- my $max = max map $_->{votes}, values %histogram;
- my $count = sum map $_->{votes}, values %histogram;
- my $sum = sum map $_->{total}, values %histogram;
-
- my $Graph = sub {
- Div class => 'vote-graph', sub {
- Div class => 'vote-graph__scores', sub {
- Div class => 'vote-graph__score', $_ for (reverse 1..10);
- };
- Div class => 'vote-graph__bars', sub {
- Div class => 'vote-graph__bar', style => sprintf('width: %.2f%%', ($histogram{$_}{votes}||0)/$max*100), sub {
- Div class => 'vote-graph__bar-label', $histogram{$_}{votes}||'1';
- } for (reverse 1..10);
- };
- };
- Div class => 'final-text',
- sprintf '%d vote%s total, average %.2f%s',
- $count, $count == 1 ? '' : 's', $sum/$count/10,
- $type eq 'v' ? ' ('.vote_string($sum/$count).')' : '';
- };
- return ($count, $Graph);
-}
-
-sub ListIcon {
- Lit q{<svg class="svg-icon" xmlns="http://www.w3.org/2000/svg" width="14" height="14" version="1">}
- .q{<g fill="currentColor" fill-rule="nonzero">}
- .q{<path d="M0 2h14v2H0zM0 6h14v2H0zM0 10h14v2H0z"/>}
- .q{</g>}
- .q{</svg>};
-}
-
-
-sub GridIcon {
- Lit q{<svg class="svg-icon" xmlns="http://www.w3.org/2000/svg" width="14" height="14" version="1">}
- .q{<g fill="currentColor" fill-rule="nonzero">}
- .q{<path d="M0 0h3v3H0zM0 5h3v3H0zM0 10h3v3H0zM5 0h3v3H5zM5 5h3v3H5zM5 10h3v3H5zM10 0h3v3h-3zM10 5h3v3h-3zM10 10h3v3h-3z"/>}
- .q{</g>}
- .q{</svg>};
-}
-
-1;
diff --git a/lib/VN3/Misc/Homepage.pm b/lib/VN3/Misc/Homepage.pm
deleted file mode 100644
index b9939b07..00000000
--- a/lib/VN3/Misc/Homepage.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package VN3::User::Login;
-
-use VN3::Prelude;
-
-
-TUWF::get '/' => sub {
- Framework title => 'VNDB', sub {
- H1 'Hello, World!';
- P sub {
- Txt 'This is the place where version 3 of ';
- A href => 'https://vndb.org/', 'VNDB.org';
- Txt ' is being developed. Some random notes:';
- Ul sub {
- Li 'This test site interfaces directly with the same database as the main site, which makes it easier to test all the functionality and find odd test cases.';
- Li 'This test site is very incomplete, don\'t be surprised to see 404\'s or other things that don\'t work.';
- Li 'This is a long-term project, don\'t expect this new design to replace the main site anytime soon.';
- Li sub {
- Txt 'Feedback/comments/ideas or want to help out? Post in ';
- A href => 'https://code.blicky.net/yorhel/vndb/issues/2', 'this issue';
- Txt ' or create a new one.';
- };
- Li sub {
- Txt 'You can follow development activity on the ';
- A href => 'https://code.blicky.net/yorhel/vndb/src/branch/v3', 'git repo.';
- };
- };
- };
- };
-};
-
-1;
diff --git a/lib/VN3/Misc/ImageUpload.pm b/lib/VN3/Misc/ImageUpload.pm
deleted file mode 100644
index 76a07975..00000000
--- a/lib/VN3/Misc/ImageUpload.pm
+++ /dev/null
@@ -1,70 +0,0 @@
-package VN3::Misc::ImageUpload;
-
-use VN3::Prelude;
-use Image::Magick;
-
-
-sub save_img {
- my($im, $dir, $id, $ow, $oh, $pw, $ph) = @_;
-
- if($pw) {
- my($nw, $nh) = imgsize($ow, $oh, $pw, $ph);
- if($ow != $nw || $oh != $nh) {
- $im->GaussianBlur(geometry => '0.5x0.5');
- $im->Resize(width => $nw, height => $nh);
- $im->UnsharpMask(radius => 0, sigma => 0.75, amount => 0.75, threshold => 0.008);
- }
- }
-
- my $fn = tuwf->imgpath($dir, $id);
- $im->Write($fn);
- chmod 0666, $fn;
-}
-
-my $elm_ImgFormat = elm_api 'ImgFormat';
-my $elm_Image = elm_api 'Image', {id=>1}, {uint=>1}, {uint=>1}; # id, width, height
-
-
-TUWF::post '/js/imageupload.json', sub {
- if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
- warn "Invalid CSRF token in request";
- return $elm_CSRF->();
- }
- return $elm_Unauth->() if !auth->permEdit;
-
- my $type = tuwf->validate(post => type => { enum => [qw/cv ch sf/] })->data;
- my $imgdata = tuwf->reqUploadRaw('img');
- return $elm_ImgFormat->() if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG header
-
- my $im = Image::Magick->new;
- $im->BlobToImage($imgdata);
- $im->Set(magick => 'JPEG');
- $im->Set(background => '#ffffff');
- $im->Set(alpha => 'Remove');
- $im->Set(quality => 90);
- my($ow, $oh) = ($im->Get('width'), $im->Get('height'));
- my $id;
-
-
- # VN cover image
- if($type eq 'cv') {
- $id = tuwf->dbVali("SELECT nextval('covers_seq')");
- save_img $im, cv => $id, $ow, $oh, 256, 400;
-
- # Screenshot
- } elsif($type eq 'sf') {
- $id = tuwf->dbVali('INSERT INTO screenshots', { width => $ow, height => $oh }, 'RETURNING id');
- save_img $im, sf => $id;
- save_img $im, st => $id, $ow, $oh, 136, 102;
-
- # Character image
- } elsif($type eq 'ch') {
- $id = tuwf->dbVali("SELECT nextval('charimg_seq')");
- save_img $im, ch => $id, $ow, $oh, 256, 300;
- }
-
- $elm_Image->($id, $ow, $oh);
-};
-
-
-1;
diff --git a/lib/VN3/Prelude.pm b/lib/VN3/Prelude.pm
deleted file mode 100644
index a10a66ac..00000000
--- a/lib/VN3/Prelude.pm
+++ /dev/null
@@ -1,104 +0,0 @@
-# Importing this module is equivalent to:
-#
-# use strict;
-# use warnings;
-# use v5.10;
-# use utf8;
-#
-# use TUWF ':Html5', 'mkclass';
-# use Exporter 'import';
-# use Time::HiRes 'time';
-#
-# use VNDBUtil;
-# use VNDB::Types;
-# use VNWeb::Auth;
-# use VN3::HTML;
-# use VN3::DB;
-# use VN3::Types;
-# use VN3::Validation;
-# use VN3::BBCode;
-# use VN3::ElmGen;
-#
-# WARNING: This should not be used from the above modules.
-#
-# This module also exports a few utility functions for writing URI handlers.
-package VN3::Prelude;
-
-use strict;
-use warnings;
-use utf8;
-use feature ':5.10';
-use TUWF;
-use VNWeb::Auth;
-use VN3::ElmGen;
-
-sub import {
- my $c = caller;
-
- strict->import;
- warnings->import;
- feature->import(':5.10');
- utf8->import;
-
- die $@ if !eval <<" EOM;";
- package $c;
-
- use TUWF ':Html5', 'mkclass';
- use Exporter 'import';
- use Time::HiRes 'time';
-
- use VNDBUtil;
- use VNDB::Types;
- use VNWeb::Auth;
- use VN3::HTML;
- use VN3::DB;
- use VN3::Types;
- use VN3::Validation;
- use VN3::BBCode;
- use VN3::ElmGen;
- 1;
- EOM;
-
- no strict 'refs';
- *{$c.'::json_api'} = \&json_api;
-}
-
-
-
-# Easy wrapper to create a simple API that accepts JSON data on POST requests.
-# The CSRF token and the input data are validated before the subroutine is
-# called.
-#
-# Usage:
-#
-# json_api '/some/url', {
-# username => { maxlength => 10 },
-# }, sub {
-# my $validated_data = shift;
-# };
-my $elm_Invalid = elm_api 'Invalid', {};
-sub json_api {
- my($path, $keys, $sub) = @_;
-
- my $schema = ref $keys eq 'HASH' ? tuwf->compile({ type => 'hash', keys => $keys }) : $keys;
-
- TUWF::post $path => sub {
- if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
- warn "Invalid CSRF token in request\n";
- $elm_CSRF->();
- return;
- }
-
- my $data = tuwf->validate(json => $schema);
- if(!$data) {
- warn "JSON validation failed\ninput: " . JSON::XS->new->allow_nonref->pretty->canonical->encode(tuwf->reqJSON) . "\nerror: " . JSON::XS->new->encode($data->err) . "\n";
- $elm_Invalid->($data->err);
- return;
- }
-
- $sub->($data->data);
- warn "Non-JSON response to a json_api request, is this intended?\n" if tuwf->resHeader('Content-Type') !~ /^application\/json/;
- };
-}
-
-1;
diff --git a/lib/VN3/Producer/Edit.pm b/lib/VN3/Producer/Edit.pm
deleted file mode 100644
index 3643d771..00000000
--- a/lib/VN3/Producer/Edit.pm
+++ /dev/null
@@ -1,136 +0,0 @@
-package VN3::Producer::Edit;
-
-use VN3::Prelude;
-
-
-my $FORM = {
- alias => { required => 0, default => '', maxlength => 500 },
- desc => { required => 0, default => '', maxlength => 5000 },
- hidden => { anybool => 1 },
- l_wp => { required => 0, default => '', maxlength => 150 },
- lang => { language => 1 },
- locked => { anybool => 1 },
- original => { required => 0, default => '', maxlength => 200 },
- name => { maxlength => 200 },
- ptype => { enum => \%PRODUCER_TYPE }, # This is 'type' in the database, but renamed for Elm compat
- relations => { maxlength => 50, sort_keys => 'pid', aoh => {
- pid => { id => 1 }, # X
- relation => { producer_relation => 1 },
- name => { _when => 'out' },
- } },
- website => { required => 0, default => '', weburl => 1 },
-
- id => { _when => 'out', required => 0, id => 1 },
- authmod => { _when => 'out', anybool => 1 },
- editsum => { _when => 'in out', editsum => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form ProdEdit => $FORM_OUT, $FORM_IN;
-
-
-TUWF::get qr{/$PREV_RE/edit} => sub {
- my $p = entry p => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit p => $p;
-
- enrich pid => q{SELECT id AS pid, name FROM producers WHERE id IN} => $p->{relations};
-
- $p->{l_wp} //= ''; # TODO: The DB currently uses NULL when no wp link is provided, this should be an empty string instead to be consistent with most other fields.
- $p->{ptype} = delete $p->{type};
- $p->{authmod} = auth->permDbmod;
- $p->{editsum} = $p->{chrev} == $p->{maxrev} ? '' : "Reverted to revision p$p->{id}.$p->{chrev}";
-
- Framework index => 0, title => "Edit $p->{name}",
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit p => $p;
- Div class => 'detail-page-title', sub {
- Txt $p->{name};
- Debug $p;
- };
- };
- }, sub {
- FullPageForm module => 'ProdEdit.Main', data => $p, schema => $FORM_OUT, sections => [
- general => 'General info',
- relations => 'Relations',
- ];
- };
-};
-
-
-TUWF::get '/p/add', sub {
- return tuwf->resDenied if !auth->permEdit;
- Framework index => 0, title => 'Add a new producer', narrow => 1, sub {
- Div class => 'row', sub {
- Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'ProdEdit.New', '' };
- };
- };
-};
-
-
-json_api qr{/(?:$PID_RE/edit|p/add)}, $FORM_IN, sub {
- my $data = shift;
- my $new = !tuwf->capture('id');
- my $p = $new ? { id => 0 } : entry p => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit p => $p;
-
- $data->{l_wp} ||= undef;
- if(!auth->permDbmod) {
- $data->{hidden} = $p->{hidden}||0;
- $data->{locked} = $p->{locked}||0;
- }
- $data->{relations} = [] if $data->{hidden};
-
- die "Relation with self" if grep $_->{pid} == $p->{id}, @{$data->{relations}};
- validate_dbid 'SELECT id FROM producers WHERE id IN', map $_->{pid}, @{$data->{relations}};
-
- $data->{desc} = bb_subst_links $data->{desc};
-
- $p->{ptype} = delete $p->{type};
- return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $p;
- $data->{type} = delete $data->{ptype};
-
- my($id,undef,$rev) = update_entry p => $p->{id}, $data;
-
- update_reverse($id, $rev, $p, $data);
-
- $elm_Changed->($id, $rev);
-};
-
-
-sub update_reverse {
- my($id, $rev, $old, $new) = @_;
-
- my %old = map +($_->{pid}, $_), $old->{relations} ? @{$old->{relations}} : ();
- my %new = map +($_->{pid}, $_), @{$new->{relations}};
-
- # Updates to be performed, pid => { pid => x, relation => y } or undef if the relation should be removed.
- my %upd;
-
- for my $i (keys %old, keys %new) {
- if($old{$i} && !$new{$i}) {
- $upd{$i} = undef;
- } elsif(!$old{$i} || $old{$i}{relation} ne $new{$i}{relation}) {
- $upd{$i} = {
- pid => $id,
- relation => producer_relation_reverse($new{$i}{relation}),
- };
- }
- }
-
- for my $i (keys %upd) {
- my $p = entry p => $i;
- $p->{relations} = [
- $upd{$i} ? $upd{$i} : (),
- grep $_->{pid} != $id, @{$p->{relations}}
- ];
- $p->{editsum} = "Reverse relation update caused by revision p$id.$rev";
- update_entry p => $i, $p, 1;
- }
-}
-
-1;
diff --git a/lib/VN3/Producer/JS.pm b/lib/VN3/Producer/JS.pm
deleted file mode 100644
index 50161ce5..00000000
--- a/lib/VN3/Producer/JS.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package VN3::Producer::JS;
-
-use VN3::Prelude;
-
-
-my $elm_ProducerResult = elm_api ProducerResult => { aoh => {
- id => { id => 1 },
- name => {},
- original => {},
- hidden => { anybool => 1 },
-}};
-
-
-json_api '/js/producer.json', {
- search => { type => 'array', scalar => 1, minlength => 1, values => { maxlength => 500 } },
- hidden => { anybool => 1 }
-}, sub {
- my $data = shift;
-
- my $r = tuwf->dbAlli(
- 'SELECT p.id, p.name, p.original, p.hidden',
- 'FROM (', (sql_join 'UNION ALL', map {
- my $q = $_;
- my $qs = s/[%_]//gr;
- +(
- # ID search
- /^$PID_RE$/ ? (sql 'SELECT 1, id FROM producers WHERE id =', \"$1") : (),
- # exact match
- sql('SELECT 2, id FROM producers WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')'),
- # prefix match
- sql('SELECT 3, id FROM producers WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%"),
- # substring match
- sql('SELECT 4, id FROM producers WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%", ' OR alias ILIKE', \"%$qs%")
- )
- } @{$data->{search}}),
- ') AS pt (ord, id)',
- 'JOIN producers p ON p.id = pt.id',
- $data->{hidden} ? () : ('WHERE NOT p.hidden'),
- 'GROUP BY p.id',
- 'ORDER BY MIN(pt.ord), p.name',
- 'LIMIT 20'
- );
-
- $elm_ProducerResult->($r);
-};
-
-1;
diff --git a/lib/VN3/Producer/Page.pm b/lib/VN3/Producer/Page.pm
deleted file mode 100644
index 89cd9dd8..00000000
--- a/lib/VN3/Producer/Page.pm
+++ /dev/null
@@ -1,117 +0,0 @@
-package VN3::Producer::Page;
-
-use VN3::Prelude;
-
-# TODO: Releases/VNs
-# TODO: Relation graph
-
-sub Notes {
- my $e = shift;
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Notes';
- };
- Div class => 'col-md', sub {
- Div class => 'description serif mb-5', sub {
- P sub { Lit bb2html $e->{desc} };
- };
- };
- } if $e->{desc};
-}
-
-
-sub DetailsTable {
- my $e = shift;
-
- my @links = (
- $e->{website} ? [ 'Official website', $e->{website} ] : (),
- $e->{l_wp} ? [ 'Wikipedia', "https://en.wikipedia.org/wiki/$e->{l_wp}" ] : (),
- );
-
- my %rel;
- push @{$rel{$_->{relation}}}, $_ for (sort { $a->{name} cmp $b->{name} } @{$e->{relations}});
-
- my @list = (
- $e->{alias} ? sub {
- Dt $e->{alias} =~ /\n/ ? 'Aliases' : 'Alias';
- Dd $e->{alias} =~ s/\n/, /gr;
- } : (),
-
- sub {
- Dt 'Type';
- Dd $PRODUCER_TYPE{$e->{type}};
- },
-
- sub {
- Dt 'Language';
- Dd sub {
- Lang $e->{lang};
- Txt " $LANGUAGE{$e->{lang}}";
- }
- },
-
- @links ? sub {
- Dt 'Links';
- Dd sub {
- Join ', ', sub { A href => $_[0][1], rel => 'nofollow', $_[0][0] }, @links;
- };
- } : (),
-
- (map {
- my $r = $_;
- sub {
- Dt producer_relation_display $r;
- Dd sub {
- Join ', ', sub {
- A href => "/p$_[0]{pid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name};
- }, @{$rel{$r}}
- }
- }
- } grep $rel{$_}, keys %PRODUCER_RELATION)
- );
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Details';
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Div class => 'card__section fs-medium', sub {
- Div class => 'row', sub {
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] };
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] };
- }
- }
- }
- }
- } if @list;
-}
-
-
-TUWF::get qr{/$PREV_RE}, sub {
- my $e = entry p => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resNotFound if !$e->{id} || $e->{hidden};
-
- enrich pid => q{SELECT id AS pid, name, original FROM producers WHERE id IN}, $e->{relations};
-
- Framework
- title => $e->{name},
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit p => $e;
- Div class => 'detail-page-title', sub {
- Txt $e->{name};
- Debug $e;
- };
- Div class => 'detail-page-subtitle', $e->{original} if $e->{original};
- # TODO: link to discussions page. Prolly needs a TopNav
- }
- },
- sub {
- DetailsTable $e;
- Notes $e;
- };
-};
-
-1;
diff --git a/lib/VN3/Release/Edit.pm b/lib/VN3/Release/Edit.pm
deleted file mode 100644
index 030c0711..00000000
--- a/lib/VN3/Release/Edit.pm
+++ /dev/null
@@ -1,130 +0,0 @@
-package VN3::Release::Edit;
-
-use VN3::Prelude;
-
-my $FORM = {
- hidden => { anybool => 1 },
- locked => { anybool => 1 },
- title => { maxlength => 250 },
- original => { required => 0, default => '', maxlength => 250 },
- rtype => { enum => [ release_types ] }, # This is 'type' in the database, but renamed for Elm compat
- patch => { anybool => 1 },
- freeware => { anybool => 1 },
- doujin => { anybool => 1 },
- lang => { minlength => 1, sort_keys => 'lang', aoh => { lang => { language => 1 } } },
- gtin => { gtin => 1 },
- catalog => { required => 0, default => '', maxlength => 50 },
- website => { required => 0, default => '', weburl => 1 },
- released => { rdate => 1, min => 1 },
- minage => { required => 0, minage => 1 },
- uncensored => { anybool => 1 },
- notes => { required => 0, default => '', maxlength => 10240 },
- resolution => { resolution => 1 },
- voiced => { voiced => 1 },
- ani_story => { animated => 1 },
- ani_ero => { animated => 1 },
- platforms => { sort_keys => 'platform', aoh => { platform => { platform => 1 } } },
- media => { sort_keys => ['media', 'qty'], aoh => {
- medium => { medium => 1 },
- qty => { uint => 1, range => [0,20] },
- } },
- vn => { length => [1,50], sort_keys => 'vid', aoh => {
- vid => { id => 1 }, # X
- title => { _when => 'out' },
- } },
- producers => { maxlength => 50, sort_keys => 'pid', aoh => {
- pid => { id => 1 }, # X
- developer => { anybool => 1 },
- publisher => { anybool => 1 },
- name => { _when => 'out' },
- } },
-
- id => { _when => 'out', required => 0, id => 1 },
- authmod => { _when => 'out', anybool => 1 },
- editsum => { _when => 'in out', editsum => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form RelEdit => $FORM_OUT, $FORM_IN;
-
-TUWF::get qr{/$RREV_RE/(?<type>edit|copy)}, sub {
- my $r = entry r => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit r => $r;
- my $copy = tuwf->capture('type') eq 'copy';
-
- enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $r->{vn};
- enrich pid => q{SELECT id AS pid, name FROM producers WHERE id IN} => $r->{producers};
-
- $r->{rtype} = delete $r->{type};
- $r->{authmod} = auth->permDbmod;
- $r->{editsum} = $copy ? "Copied from r$r->{id}.$r->{chrev}" : $r->{chrev} == $r->{maxrev} ? '' : "Reverted to revision r$r->{id}.$r->{chrev}";
-
- my $title = sprintf '%s %s', $copy ? 'Copy' : 'Edit', $r->{title};
- Framework title => $title,
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit r => $r;
- Div class => 'detail-page-title', sub {
- Txt $title;
- Debug $r;
- };
- };
- }, sub {
- FullPageForm module => 'RelEdit.Main', schema => $FORM_OUT, data => { %$r, $copy ? (id => undef) : () }, sections => [
- general => 'General info',
- format => 'Format',
- relations => 'Relations'
- ];
- };
-};
-
-
-TUWF::get qr{/$VID_RE/add}, sub {
- return tuwf->resDenied if !auth->permEdit;
-
- my $vn = tuwf->dbRowi('SELECT id, title, original FROM vn WHERE NOT hidden AND id =', \tuwf->capture('id'));
- return tuwf->resNotFound if !$vn->{id};
-
- Framework index => 0, title => "Add a new release to $vn->{title}", narrow => 1, sub {
- FullPageForm module => 'RelEdit.New', data => $vn, sections => [
- general => 'General info',
- format => 'Format',
- relations => 'Relations'
- ];
- };
-};
-
-
-json_api qr{/(?:$RID_RE/edit|r/add)}, $FORM_IN, sub {
- my $data = shift;
- my $new = !tuwf->capture('id');
- my $rel = $new ? { id => 0 } : entry r => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit r => $rel;
-
- if(!auth->permDbmod) {
- $data->{hidden} = $rel->{hidden}||0;
- $data->{locked} = $rel->{locked}||0;
- }
- $data->{doujin} = $data->{voiced} = $data->{ani_story} = $data->{ani_ero} = 0 if $data->{patch};
- $data->{resolution} = 'unknown' if $data->{patch};
- $data->{uncensored} = 0 if !$data->{minage} || $data->{minage} != 18;
- $_->{qty} = $MEDIUM{$_->{medium}}{qty} ? $_->{qty}||1 : 0 for @{$data->{media}};
-
- validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{vn}};
- validate_dbid 'SELECT id FROM producers WHERE id IN', map $_->{pid}, @{$data->{producers}};
-
- $data->{notes} = bb_subst_links $data->{notes};
-
- $rel->{rtype} = delete $rel->{type};
- return $elm_Unchanged() if !$new && !form_changed $FORM_CMP, $data, $rel;
- $data->{type} = delete $data->{rtype};
-
- my($id,undef,$rev) = update_entry r => $rel->{id}, $data;
- $elm_Changed->($id, $rev);
-};
-
-1;
diff --git a/lib/VN3/Release/JS.pm b/lib/VN3/Release/JS.pm
deleted file mode 100644
index 152fd69a..00000000
--- a/lib/VN3/Release/JS.pm
+++ /dev/null
@@ -1,32 +0,0 @@
-package VN3::Release::JS;
-
-use VN3::Prelude;
-
-
-my $elm_ReleaseResult = elm_api ReleaseResult => { aoh => {
- id => { id => 1 },
- title => {},
- lang => { type => 'array', values => {} },
-}};
-
-
-# Fetch all releases assigned to a VN
-json_api '/js/release.json', {
- vid => { id => 1 },
-}, sub {
- my $vid = shift->{vid};
-
- my $r = tuwf->dbAlli(q{
- SELECT r.id, r.title
- FROM releases r
- JOIN releases_vn rv ON rv.id = r.id
- WHERE NOT r.hidden
- AND rv.vid =}, \$vid, q{
- ORDER BY r.id
- });
- enrich_list1 lang => id => id => sub { sql 'SELECT id, lang FROM releases_lang WHERE id IN', $_[0], 'ORDER BY id, lang' }, $r;
-
- $elm_ReleaseResult->($r);
-};
-
-1;
diff --git a/lib/VN3/Release/Page.pm b/lib/VN3/Release/Page.pm
deleted file mode 100644
index 03d3bd5c..00000000
--- a/lib/VN3/Release/Page.pm
+++ /dev/null
@@ -1,184 +0,0 @@
-package VN3::Release::Page;
-
-use VN3::Prelude;
-
-# TODO: Userlist options
-
-
-sub Notes {
- my $e = shift;
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Notes';
- };
- Div class => 'col-md', sub {
- Div class => 'description serif mb-5', sub {
- P sub { Lit bb2html $e->{notes} };
- };
- };
- } if $e->{notes};
-}
-
-
-sub DetailsTable {
- my $e = shift;
-
- # TODO: Some of these properties could be moved into the title header thing
- # (type and languages, in particular)
- # (Not even sure this table format makes sense for all properties, there's gotta be a nicer way)
- my @list = (
- @{$e->{vn}} ? sub {
- Dt @{$e->{vn}} == 1 ? 'Visual Novel' : 'Visual Novels';
- Dd sub {
- Join \&Br, sub {
- A href => "/v$_[0]{vid}", title => $_[0]{original}||$_[0]{title}, $_[0]{title};
- }, @{$e->{vn}};
- }
- } : (),
-
- sub {
- Dt 'Type';
- Dd sub {
- Txt ucfirst $e->{type};
- Txt ", patch" if $e->{patch};
- }
- },
-
- sub {
- Dt 'Released';
- Dd sub { ReleaseDate $e->{released} };
- },
-
- sub {
- Dt @{$e->{lang}} > 1 ? 'Languages' : 'Language';
- Dd sub {
- Join \&Br, sub {
- Lang $_[0]{lang};
- Txt " $LANGUAGE{$_[0]{lang}}";
- }, @{$e->{lang}};
- }
- },
-
- sub {
- Dt 'Publication';
- Dd join ', ',
- $e->{freeware} ? 'Freeware' : 'Non-free',
- $e->{patch} ? () : ($e->{doujin} ? 'doujin' : 'commercial')
- },
-
- $e->{minage} && $e->{minage} >= 0 ? sub {
- Dt 'Age rating';
- Dd minage_display $e->{minage};
- } : (),
-
- @{$e->{platforms}} ? sub {
- Dt @{$e->{platforms}} == 1 ? 'Platform' : 'Platforms';
- Dd sub {
- Join \&Br, sub {
- Platform $_[0]{platform};
- Txt " $PLATFORM{$_[0]{platform}}";
- }, @{$e->{platforms}};
- }
- } : (),
-
- @{$e->{media}} ? sub {
- Dt @{$e->{media}} == 1 ? 'Medium' : 'Media';
- Dd join ', ', map media_display($_->{medium}, $_->{qty}), @{$e->{media}};
- } : (),
-
- $e->{voiced} ? sub {
- Dt 'Voiced';
- Dd $VOICED{$e->{voiced}}{txt};
- } : (),
-
- $e->{ani_story} ? sub {
- Dt 'Story animation';
- Dd $ANIMATED{$e->{ani_story}}{txt};
- } : (),
-
- $e->{ani_ero} ? sub {
- Dt 'Ero animation';
- Dd $ANIMATED{$e->{ani_ero}}{txt};
- } : (),
-
- $e->{minage} && $e->{minage} == 18 ? sub {
- Dt 'Censoring';
- Dd $e->{uncensored} ? 'No optical censoring (e.g. mosaics)' : 'May include optical censoring (e.g. mosaics)';
- } : (),
-
- $e->{gtin} ? sub {
- Dt gtintype($e->{gtin}) || 'GTIN';
- Dd $e->{gtin};
- } : (),
-
- $e->{catalog} ? sub {
- Dt 'Catalog no.';
- Dd $e->{catalog};
- } : (),
-
- (map {
- my $type = $_;
- my @prod = grep $_->{$type}, @{$e->{producers}};
- @prod ? sub {
- Dt ucfirst($type) . (@prod == 1 ? '' : 's');
- Dd sub {
- Join \&Br, sub {
- A href => "/p$_[0]{pid}", title => $_[0]{original}||$_[0]{name}, $_[0]{name};
- }, @prod;
- }
- } : ()
- } 'developer', 'publisher'),
-
- $e->{website} ? sub {
- Dt 'Links';
- Dd sub {
- A href => $e->{website}, rel => 'nofollow', 'Official website';
- };
- } : (),
- );
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Details';
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Div class => 'card__section fs-medium', sub {
- Div class => 'row', sub {
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] };
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] };
- }
- }
- }
- }
- } if @list;
-}
-
-
-TUWF::get qr{/$RREV_RE}, sub {
- my $e = entry r => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resNotFound if !$e->{id} || $e->{hidden};
-
- enrich vid => q{SELECT id AS vid, title, original FROM vn WHERE id IN}, $e->{vn};
- enrich pid => q{SELECT id AS pid, name, original FROM producers WHERE id IN}, $e->{producers};
-
- Framework
- title => $e->{title},
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit r => $e;
- Div class => 'detail-page-title', sub {
- Txt $e->{title};
- Debug $e;
- };
- Div class => 'detail-page-subtitle', $e->{original} if $e->{original};
- }
- },
- sub {
- DetailsTable $e;
- Notes $e;
- };
-};
-
-1;
diff --git a/lib/VN3/Staff/Edit.pm b/lib/VN3/Staff/Edit.pm
deleted file mode 100644
index 0b9c3af4..00000000
--- a/lib/VN3/Staff/Edit.pm
+++ /dev/null
@@ -1,108 +0,0 @@
-package VN3::Staff::Edit;
-
-use VN3::Prelude;
-
-
-my $FORM = {
- aid => { int => 1, range => [ -1000, 1<<40 ] }, # X
- alias => { maxlength => 100, sort_keys => 'aid', aoh => {
- aid => { int => 1, range => [ -1000, 1<<40 ] }, # X, negative IDs are for new aliases
- name => { maxlength => 200 },
- original => { maxlength => 200, required => 0, default => '' },
- inuse => { anybool => 1, _when => 'out' },
- } },
- desc => { required => 0, default => '', maxlength => 5000 },
- gender => { gender => 1 },
- hidden => { anybool => 1 },
- l_site => { required => 0, default => '', weburl => 1 },
- l_wp => { required => 0, default => '', maxlength => 150 },
- l_twitter => { required => 0, default => '', maxlength => 150 },
- l_anidb => { required => 0, id => 1 },
- lang => { language => 1 },
- locked => { anybool => 1 },
-
- id => { _when => 'out', required => 0, id => 1 },
- authmod => { _when => 'out', anybool => 1 },
- editsum => { _when => 'in out', editsum => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form StaffEdit => $FORM_OUT, $FORM_IN;
-
-
-TUWF::get qr{/$SREV_RE/edit} => sub {
- my $e = entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit s => $e;
-
- $e->{authmod} = auth->permDbmod;
- $e->{editsum} = $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision s$e->{id}.$e->{chrev}";
-
- enrich aid => sub { sql '
- SELECT aid, EXISTS(SELECT 1 FROM vn_staff WHERE aid = x.aid UNION ALL SELECT 1 FROM vn_seiyuu WHERE aid = x.aid) AS inuse
- FROM unnest(', sql_array(@{$_[0]}), '::int[]) AS x(aid)'
- }, $e->{alias};
-
- my $name = (grep $_->{aid} == $e->{aid}, @{$e->{alias}})[0]{name};
- Framework index => 0, narrow => 1, title => "Edit $name",
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit s => $e;
- Div class => 'detail-page-title', sub {
- Txt $name,
- Debug $e;
- };
- };
- }, sub {
- FullPageForm module => 'StaffEdit.Main', data => $e, schema => $FORM_OUT;
- };
-};
-
-
-TUWF::get '/s/new', sub {
- return tuwf->resDenied if !auth->permEdit;
- Framework index => 0, title => 'Add a new staff entry', narrow => 1, sub {
- Div class => 'row', sub {
- Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'StaffEdit.New', '' };
- };
- };
-};
-
-
-json_api qr{/(?:$SID_RE/edit|s/add)}, $FORM_IN, sub {
- my $data = shift;
- my $new = !tuwf->capture('id');
- my $e = $new ? { id => 0 } : entry s => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit s => $e;
-
- if(!auth->permDbmod) {
- $data->{hidden} = $e->{hidden}||0;
- $data->{locked} = $e->{locked}||0;
- }
-
- # For positive alias IDs: Make sure they exist and are owned by this entry.
- validate_dbid
- sub { sql 'SELECT aid FROM staff_alias WHERE id =', \$e->{id}, ' AND aid IN', $_[0] },
- grep $_>=0, map $_->{aid}, @{$data->{alias}};
-
- # For negative alias IDs: Assign a new ID.
- for my $alias (@{$data->{alias}}) {
- if($alias->{aid} < 0) {
- my $new = tuwf->dbVali(select => sql_func nextval => \'staff_alias_aid_seq');
- $data->{aid} = $new if $alias->{aid} == $data->{aid};
- $alias->{aid} = $new;
- }
- }
- # We rely on Postgres to throw an error if we attempt to delete an alias that is still being referenced.
-
- $data->{desc} = bb_subst_links $data->{desc};
-
- return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $e;
- my($id,undef,$rev) = update_entry s => $e->{id}, $data;
- $elm_Changed->($id, $rev);
-};
-
-1;
diff --git a/lib/VN3/Staff/JS.pm b/lib/VN3/Staff/JS.pm
deleted file mode 100644
index 58ce947b..00000000
--- a/lib/VN3/Staff/JS.pm
+++ /dev/null
@@ -1,43 +0,0 @@
-package Staff::JS;
-
-use VN3::Prelude;
-
-my $elm_StaffResult = elm_api StaffResult => { aoh => {
- id => { id => 1 },
- aid => { id => 1 },
- name => {},
- original => {},
-}};
-
-json_api '/js/staff.json', {
- search => { maxlength => 500 }
-}, sub {
- my $q = shift->{search};
-
- # XXX: This query is kinda slow
- my $qs = $q =~ s/[%_]//gr;
- my $r = tuwf->dbAlli(
- 'SELECT s.id, st.aid, st.name, st.original',
- 'FROM (',
- # ID search
- $q =~ /^$SID_RE$/ ? ('SELECT 1, id, aid, name, original FROM staff_alias WHERE id =', \"$1", 'UNION ALL') : (),
- # exact match
- 'SELECT 2, id, aid, name, original FROM staff_alias WHERE lower(name) = lower(', \$q, ") OR lower(translate(original,' ', '')) = lower(", \($q =~ s/\s//gr), ')',
- 'UNION ALL',
- # prefix match
- 'SELECT 3, id, aid, name, original FROM staff_alias WHERE name ILIKE', \"$qs%", ' OR original ILIKE', \"$qs%",
- 'UNION ALL',
- # substring match
- 'SELECT 4, id, aid, name, original FROM staff_alias WHERE name ILIKE', \"%$qs%", ' OR original ILIKE', \"%$qs%",
- ') AS st (ord, id, aid, name, original)',
- 'JOIN staff s ON s.id = st.id',
- 'WHERE NOT s.hidden',
- 'GROUP BY s.id, st.aid, st.name, st.original',
- 'ORDER BY MIN(st.ord), st.name',
- 'LIMIT 20'
- );
-
- $elm_StaffResult->($r);
-};
-
-1;
diff --git a/lib/VN3/Staff/Page.pm b/lib/VN3/Staff/Page.pm
deleted file mode 100644
index 2d8cd349..00000000
--- a/lib/VN3/Staff/Page.pm
+++ /dev/null
@@ -1,213 +0,0 @@
-package VN3::Staff::Page;
-
-use VN3::Prelude;
-
-sub Notes {
- my $e = shift;
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Notes';
- };
- Div class => 'col-md', sub {
- Div class => 'description serif mb-5', sub {
- P sub { Lit bb2html $e->{desc} };
- };
- };
- } if $e->{desc};
-}
-
-
-sub DetailsTable {
- my $e = shift;
-
- my @links = (
- $e->{l_site} ? [ 'Official website', $e->{l_site} ] : (),
- $e->{l_wp} ? [ 'Wikipedia', "https://en.wikipedia.org/wiki/$e->{l_wp}" ] : (),
- $e->{l_twitter} ? [ 'Twitter', "https://twitter.com/$e->{l_twitter}" ] : (),
- $e->{l_anidb} ? [ 'AniDB', "http://anidb.net/cr$e->{l_anidb}" ] : (),
- );
- my @alias = grep $_->{aid} != $e->{aid}, @{$e->{alias}};
-
- my @list = (
- @alias ? sub {
- Dt @alias > 1 ? 'Aliases' : 'Alias';
- Dd sub {
- Join \&Br, sub {
- Txt $_[0]{name};
- Txt " ($_[0]{original})" if $_[0]{original};
- }, sort { $a->{name} cmp $b->{name} || $a->{original} cmp $b->{original} } @alias;
- }
- } : (),
-
- sub {
- Dt 'Language';
- Dd sub {
- Lang $e->{lang};
- Txt " $LANGUAGE{$e->{lang}}";
- }
- },
-
- @links ? sub {
- Dt 'Links';
- Dd sub {
- Join ', ', sub { A href => $_[0][1], rel => 'nofollow', $_[0][0] }, @links;
- };
- } : (),
- );
-
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Details';
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Div class => 'card__section fs-medium', sub {
- Div class => 'row', sub {
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[0..$#list/2] };
- Dl class => 'col-md dl--horizontal', sub { $_->() for @list[$#list/2+1..$#list] };
- }
- }
- }
- }
- } if @list;
-}
-
-
-sub Roles {
- my $e = shift;
-
- my $roles = tuwf->dbAlli(q{
- SELECT sa.id, sa.aid, v.id AS vid, sa.name, sa.original, v.c_released, v.title, v.original AS t_original, vs.role, vs.note
- FROM vn_staff vs
- JOIN vn v ON v.id = vs.id
- JOIN staff_alias sa ON vs.aid = sa.aid
- WHERE sa.id =}, \$e->{id}, q{ AND NOT v.hidden
- ORDER BY v.c_released ASC, v.title ASC, vs.role ASC
- });
- return if !@$roles;
-
- my $rows = sub {
- for my $r (@$roles) {
- Tr sub {
- Td class => 'tabular-nums muted', sub { ReleaseDate $r->{c_released} };
- Td sub {
- A href => "/v$r->{vid}", title => $r->{t_original}||$r->{title}, $r->{title};
- };
- Td $CREDIT_TYPE{$r->{role}};
- Td title => $r->{original}||$r->{name}, $r->{name};
- Td $r->{note};
- };
- }
- };
-
- # TODO: Full-width table? It's pretty dense
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Credits';
- Debug $roles;
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Table class => 'table table--responsive-single-sm fs-medium', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', 'Date';
- Th width => '30%', 'Title';
- Th width => '20%', 'Role';
- Th width => '20%', 'As';
- Th width => '15%', 'Note';
- };
- };
- Tbody $rows;
- };
- }
- }
- }
-}
-
-
-sub Cast {
- my $e = shift;
-
- my $cast = tuwf->dbAlli(q{
- SELECT sa.id, sa.aid, v.id AS vid, sa.name, sa.original, v.c_released, v.title, v.original AS t_original, c.id AS cid, c.name AS c_name, c.original AS c_original, vs.note
- FROM vn_seiyuu vs
- JOIN vn v ON v.id = vs.id
- JOIN chars c ON c.id = vs.cid
- JOIN staff_alias sa ON vs.aid = sa.aid
- WHERE sa.id =}, \$e->{id}, q{ AND NOT v.hidden
- ORDER BY v.c_released ASC, v.title ASC
- });
- return if !@$cast;
-
- my $rows = sub {
- for my $c (@$cast) {
- Tr sub {
- Td class => 'tabular-nums muted', sub { ReleaseDate $c->{c_released} };
- Td sub {
- A href => "/v$c->{vid}", title => $c->{t_original}||$c->{title}, $c->{title};
- };
- Td sub {
- A href => "/c$c->{cid}", title => $c->{c_original}||$c->{c_name}, $c->{c_name};
- };
- Td title => $c->{original}||$c->{name}, $c->{name};
- Td $c->{note};
- };
- }
- };
-
- # TODO: Full-width table? It's pretty dense
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- H2 class => 'detail-page-sidebar-section-header', 'Voiced Characters';
- Debug $cast;
- };
- Div class => 'col-md', sub {
- Div class => 'card card--white mb-5', sub {
- Table class => 'table table--responsive-single-sm fs-medium', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', 'Date';
- Th width => '30%', 'Title';
- Th width => '20%', 'Cast';
- Th width => '20%', 'As';
- Th width => '15%', 'Note';
- };
- };
- Tbody $rows;
- };
- }
- }
- }
-}
-
-
-TUWF::get qr{/$SREV_RE}, sub {
- my $e = entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resNotFound if !$e->{id} || $e->{hidden};
-
- ($e->{name}, $e->{original}) = @{(grep $_->{aid} == $e->{aid}, @{$e->{alias}})[0]}{'name', 'original'};
-
- Framework
- title => $e->{name},
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit s => $e;
- Div class => 'detail-page-title', sub {
- Txt $e->{name};
- Txt ' '.gender_icon $e->{gender};
- Debug $e;
- };
- Div class => 'detail-page-subtitle', $e->{original} if $e->{original};
- }
- },
- sub {
- DetailsTable $e;
- Notes $e;
- Roles $e;
- Cast $e;
- };
-};
-
-1;
diff --git a/lib/VN3/Trait/JS.pm b/lib/VN3/Trait/JS.pm
deleted file mode 100644
index 05e1d03d..00000000
--- a/lib/VN3/Trait/JS.pm
+++ /dev/null
@@ -1,44 +0,0 @@
-package VN3::Trait::JS;
-
-use VN3::Prelude;
-
-my $elm_TraitResult = elm_api TraitResult => { aoh => {
- id => { id => 1 },
- name => {},
- gid => { id => 1, required => 0 },
- group => { required => 0 }
-}};
-
-# Returns only approved and applicable traits
-json_api '/js/trait.json', {
- search => { maxlength => 500 }
-}, sub {
- my $q = shift->{search};
-
- my $qs = $q =~ s/[%_]//gr;
- my $r = tuwf->dbAlli(
- 'SELECT t.id, t.name, g.id AS gid, g.name AS group',
- 'FROM (',
- # ID search
- $q =~ /^$IID_RE$/ ? ('SELECT 1, id FROM traits WHERE id =', \"$1", 'UNION ALL') : (),
- # exact match
- 'SELECT 2, id FROM traits WHERE lower(name) = lower(', \$q, ")",
- 'UNION ALL',
- # prefix match
- 'SELECT 3, id FROM traits WHERE name ILIKE', \"$qs%",
- 'UNION ALL',
- # substring match + alias search
- 'SELECT 4, id FROM traits WHERE name ILIKE', \"%$qs%", ' OR alias ILIKE', \"%$qs%",
- ') AS tt (ord, id)',
- 'JOIN traits t ON t.id = tt.id',
- 'LEFT JOIN traits g ON g.id = t.group',
- 'WHERE t.state = 2 AND t.applicable',
- 'GROUP BY t.id, t.name, g.id, g.name',
- 'ORDER BY MIN(tt.ord), t.name',
- 'LIMIT 20'
- );
-
- $elm_TraitResult->($r);
-};
-
-1;
diff --git a/lib/VN3/Types.pm b/lib/VN3/Types.pm
deleted file mode 100644
index 273f8b79..00000000
--- a/lib/VN3/Types.pm
+++ /dev/null
@@ -1,171 +0,0 @@
-# Listings and formatting functions for various data types in the database.
-
-package VN3::Types;
-
-use strict;
-use warnings;
-use utf8;
-use TUWF ':Html5';
-use POSIX 'strftime', 'ceil';
-use Exporter 'import';
-use VNDB::Types;
-
-our @EXPORT = qw/
- $UID_RE $VID_RE $RID_RE $SID_RE $CID_RE $PID_RE $IID_RE $DOC_RE
- $VREV_RE $RREV_RE $PREV_RE $SREV_RE $CREV_RE $DREV_RE
- Lang
- Platform
- media_display
- ReleaseDate
- vn_length_time vn_length_display
- char_roles char_role_display
- vote_display vote_string
- date_display
- vn_relation_reverse vn_relation_display
- producer_relation_reverse producer_relation_display
- spoil_display
- release_types
- minage_display minage_display_full
- resolution_display_full
- gender_display gender_icon
- blood_type_display
-/;
-
-
-# Regular expressions for use in path registration
-my $num = qr{[1-9][0-9]{0,6}};
-our $UID_RE = qr{u(?<id>$num)};
-our $VID_RE = qr{v(?<id>$num)};
-our $RID_RE = qr{r(?<id>$num)};
-our $SID_RE = qr{s(?<id>$num)};
-our $CID_RE = qr{c(?<id>$num)};
-our $PID_RE = qr{p(?<id>$num)};
-our $IID_RE = qr{i(?<id>$num)};
-our $DOC_RE = qr{d(?<id>$num)};
-our $VREV_RE = qr{$VID_RE(?:\.(?<rev>$num))?};
-our $RREV_RE = qr{$RID_RE(?:\.(?<rev>$num))?};
-our $PREV_RE = qr{$PID_RE(?:\.(?<rev>$num))?};
-our $SREV_RE = qr{$SID_RE(?:\.(?<rev>$num))?};
-our $CREV_RE = qr{$CID_RE(?:\.(?<rev>$num))?};
-our $DREV_RE = qr{$DOC_RE(?:\.(?<rev>$num))?};
-
-
-sub Lang {
- Span class => 'lang-badge', uc $_[0];
-}
-
-
-
-sub Platform {
- # TODO: Icons
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/windows.svg', title => $PLATFORM{$_[0]};
-}
-
-
-sub media_display {
- my($media, $qty) = @_;
- my $med = $MEDIUM{$media};
- return $med->{txt} if !$med->{qty};
- sprintf '%d %s', $qty, $qty == 1 ? $med->{txt} : $med->{plural};
-}
-
-
-
-
-sub ReleaseDate {
- my $date = sprintf '%08d', shift||0;
- my $future = $date > strftime '%Y%m%d', gmtime;
- my($y, $m, $d) = ($1, $2, $3) if $date =~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/;
-
- my $str = $y == 0 ? 'unknown' : $y == 9999 ? 'TBA' :
- $m == 99 ? sprintf('%04d', $y) :
- $d == 99 ? sprintf('%04d-%02d', $y, $m) :
- sprintf('%04d-%02d-%02d', $y, $m, $d);
-
- Txt $str if !$future;
- B class => 'future', $str if $future;
-}
-
-
-sub vn_length_time {
- my $l = $VN_LENGTH{$_[0]};
- $l->{time} || $l->{txt};
-}
-
-sub vn_length_display {
- my $l = $VN_LENGTH{$_[0]};
- $l->{txt}.($l->{time} ? " ($l->{time})" : '')
-}
-
-
-
-sub char_role_display {
- my($role, $num) = @_;
- $CHAR_ROLE{$role}{!$num || $num == 1 ? 'txt' : 'plural'};
-}
-
-
-
-sub vote_display {
- !$_[0] ? '-' : $_[0] % 10 == 0 ? $_[0]/10 : sprintf '%.1f', $_[0]/10;
-}
-
-sub vote_string {
- ['worst ever',
- 'awful',
- 'bad',
- 'weak',
- 'so-so',
- 'decent',
- 'good',
- 'very good',
- 'excellent',
- 'masterpiece']->[ceil(shift()/10)-2];
-}
-
-
-
-sub date_display {
- strftime '%Y-%m-%d', gmtime $_[0];
-}
-
-
-
-sub vn_relation_reverse { $VN_RELATION{$_[0]}{reverse} }
-sub vn_relation_display { $VN_RELATION{$_[0]}{txt} }
-
-
-
-sub producer_relation_reverse { $PRODUCER_RELATION{$_[0]}{reverse} }
-sub producer_relation_display { $PRODUCER_RELATION{$_[0]}{txt} }
-
-
-
-sub spoil_display {
- ['No spoilers'
- ,'Minor spoilers'
- ,'Spoil me!']->[$_[0]];
-}
-
-
-
-sub release_types { keys %RELEASE_TYPE }
-
-
-sub minage_display { $AGE_RATING{$_[0]}{txt} }
-sub minage_display_full { my $e = $AGE_RATING{$_[0]}; $e->{txt}.($e->{ex} ? " (e.g. $e->{ex})" : '') };
-
-
-
-sub resolution_display_full { my $e = $RESOLUTION{$_[0]}; ($e->{cat} ? ucfirst "$e->{cat}: " : '').$e->{txt} }
-
-
-sub gender_display { $GENDER{$_[0]} }
-sub gender_icon { +{qw/m โ™‚ f โ™€ mf โ™‚โ™€/}->{$_[0]}||'' }
-
-
-
-sub blood_type_display { $BLOOD_TYPE{$_[0]} }
-
-
-1;
diff --git a/lib/VN3/User/Lib.pm b/lib/VN3/User/Lib.pm
deleted file mode 100644
index c63e4286..00000000
--- a/lib/VN3/User/Lib.pm
+++ /dev/null
@@ -1,31 +0,0 @@
-package VN3::User::Lib;
-
-use VN3::Prelude;
-
-our @EXPORT = qw/show_list TopNav/;
-
-
-# Whether we can see the user's list
-sub show_list {
- my $u = shift;
- die "Can't determine show_list() when hide_list preference is not known" if !exists $u->{hide_list};
- auth->permUsermod || !$u->{hide_list} || $u->{id} == (auth->uid||0);
-}
-
-
-sub TopNav {
- my($page, $u) = @_;
-
- Div class => 'nav raised-top-nav', sub {
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'details'), sub { A href => "/u$u->{id}", class => 'nav__link', 'Details'; };
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'list'), sub { A href => "/u$u->{id}/list", class => 'nav__link', 'List'; } if show_list $u;
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'wish'), sub { A href => "/u$u->{id}/wish", class => 'nav__link', 'Wishlist'; } if show_list $u;
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'posts'), sub { A href => "/u$u->{id}/posts", class => 'nav__link', 'Posts'; };
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'discussions'),sub { A href => "/t/u$u->{id}", class => 'nav__link', 'Discussions'; };
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'tags'), sub { A href => "/g/links?uid=$u->{id}", class => 'nav__link', 'Tags'; };
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'hist'), sub { A href => "/u$u->{id}/hist", class => 'nav__link', 'Contributions'; };
- };
-}
-
-1;
-
diff --git a/lib/VN3/User/Login.pm b/lib/VN3/User/Login.pm
deleted file mode 100644
index 7660762a..00000000
--- a/lib/VN3/User/Login.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-package VN3::User::Login;
-
-use VN3::Prelude;
-
-# TODO: Redirect to a password change form when a user logs in with an insecure password.
-
-TUWF::get '/u/login' => sub {
- return tuwf->resRedirect('/', 'temp') if auth;
- Framework title => 'Login', center => 1, sub {
- Div 'data-elm-module' => 'User.Login', '';
- };
-};
-
-
-my $elm_Throttled = elm_api 'Throttled';
-my $elm_BadLogin = elm_api 'BadLogin';
-
-json_api '/u/login', {
- username => { username => 1 },
- password => { password => 1 }
-}, sub {
- my $data = shift;
-
- my $conf = tuwf->conf->{login_throttle} || [ 24*3600/10, 24*3600 ];
- my $ip = norm_ip tuwf->reqIP;
-
- my $tm = tuwf->dbVali(
- 'SELECT', sql_totime('greatest(timeout, now())'), 'FROM login_throttle WHERE ip =', \$ip
- ) || time;
-
- return $elm_Throttled->() if $tm-time() > $conf->[1];
- return $elm_Success->() if auth->login($data->{username}, $data->{password});
-
- # Failed login, update throttle.
- my $upd = {
- ip => \$ip,
- timeout => sql_fromtime $tm+$conf->[0]
- };
- tuwf->dbExeci('INSERT INTO login_throttle', $upd, 'ON CONFLICT (ip) DO UPDATE SET', $upd);
- $elm_BadLogin->()
-};
-
-
-TUWF::get qr{/$UID_RE/logout}, sub {
- return tuwf->resNotFound if !auth || auth->uid != tuwf->capture('id');
- auth->logout;
- tuwf->resRedirect('/', 'temp');
-};
-
-1;
diff --git a/lib/VN3/User/Page.pm b/lib/VN3/User/Page.pm
deleted file mode 100644
index 886ad39a..00000000
--- a/lib/VN3/User/Page.pm
+++ /dev/null
@@ -1,207 +0,0 @@
-package VN3::User::Page;
-
-use VN3::Prelude;
-use VN3::User::Lib;
-
-
-sub StatsLeft {
- my $u = shift;
- my $vns = show_list($u) && tuwf->dbVali('SELECT COUNT(*) FROM vnlists WHERE uid =', \$u->{id});
- my $rel = show_list($u) && tuwf->dbVali('SELECT COUNT(*) FROM rlists WHERE uid =', \$u->{id});
- my $posts = tuwf->dbVali('SELECT COUNT(*) FROM threads_posts WHERE uid =', \$u->{id});
- my $threads = tuwf->dbVali('SELECT COUNT(*) FROM threads_posts WHERE num = 1 AND uid =', \$u->{id});
-
- Div class => 'card__title mb-4', 'Stats';
- Div class => 'big-stats mb-5', sub {
- A href => "/u$u->{id}/list", class => 'big-stats__stat', sub {
- Txt 'Votes';
- Div class => 'big-stats__value', show_list($u) ? $u->{c_votes} : '-';
- };
- A href => "/u$u->{id}/hist", class => 'big-stats__stat', sub {
- Txt 'Edits';
- Div class => 'big-stats__value', $u->{c_changes};
- };
- A href => "/g/links?u=$u->{id}", class => 'big-stats__stat', sub {
- Txt 'Tags';
- Div class => 'big-stats__value', $u->{c_tags};
- };
- };
- Div class => 'user-stats__text', sub {
- Dl class => 'dl--horizontal', sub {
- if(show_list $u) {
- Dt 'List stats';
- Dd sprintf '%d release%s of %d visual novel%s', $rel, $rel == 1 ? '' : 's', $vns, $vns == 1 ? '' : 's';
- }
- Dt 'Forum stats';
- Dd sprintf '%d post%s, %d new thread%s', $posts, $posts == 1 ? '' : 's', $threads, $threads == 1 ? '' : 's';
- Dt 'Registered';
- Dd date_display $u->{registered};
- };
- };
-}
-
-
-sub Stats {
- my $u = shift;
-
- my($count, $Graph) = show_list($u) ? VoteGraph u => $u->{id} : ();
-
- Div class => 'card card--white card--no-separators flex-expand mb-5', sub {
- Div class => 'card__section fs-medium', sub {
- Div class => 'user-stats', sub {
- Div class => 'user-stats__left', sub { StatsLeft $u };
- Div class => 'user-stats__right', sub {
- Div class => 'card__title mb-2', 'Vote distribution';
- $Graph->();
- } if $count;
- }
- }
- }
-}
-
-
-sub List {
- my $u = shift;
- return if !show_list $u;
-
- # XXX: This query doesn't catch vote or list *changes*, only new entries.
- # We don't store the modification date in the DB at the moment.
- my $l = tuwf->dbAlli(q{
- SELECT il.vid, EXTRACT('epoch' FROM GREATEST(v.date, l.added)) AS date, vn.title, vn.original, v.vote, l.status
- FROM (
- SELECT vid FROM votes WHERE uid = }, \$u->{id}, q{
- UNION SELECT vid FROM vnlists WHERE uid = }, \$u->{id}, q{
- ) AS il (vid)
- LEFT JOIN votes v ON v.vid = il.vid
- LEFT JOIN vnlists l ON l.vid = il.vid
- JOIN vn ON vn.id = il.vid
- WHERE v.uid = }, \$u->{id}, q{
- AND l.uid = }, \$u->{id}, q{
- ORDER BY GREATEST(v.date, l.added) DESC
- LIMIT 10
- });
- return if !@$l;
-
- Div class => 'card card--white card--no-separators mb-5', sub {
- Div class => 'card__header', sub {
- Div class => 'card__title', 'Recent list additions';
- };
- Table class => 'table table--responsive-single-sm fs-medium', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', 'Date';
- Th width => '50%', 'Visual novel';
- Th width => '10%', 'Vote';
- Th width => '25%', 'Status';
- };
- };
- Tbody sub {
- for my $i (@$l) {
- Tr sub {
- Td class => 'tabular-nums muted', date_display $i->{date};
- Td sub {
- A href => "/v$i->{vid}", title => $i->{original}||$i->{title}, $i->{title};
- };
- Td vote_display $i->{vote};
- Td $i->{status} ? $VNLIST_STATUS{$i->{status}} : '';
- };
- }
- };
- };
- Div class => 'card__section fs-medium', sub {
- A href => "/u$u->{id}/list", 'View full list';
- }
- };
-}
-
-
-sub Edits {
- my $u = shift;
- # XXX: This is a lazy implementation, could probably share code/UI with the database entry history tables (as in VNDB 2)
-
- my $l = tuwf->dbAlli(q{
- SELECT ch.id, ch.itemid, ch.rev, ch.type, EXTRACT('epoch' FROM ch.added) AS added
- FROM changes ch
- WHERE ch.requester =}, \$u->{id}, q{
- ORDER BY ch.added DESC LIMIT 10
- });
- return if !@$l;
-
- # This can also be written as a UNION, haven't done any benchmarking yet.
- # It doesn't matter much with only 10 entries, but it will matter if this
- # query is re-used for other history browsing purposes.
- enrich id => q{
- SELECT ch.id, COALESCE(d.title, v.title, p.name, r.title, c.name, sa.name) AS title
- FROM changes ch
- LEFT JOIN docs_hist d ON ch.type = 'd' AND d.chid = ch.id
- LEFT JOIN vn_hist v ON ch.type = 'v' AND v.chid = ch.id
- LEFT JOIN producers_hist p ON ch.type = 'p' AND p.chid = ch.id
- LEFT JOIN releases_hist r ON ch.type = 'r' AND r.chid = ch.id
- LEFT JOIN chars_hist c ON ch.type = 'c' AND c.chid = ch.id
- LEFT JOIN staff_hist s ON ch.type = 's' AND s.chid = ch.id
- LEFT JOIN staff_alias_hist sa ON ch.type = 's' AND sa.chid = ch.id AND s.aid = sa.aid
- WHERE ch.id IN}, $l;
-
- Div class => 'card card--white card--no-separators mb-5', sub {
- Div class => 'card__header', sub {
- Div class => 'card__title', 'Recent database contributions';
- };
- Table class => 'table table--responsive-single-sm fs-medium', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', 'Date';
- Th width => '10%', 'Rev.';
- Th width => '75%', 'Entry';
- };
- };
- Tbody sub {
- for my $i (@$l) {
- my $id = "$i->{type}$i->{itemid}.$i->{rev}";
- Tr sub {
- Td class => 'tabular-nums muted', date_display $i->{added};
- Td sub {
- A href => "/$id", $id;
- };
- Td sub {
- A href => "/$id", $i->{title};
- };
- }
- }
- }
- };
- Div class => 'card__section fs-medium', sub {
- A href => "/u$u->{id}/hist", 'View all';
- }
- };
-}
-
-
-TUWF::get qr{/$UID_RE}, sub {
- my $uid = tuwf->capture('id');
- my $u = tuwf->dbRowi(q{
- SELECT u.id, u.username, EXTRACT('epoch' FROM u.registered) AS registered, u.c_votes, u.c_changes, u.c_tags, hd.value AS hide_list
- FROM users u
- LEFT JOIN users_prefs hd ON hd.uid = u.id AND hd.key = 'hide_list'
- WHERE u.id =}, \$uid
- );
- return tuwf->resNotFound if !$u->{id};
-
- Framework
- title => lcfirst($u->{username}),
- index => 0,
- single_col => 1,
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit u => $u;
- Div class => 'detail-page-title', ucfirst $u->{username};
- TopNav details => $u;
- }
- },
- sub {
- Stats $u;
- List $u;
- Edits $u;
- };
-};
-
-1;
diff --git a/lib/VN3/User/RegReset.pm b/lib/VN3/User/RegReset.pm
deleted file mode 100644
index ed815547..00000000
--- a/lib/VN3/User/RegReset.pm
+++ /dev/null
@@ -1,137 +0,0 @@
-# User registration and password reset. These functions share some common code.
-package VN3::User::RegReset;
-
-use VN3::Prelude;
-
-
-TUWF::get '/u/newpass' => sub {
- return tuwf->resRedirect('/', 'temp') if auth;
- Framework title => 'Password reset', center => 1, sub {
- Div 'data-elm-module' => 'User.PassReset', '';
- };
-};
-
-
-my $elm_BadEmail = elm_api 'BadEmail';
-my $elm_BadPass = elm_api 'BadPass';
-my $elm_Bot = elm_api 'Bot';
-my $elm_Taken = elm_api 'Taken';
-my $elm_DoubleEmail = elm_api 'DoubleEmail';
-my $elm_DoubleIP = elm_api 'DoubleIP';
-
-
-json_api '/u/newpass', {
- email => { email => 1 },
-}, sub {
- my $data = shift;
-
- my($id, $token) = auth->resetpass($data->{email});
- return $elm_BadEmail->() if !$id;
-
- my $name = tuwf->dbVali('SELECT username FROM users WHERE id =', \$id);
- my $body = sprintf
- "Hello %s,"
- ."\n\n"
- ."Your VNDB.org login has been disabled, you can now set a new password by following the link below:"
- ."\n\n"
- ."%s"
- ."\n\n"
- ."Now don't forget your password again! :-)"
- ."\n\n"
- ."vndb.org",
- $name, tuwf->reqBaseURI()."/u$id/setpass/$token";
-
- tuwf->mail($body,
- To => $data->{email},
- From => 'VNDB <noreply@vndb.org>',
- Subject => "Password reset for $name",
- );
- $elm_Success->();
-};
-
-
-my $reset_url = qr{/$UID_RE/setpass/(?<token>[a-f0-9]{40})};
-
-TUWF::get $reset_url, sub {
- return tuwf->resRedirect('/', 'temp') if auth;
-
- my $id = tuwf->capture('id');
- my $token = tuwf->capture('token');
- my $name = tuwf->dbVali('SELECT username FROM users WHERE id =', \$id);
-
- return tuwf->resNotFound if !$name || !auth->isvalidtoken($id, $token);
-
- Framework title => 'Set password', center => 1, sub {
- Div 'data-elm-module' => 'User.PassSet', 'data-elm-flags' => '"'.tuwf->reqPath().'"', '';
- };
-};
-
-
-json_api $reset_url, {
- pass => { password => 1 },
-}, sub {
- my $data = shift;
- my $id = tuwf->capture('id');
- my $token = tuwf->capture('token');
-
- return $elm_BadPass->() if tuwf->isUnsafePass($data->{pass});
- die "Invalid reset token" if !auth->setpass($id, $token, undef, $data->{pass});
- tuwf->dbExeci('UPDATE users SET email_confirmed = true WHERE id =', \$id);
- $elm_Success->()
-};
-
-
-TUWF::get '/u/register', sub {
- return tuwf->resRedirect('/', 'temp') if auth;
- Framework title => 'Register', center => 1, sub {
- Div 'data-elm-module' => 'User.Register', '';
- };
-};
-
-
-json_api '/u/register', {
- username => { username => 1 },
- email => { email => 1 },
- vns => { int => 1 },
-}, sub {
- my $data = shift;
-
- my $num = tuwf->dbVali("SELECT count FROM stats_cache WHERE section = 'vn'");
- return $elm_Bot->() if $data->{vns} < $num*0.995 || $data->{vns} > $num*1.005;
- return $elm_Taken->() if tuwf->dbVali('SELECT 1 FROM users WHERE username =', \$data->{username});
- return $elm_DoubleEmail->() if tuwf->dbVali(select => sql_func user_emailexists => \$data->{email});
-
- my $ip = tuwf->reqIP;
- return $elm_DoubleIP->() if tuwf->dbVali(
- q{SELECT 1 FROM users WHERE registered >= NOW()-'1 day'::interval AND ip <<},
- $ip =~ /:/ ? \"$ip/48" : \"$ip/30"
- );
-
- my $id = tuwf->dbVali('INSERT INTO users', {
- username => $data->{username},
- mail => $data->{email},
- ip => $ip,
- }, 'RETURNING id');
- my(undef, $token) = auth->resetpass($data->{email});
-
- my $body = sprintf
- "Hello %s,"
- ."\n\n"
- ."Someone has registered an account on VNDB.org with your email address. To confirm your registration, follow the link below."
- ."\n\n"
- ."%s"
- ."\n\n"
- ."If you don't remember creating an account on VNDB.org recently, please ignore this e-mail."
- ."\n\n"
- ."vndb.org",
- $data->{username}, tuwf->reqBaseURI()."/u$id/setpass/$token";
-
- tuwf->mail($body,
- To => $data->{email},
- From => 'VNDB <noreply@vndb.org>',
- Subject => "Confirm registration for $data->{username}",
- );
- $elm_Success->()
-};
-
-1;
diff --git a/lib/VN3/User/Settings.pm b/lib/VN3/User/Settings.pm
deleted file mode 100644
index a63de232..00000000
--- a/lib/VN3/User/Settings.pm
+++ /dev/null
@@ -1,98 +0,0 @@
-package VN3::User::Settings;
-
-use VN3::Prelude;
-
-
-my $FORM = {
- username => { username => 1 },
- mail => { email => 1 },
- perm => { uint => 1, func => sub { ($_[0] & ~auth->allPerms) == 0 } },
- ign_votes => { anybool => 1 },
- hide_list => { anybool => 1 },
- show_nsfw => { anybool => 1 },
- traits_sexual => { anybool => 1 },
- tags_all => { anybool => 1 },
- tags_cont => { anybool => 1 },
- tags_ero => { anybool => 1 },
- tags_tech => { anybool => 1 },
- spoilers => { uint => 1, range => [ 0, 2 ] },
-
- password => { _when => 'in', required => 0, type => 'hash', keys => {
- old => { password => 1 },
- new => { password => 1 }
- } },
-
- id => { _when => 'out', uint => 1 },
- authmod => { _when => 'out', anybool => 1 },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-
-elm_form UserEdit => $FORM_OUT, $FORM_IN;
-
-my $elm_BadPass = elm_api 'BadPass';
-my $elm_BadLogin = elm_api 'BadLogin';
-
-TUWF::get qr{/$UID_RE/edit}, sub {
- my $u = tuwf->dbRowi('SELECT id, username, perm, ign_votes FROM users WHERE id =', \tuwf->capture('id'));
-
- return tuwf->resNotFound if !can_edit u => $u;
-
- $u->{mail} = tuwf->dbVali(select => sql_func user_getmail => \$u->{id}, \auth->uid, sql_fromhex auth->token);
- $u->{authmod} = auth->permUsermod;
-
- # Let's not disclose this (though it's not hard to find out through other means)
- if(!auth->permUsermod) {
- $u->{ign_votes} = 0;
- $u->{perm} = auth->defaultPerms;
- }
-
- my $prefs = { map +($_->{key}, $_->{value}), @{ tuwf->dbAlli('SELECT key, value FROM users_prefs WHERE uid =', \$u->{id}) }};
- $u->{$_} = $prefs->{$_}||'' for qw/hide_list show_nsfw traits_sexual tags_all spoilers/;
- $u->{spoilers} ||= 0;
- $u->{"tags_$_"} = (($prefs->{tags_cat}||'cont,tech') =~ /$_/) for qw/cont ero tech/;
-
- my $title = $u->{id} == auth->uid ? 'My Preferences' : "Edit $u->{username}";
- Framework title => $title, noindex => 1, narrow => 1, sub {
- FullPageForm module => 'User.Settings', data => $u, schema => $FORM_OUT;
- };
-};
-
-
-json_api qr{/$UID_RE/edit}, $FORM_IN, sub {
- my $data = shift;
- my $id = tuwf->capture('id');
-
- return $elm_Unauth->() if !can_edit u => { id => $id };
-
- if(auth->permUsermod) {
- tuwf->dbExeci(update => users => set => {
- username => $data->{username},
- ign_votes => $data->{ign_votes},
- email_confirmed => 1,
- }, where => { id => $id });
- tuwf->dbExeci(select => sql_func user_setperm => \$id, \auth->uid, sql_fromhex(auth->token), \$data->{perm});
- }
-
- if($data->{password}) {
- return $elm_BadPass->() if tuwf->isUnsafePass($data->{password}{new});
-
- if(auth->uid == $id) {
- return $elm_BadLogin->() if !auth->setpass($id, undef, $data->{password}{old}, $data->{password}{new});
- } else {
- tuwf->dbExeci(select => sql_func user_admin_setpass => \$id, \auth->uid,
- sql_fromhex(auth->token), sql_fromhex auth->_preparepass($data->{password}{new})
- );
- }
- }
-
- tuwf->dbExeci(select => sql_func user_setmail => \$id, \auth->uid, sql_fromhex(auth->token), \$data->{mail});
-
- auth->prefSet($_, $data->{$_}, $id) for qw/hide_list show_nsfw traits_sexual tags_all spoilers/;
- auth->prefSet(tags_cat => join(',', map $data->{"tags_$_"} ? $_ : (), qw/cont ero tech/), $id);
-
- $elm_Success->();
-};
-
-1;
diff --git a/lib/VN3/User/VNList.pm b/lib/VN3/User/VNList.pm
deleted file mode 100644
index 922f81d6..00000000
--- a/lib/VN3/User/VNList.pm
+++ /dev/null
@@ -1,325 +0,0 @@
-package VN3::User::VNList;
-
-use POSIX 'ceil';
-use VN3::Prelude;
-use VN3::User::Lib;
-
-
-sub mkurl {
- my $opt = shift;
- $opt = { %$opt, @_ };
- delete $opt->{t} if $opt->{t} == -1;
- delete $opt->{g} if !$opt->{g};
- '?'.join ';', map "$_=$opt->{$_}", sort keys %$opt;
-}
-
-
-sub SideBar {
- my $opt = shift;
-
- Div class => 'fixed-size-left-sidebar-xl', sub {
- Div class => 'vertical-selector-label', 'Status';
- Div class => 'vertical-selector', sub {
- for (-1, keys %VNLIST_STATUS) {
- A href => mkurl($opt, t => $_, p => 1), mkclass(
- 'vertical-selector__item' => 1,
- 'vertical-selector__item--active' => $_ == $opt->{t}
- ), $_ < 0 ? 'All' : $VNLIST_STATUS{$_};
- }
- };
- };
-}
-
-
-sub NextPrev {
- my($opt, $count) = @_;
- my $numpage = ceil($count/50);
-
- Div class => 'd-lg-flex jc-between align-items-center', sub {
- Div class => 'd-flex align-items-center', '';
- Div class => 'd-block d-lg-none mb-2', '';
- Div class => 'd-flex jc-right align-items-center', sub {
- A href => mkurl($opt, p => $opt->{p}-1), mkclass(btn => 1, 'btn--disabled' => $opt->{p} <= 1), '< Prev';
- Div class => 'mx-3 semi-muted', sprintf 'page %d of %d', $opt->{p}, $numpage;
- A href => mkurl($opt, p => $opt->{p}+1), mkclass(btn => 1, 'btn--disabled' => $opt->{p} >= $numpage), 'Next >';
- };
- };
-}
-
-
-sub EditDropDown {
- my($u, $opt, $item) = @_;
- return if $u->{id} != (auth->uid||0);
- Div 'data-elm-module' => 'UVNList.Options',
- 'data-elm-flags' => JSON::XS->new->encode({uid => $u->{id}, item => $item}),
- '';
-}
-
-
-sub VNTable {
- my($u, $lst, $opt) = @_;
-
- my $SortHeader = sub {
- my($id, $label) = @_;
- my $isasc = $opt->{s} eq $id && $opt->{o} eq 'a';
- A mkclass(
- 'table-header' => 1,
- 'with-sort-icon' => 1,
- 'with-sort-icon--down' => !$isasc,
- 'with-sort-icon--up' => $isasc,
- 'with-sort-icon--active' => $opt->{s} eq $id,
- ), href => mkurl($opt, p => 1, s => $id, o => $isasc ? 'd' : 'a'), $label;
- };
-
- Table class => 'table table--responsive-single-sm fs-medium vn-list', sub {
- Thead sub {
- Tr sub {
- Th width => '15%', class => 'th--nopad', sub { $SortHeader->(date => 'Date' ) };
- Th width => '40%', class => 'th--nopad', sub { $SortHeader->(title => 'Title') };
- Th width => '10%', class => 'th--nopad', sub { $SortHeader->(vote => 'Vote' ) };
- Th width => '13%', 'Status';
- Th width => '7.33%', '';
- Th width => '7.33%', '';
- Th width => '7.33%', '';
- };
- };
- Tbody sub {
- for my $l (@$lst) {
- Tr sub {
- Td class => 'tabular-nums muted', date_display $l->{date};
- Td sub {
- A href => "/v$l->{id}", title => $l->{original}||$l->{title}, $l->{title};
- };
-
- if($u->{id} == (auth->uid||0)) {
- Td class => 'table-edit-overlay-base', sub {
- Div 'data-elm-module' => 'UVNList.Vote',
- 'data-elm-flags' => JSON::XS->new->encode({uid => int $u->{id}, vid => int $l->{id}, vote => ''.vote_display $l->{vote}}),
- vote_display $l->{vote};
- };
- Td class => 'table-edit-overlay-base', sub {
- Div 'data-elm-module' => 'UVNList.Status',
- 'data-elm-flags' => JSON::XS->new->encode({uid => int $u->{id}, vid => int $l->{id}, status => int $l->{status}||0}),
- $VNLIST_STATUS{$l->{status}||0};
- };
- } else {
- Td vote_display $l->{vote};
- Td $VNLIST_STATUS{$l->{status}||0};
- }
-
- # Release info
- Td sub {
- A href => 'javascript:;', class => 'vn-list__expand-releases', sub {
- Span class => 'expand-arrow mr-2', '';
- Txt sprintf '%d/%d', (scalar grep $_->{status}==2, @{$l->{rel}}), scalar @{$l->{rel}};
- } if @{$l->{rel}};
- };
-
- # Notes
- Td sub {
- # TODO: vn-list__expand-comment--empty for 'add comment' things
- A href => 'javascript:;', class => 'vn-list__expand-comment', sub {
- Span class => 'expand-arrow mr-2', '';
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/comment.svg';
- } if $l->{notes};
- };
-
- Td sub { EditDropDown $u, $opt, $l };
- };
-
- # Release info
- Tr class => 'vn-list__releases-row d-none', sub {
- Td colspan => '6', sub {
- Div class => 'vn-list__releases', sub {
- Table class => 'table table--responsive-single-sm ml-3', sub {
- Tbody sub {
- for my $r (@{$l->{rel}}) {
- Tr sub {
- Td width => '15%', class => 'tabular-nums muted pl-0', date_display $r->{date};
- Td width => '50%', sub {
- A href => "/v$r->{rid}", title => $r->{original}||$r->{title}, $r->{title};
- };
- # TODO: Editabe
- Td width => '20%', $RLIST_STATUS{$l->{status}};
- Td width => '15%', ''; # TODO: Edit menu
- }
- }
- }
- }
- }
- }
- } if @{$l->{rel}};
-
- # Notes
- Tr class => 'vn-list__comment-row d-none', sub {
- Td colspan => '6', sub {
- # TODO: Editable
- Div class => 'vn-list__comment ml-3', $l->{notes};
- }
- } if $l->{notes};
- };
- };
- };
-}
-
-
-sub VNGrid {
- my($u, $lst, $opt) = @_;
-
- Div class => 'vn-grid mb-4', sub {
- for my $l (@$lst) {
- Div class => 'vn-grid__item', sub {
- # TODO: NSFW hiding? What about missing images?
- Div class => 'vn-grid__item-bg', style => sprintf("background-image: url('%s')", tuwf->imgurl(cv => $l->{image})), '';
- Div class => 'vn-grid__item-overlay', sub {
- A href => 'javascript:;', class => 'vn-grid__item-link', ''; # TODO: Open modal on click
- Div class => 'vn-grid__item-top', sub {
- EditDropDown $u, $opt, $l;
- Div class => 'vn-grid__item-rating', sub {
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/heavy/comment.svg' if $l->{notes};
- Lit ' ';
- Txt vote_display $l->{vote};
- }
- };
- Div class => 'vn-grid__item-name', $l->{title};
- }
- }
- }
- }
-}
-
-
-sub List {
- my($u, $opt) = @_;
-
- my $lst = tuwf->dbAlli(q{
- SELECT v.id, v.title, v.original, vl.status, vl.notes, vo.vote, v.image, },
- sql_totime('LEAST(vl.added, vo.date)'), q{AS date,
- count(*) OVER() AS full_count
- FROM vn v
- LEFT JOIN votes vo ON vo.vid = v.id AND vo.uid =}, \$u->{id}, q{
- LEFT JOIN vnlists vl ON vl.vid = v.id AND vl.uid =}, \$u->{id}, q{
- WHERE }, sql_and(
- 'vo.vid IS NOT NULL OR vl.vid IS NOT NULL',
- $opt->{t} >= 1 ? sql('vl.status =', \$opt->{t}) : $opt->{t} == 0 ? 'vl.status = 0 OR vl.status IS NULL' : ()
- ),
- 'ORDER BY', {
- title => 'v.title',
- date => 'LEAST(vl.added, vo.date)',
- vote => 'vo.vote',
- }->{$opt->{s}},
- $opt->{o} eq 'a' ? 'ASC' : 'DESC',
- 'NULLS LAST',
- 'LIMIT', \50,
- 'OFFSET', \(($opt->{p}-1)*50)
- );
- my $count = @$lst ? $lst->[0]{full_count} : 0;
- delete $_->{full_count} for @$lst;
-
- enrich_list rel => id => vid => sub { sql q{
- SELECT rv.vid, rl.rid, rl.status, r.title, r.original, }, sql_totime('rl.added'), q{ AS date
- FROM rlists rl
- JOIN releases r ON r.id = rl.rid
- JOIN releases_vn rv ON rv.id = r.id
- WHERE rl.uid =}, \$u->{id}, q{AND rv.vid IN}, $_[0]
- }, $lst;
-
- Div class => 'col-md', sub {
- Div class => 'card card--white card--no-separators mb-5', sub {
- Div class => 'card__header', sub {
- Div class => 'card__title', 'List';
- Debug $lst;
- Div class => 'card__header-buttons', sub {
- Div class => 'btn-group', sub {
- A href => mkurl($opt, g => 0), mkclass(btn => 1, active => !$opt->{g}, 'js-show-vn-list' => 1), \&ListIcon;
- A href => mkurl($opt, g => 1), mkclass(btn => 1, active => $opt->{g}, 'js-show-vn-grid' => 1), \&GridIcon;
- };
- };
- };
-
- VNTable $u, $lst, $opt unless $opt->{g};
- Div class => 'card__body fs-medium', sub {
- VNGrid $u, $lst, $opt if $opt->{g};
- NextPrev $opt, $count;
- };
- }
- };
-}
-
-
-TUWF::get qr{/$UID_RE/list}, sub {
- my $uid = tuwf->capture('id');
- my $u = tuwf->dbRowi(q{
- SELECT u.id, u.username, hd.value AS hide_list
- FROM users u
- LEFT JOIN users_prefs hd ON hd.uid = u.id AND hd.key = 'hide_list'
- WHERE u.id =}, \$uid
- );
- return tuwf->resNotFound if !$u->{id} || !show_list $u;
-
- my $opt = tuwf->validate(get =>
- t => { vnlist_status => 1, required => 0, default => -1 }, # status
- p => { page => 1 }, # page
- o => { enum => ['d','a'], required => 0, default => 'a' }, # order (asc/desc)
- s => { enum => ['title', 'date', 'vote'], required => 0, default => 'title' }, # sort column
- g => { anybool => 1 }, # grid
- )->data;
-
- Framework
- title => $u->{username},
- index => 0,
- top => sub {
- Div class => 'col-md', sub {
- Div class => 'detail-page-title', ucfirst $u->{username};
- TopNav list => $u;
- }
- },
- sub {
- Div class => 'row', sub {
- SideBar $opt;
- List $u, $opt;
- };
- };
-};
-
-
-json_api '/u/setvote', {
- uid => { id => 1 },
- vid => { id => 1 },
- vote => { vnvote => 1 }
-}, sub {
- my $data = shift;
- return $elm_Unauth->() if (auth->uid||0) != $data->{uid};
-
- tuwf->dbExeci(
- 'DELETE FROM votes WHERE',
- { vid => $data->{vid}, uid => $data->{uid} }
- ) if !$data->{vote};
-
- tuwf->dbExeci(
- 'INSERT INTO votes',
- { vid => $data->{vid}, uid => $data->{uid}, vote => $data->{vote} },
- 'ON CONFLICT (vid, uid) DO UPDATE SET',
- { vote => $data->{vote} }
- ) if $data->{vote};
-
- $elm_Success->()
-};
-
-
-json_api '/u/setvnstatus', {
- uid => { id => 1 },
- vid => { id => 1 },
- status => { vnlist_status => 1 }
-}, sub {
- my $data = shift;
- return $elm_Unauth->() if (auth->uid||0) != $data->{uid};
-
- tuwf->dbExeci(
- 'INSERT INTO vnlists',
- { vid => $data->{vid}, uid => $data->{uid}, status => $data->{status} },
- 'ON CONFLICT (vid, uid) DO UPDATE SET',
- { status => $data->{status} }
- );
- $elm_Success->();
-};
diff --git a/lib/VN3/VN/Edit.pm b/lib/VN3/VN/Edit.pm
deleted file mode 100644
index bee48a5f..00000000
--- a/lib/VN3/VN/Edit.pm
+++ /dev/null
@@ -1,187 +0,0 @@
-package VN3::VN::Edit;
-
-use VN3::Prelude;
-use VN3::VN::Lib;
-
-
-my $FORM = {
- alias => { required => 0, default => '', maxlength => 500 },
- anime => { maxlength => 50, sort_keys => 'aid', aoh =>{
- aid => { id => 1 }
- } },
- desc => { required => 0, default => '', maxlength => 10240 },
- image => { required => 0, default => 0, id => 1 }, # X
- img_nsfw => { anybool => 1 },
- hidden => { anybool => 1 },
- l_encubed => { required => 0, default => '', maxlength => 100 },
- l_renai => { required => 0, default => '', maxlength => 100 },
- l_wp => { required => 0, default => '', maxlength => 150 },
- length => { vn_length => 1 },
- locked => { anybool => 1 },
- original => { required => 0, default => '', maxlength => 250 },
- relations => { maxlength => 50, sort_keys => 'vid', aoh => {
- vid => { id => 1 }, # X
- relation => { vn_relation => 1 },
- official => { anybool => 1 },
- title => { _when => 'out' },
- } },
- screenshots => { maxlength => 10, sort_keys => 'scr', aoh => {
- scr => { id => 1 }, # X
- rid => { id => 1 }, # X
- nsfw => { anybool => 1 },
- width => { _when => 'out', uint => 1 },
- height => { _when => 'out', uint => 1 },
- } },
- seiyuu => { sort_keys => ['aid','cid'], aoh => {
- aid => { id => 1 }, # X
- cid => { id => 1 }, # X
- note => { required => 0, default => '', maxlength => 250 },
- id => { _when => 'out', id => 1 },
- name => { _when => 'out' },
- } },
- staff => { sort_keys => ['aid','role'], aoh => {
- aid => { id => 1 }, # X
- role => { staff_role => 1 },
- note => { required => 0, default => '', maxlength => 250 },
- id => { _when => 'out', id => 1 },
- name => { _when => 'out' },
- } },
- title => { maxlength => 250 },
-
- id => { _when => 'out', required => 0, id => 1 },
- authmod => { _when => 'out', anybool => 1 },
- editsum => { _when => 'in out', editsum => 1 },
- chars => { _when => 'out', aoh => {
- id => { id => 1 },
- name => {},
- } },
- releases => { _when => 'out', aoh => {
- id => { id => 1 },
- title => {},
- original => {},
- display => {},
- resolution=> {},
- } },
-};
-
-my $FORM_OUT = form_compile out => $FORM;
-my $FORM_IN = form_compile in => $FORM;
-my $FORM_CMP = form_compile cmp => $FORM;
-
-elm_form VNEdit => $FORM_OUT, $FORM_IN;
-
-
-TUWF::get qr{/$VREV_RE/edit} => sub {
- my $vn = entry v => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resDenied if !can_edit v => $vn;
-
- enrich aid => q{SELECT id, aid, name FROM staff_alias WHERE aid IN} => $vn->{staff}, $vn->{seiyuu};
- enrich vid => q{SELECT id AS vid, title FROM vn WHERE id IN} => $vn->{relations};
- enrich scr => q{SELECT id AS scr, width, height FROM screenshots WHERE id IN}, $vn->{screenshots};
- $vn->{chars} = tuwf->dbAlli('SELECT id, name FROM chars c WHERE id IN(SELECT id FROM chars_vns WHERE vid =', \$vn->{id}, ') ORDER BY name');
-
- $vn->{releases} = tuwf->dbAlli('SELECT id, title, original, resolution FROM releases WHERE id IN(SELECT id FROM releases_vn WHERE vid =', \$vn->{id}, ') ORDER BY id');
- enrich_list1 lang => id => id => q{SELECT id, lang FROM releases_lang WHERE id IN}, $vn->{releases};
- $_->{display} = sprintf '[%s] %s (r%d)', join(',', @{ delete $_->{lang} }), $_->{title}, $_->{id} for @{$vn->{releases}};
-
- $vn->{authmod} = auth->permDbmod;
- $vn->{editsum} = $vn->{chrev} == $vn->{maxrev} ? '' : "Reverted to revision v$vn->{id}.$vn->{chrev}";
-
- Framework index => 0, title => "Edit $vn->{title}",
- top => sub {
- Div class => 'col-md', sub {
- EntryEdit v => $vn;
- Div class => 'detail-page-title', sub {
- Txt $vn->{title};
- Debug $vn;
- };
- TopNav edit => $vn;
- };
- }, sub {
- FullPageForm module => 'VNEdit.Main', data => $vn, schema => $FORM_OUT, sections => [
- general => 'General info',
- staff => 'Staff',
- cast => 'Cast',
- relations => 'Relations',
- screenshots => 'Screenshots',
- ];
- };
-};
-
-
-TUWF::get '/v/add', sub {
- return tuwf->resDenied if !auth->permEdit;
- Framework index => 0, title => 'Add a new visual novel', narrow => 1, sub {
- Div class => 'row', sub {
- Div class => 'col-md col-md--1', sub { Div 'data-elm-module' => 'VNEdit.New', '' };
- };
- };
-};
-
-
-json_api qr{/(?:$VID_RE/edit|v/add)}, $FORM_IN, sub {
- my $data = shift;
- my $new = !tuwf->capture('id');
- my $vn = $new ? { id => 0 } : entry v => tuwf->capture('id') or return tuwf->resNotFound;
-
- return $elm_Unauth->() if !can_edit v => $vn;
-
- if(!auth->permDbmod) {
- $data->{hidden} = $vn->{hidden}||0;
- $data->{locked} = $vn->{locked}||0;
- }
-
- # Elm doesn't actually verify this one
- die "Image not found" if $data->{image} && !-e tuwf->imgpath(cv => $data->{image});
-
- die "Relation with self" if grep $_->{vid} == $vn->{id}, @{$data->{relations}};
- validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, @{$data->{relations}};
- validate_dbid 'SELECT id FROM screenshots WHERE id IN', map $_->{scr}, @{$data->{screenshots}};
- validate_dbid sql('SELECT DISTINCT id FROM releases_vn WHERE vid =', \$vn->{id}, ' AND id IN'), map $_->{rid}, @{$data->{screenshots}};
- validate_dbid 'SELECT aid FROM staff_alias WHERE aid IN', map $_->{aid}, @{$data->{seiyuu}}, @{$data->{staff}};
- validate_dbid sql('SELECT DISTINCT id FROM chars_vns WHERE vid =', \$vn->{id}, ' AND id IN'), map $_->{cid}, @{$data->{seiyuu}};
-
- $data->{desc} = bb_subst_links $data->{desc};
- return $elm_Unchanged->() if !$new && !form_changed $FORM_CMP, $data, $vn;
-
- my($id,undef,$rev) = update_entry v => $vn->{id}, $data;
-
- update_reverse($id, $rev, $vn, $data);
-
- $elm_Changed->($id, $rev);
-};
-
-
-sub update_reverse {
- my($id, $rev, $old, $new) = @_;
-
- my %old = map +($_->{vid}, $_), $old->{relations} ? @{$old->{relations}} : ();
- my %new = map +($_->{vid}, $_), @{$new->{relations}};
-
- # Updates to be performed, vid => { vid => x, relation => y, official => z } or undef if the relation should be removed.
- my %upd;
-
- for my $i (keys %old, keys %new) {
- if($old{$i} && !$new{$i}) {
- $upd{$i} = undef;
- } elsif(!$old{$i} || $old{$i}{relation} ne $new{$i}{relation} || !$old{$i}{official} != !$new{$i}{official}) {
- $upd{$i} = {
- vid => $id,
- relation => vn_relation_reverse($new{$i}{relation}),
- official => $new{$i}{official}
- };
- }
- }
-
- for my $i (keys %upd) {
- my $v = entry v => $i;
- $v->{relations} = [
- $upd{$i} ? $upd{$i} : (),
- grep $_->{vid} != $id, @{$v->{relations}}
- ];
- $v->{editsum} = "Reverse relation update caused by revision v$id.$rev";
- update_entry v => $i, $v, 1;
- }
-}
-
-1;
diff --git a/lib/VN3/VN/JS.pm b/lib/VN3/VN/JS.pm
deleted file mode 100644
index ec98b768..00000000
--- a/lib/VN3/VN/JS.pm
+++ /dev/null
@@ -1,46 +0,0 @@
-package VN3::VN::JS;
-
-use VN3::Prelude;
-
-
-my $elm_VNResult = elm_api VNResult => { aoh => {
- id => { id => 1 },
- title => {},
- original => {},
- hidden => { anybool => 1 },
-}};
-
-
-json_api '/js/vn.json', {
- search => { type => 'array', scalar => 1, minlength => 1, values => { maxlength => 500 } },
- hidden => { anybool => 1 }
-}, sub {
- my $data = shift;
-
- my $r = tuwf->dbAlli(
- 'SELECT v.id, v.title, v.original, v.hidden',
- 'FROM (', (sql_join 'UNION ALL', map {
- my $qs = s/[%_]//gr;
- my @q = normalize_query $_;
- +(
- # ID search
- /^$VID_RE$/ ? (sql 'SELECT 1, id FROM vn WHERE id =', \"$1") : (),
- # prefix match
- sql('SELECT 2, id FROM vn WHERE title ILIKE', \"$qs%"),
- # substring match
- @q ? (sql 'SELECT 3, id FROM vn WHERE', sql_and map sql('c_search ILIKE', \"%$_%"), @q) : ()
- )
- } @{$data->{search}}),
- ') AS vt (ord, id)',
- 'JOIN vn v ON v.id = vt.id',
- $data->{hidden} ? () : ('WHERE NOT v.hidden'),
- 'GROUP BY v.id, v.title, v.original',
- 'ORDER BY MIN(vt.ord), v.title',
- 'LIMIT 20'
- );
-
- $elm_VNResult->($r);
-};
-
-1;
-
diff --git a/lib/VN3/VN/Lib.pm b/lib/VN3/VN/Lib.pm
deleted file mode 100644
index 9571cef8..00000000
--- a/lib/VN3/VN/Lib.pm
+++ /dev/null
@@ -1,20 +0,0 @@
-package VN3::VN::Lib;
-
-use VN3::Prelude;
-
-our @EXPORT = qw/TopNav/;
-
-
-sub TopNav {
- my($page, $v) = @_;
-
- my $rg = exists $v->{rgraph} ? $v->{rgraph} : tuwf->dbVali('SELECT rgraph FROM vn WHERE id=', \$v->{id});
-
- Div class => 'nav raised-top-nav', sub {
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'details'), sub { A href => "/v$v->{id}", class => 'nav__link', 'Details'; };
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'discussions'),sub { A href => "/t/v$v->{id}", class => 'nav__link', 'Discussions'; }; # TODO: count
- Div mkclass('nav__item' => 1, 'nav__item--active' => $page eq 'relations'), sub { A href => "/v$v->{id}/rg", class => 'nav__link', 'Relations'; } if $rg;
- };
-}
-
-1;
diff --git a/lib/VN3/VN/Page.pm b/lib/VN3/VN/Page.pm
deleted file mode 100644
index a09bbeb9..00000000
--- a/lib/VN3/VN/Page.pm
+++ /dev/null
@@ -1,631 +0,0 @@
-package VN3::VN::Page;
-
-use VN3::Prelude;
-use VN3::VN::Lib;
-
-
-TUWF::get '/v/rand', sub {
- # TODO: Apply stored filters?
- my $vid = tuwf->dbVal('SELECT id FROM vn WHERE NOT hidden ORDER BY RANDOM() LIMIT 1');
- tuwf->resRedirect("/v$vid", 'temp');
-};
-
-
-sub CVImage {
- my($vn, $class, $class_sfw, $class_nsfw) = @_;
- return if !$vn->{image};
-
- my $img = tuwf->imgurl(cv => $vn->{image});
- my $nsfw = tuwf->conf->{url_static}.'/v3/nsfw.svg';
- Img class => $class.' '.($vn->{img_nsfw} ? $class_nsfw : $class_sfw),
- !$vn->{img_nsfw} ? (src => $img)
- : auth->pref('show_nsfw') ? (src => $img, 'data-toggle-img' => $nsfw)
- : (src => $nsfw, 'data-toggle-img' => $img);
-}
-
-
-sub Top {
- my $vn = shift;
- Div class => 'fixed-size-left-sidebar-md', '';
- Div class => 'col-md', sub {
- Div class => 'vn-header', sub {
- EntryEdit v => $vn;
- CVImage $vn, 'page-header-img-mobile img img--rounded d-md-none', '', 'nsfw-outline';
- Div class => 'vn-header__title', $vn->{title};
- Div class => 'vn-header__original-title', $vn->{original} if $vn->{original};
- Div class => 'vn-header__details', sub {
- Txt $vn->{c_rating} ? sprintf '%.1f ', $vn->{c_rating}/10 : '-';
- Div class => 'vn-header__sep', '';
- Txt vn_length_time $vn->{length};
- Div class => 'vn-header__sep', '';
- Txt join ', ', map $LANGUAGE{$_}, @{$vn->{c_languages}};
- Debug $vn;
- };
- };
- TopNav details => $vn;
- };
-}
-
-
-sub SidebarProd {
- my $vn = shift;
-
- my $prod = tuwf->dbAlli(q{
- SELECT p.id, p.name, p.original, bool_or(rp.developer) AS dev, bool_or(rp.publisher) AS pub
- FROM releases r
- JOIN releases_producers rp ON rp.id = r.id
- JOIN releases_vn rv ON rv.id = r.id
- JOIN producers p ON rp.pid = p.id
- WHERE rv.vid =}, \$vn->{id}, q{
- AND NOT r.hidden
- GROUP BY p.id, p.name, p.original
- ORDER BY p.name
- });
-
- my $Fmt = sub {
- my($single, $multi, @lst) = @_;
-
- Dt @lst == 1 ? $single : $multi;
- Dd sub {
- Join ', ', sub {
- A href => "/p$_[0]{id}", title => $_[0]{original}||$_[0]{name}, $_[0]{name}
- }, @lst;
- };
- };
-
- $Fmt->('Developer', 'Developers', grep $_->{dev}, @$prod);
- $Fmt->('Publisher', 'Publishers', grep $_->{pub}, @$prod);
-}
-
-
-sub SidebarRel {
- my $vn = shift;
- return if !@{$vn->{relations}};
-
- Dt 'Relations';
- Dd sub {
- Dl sub {
- for my $type (keys %VN_RELATION) {
- my @rel = grep $_->{relation} eq $type, @{$vn->{relations}};
- next if !@rel;
- Dt vn_relation_display $type;
- Dd class => 'single-line-md', sub {
- Span 'unofficial ' if !$_->{official};
- A href => "/v$_->{vid}", title => $_->{original}||$_->{title}, $_->{title};
- } for @rel;
- }
- }
- }
-}
-
-
-sub Sidebar {
- my $vn = shift;
-
- CVImage $vn, 'img img--fit img--rounded d-none d-md-block vn-img-desktop', 'elevation-1', 'elevation-1-nsfw' if $vn->{image};
- Div class => 'vn-image-placeholder img--rounded elevation-1 d-none d-md-block vn-img-desktop', sub {
- Div class => 'vn-image-placeholder__icon', sub {
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/camera-alt.svg';
- }
- } if !$vn->{image};
-
- Div class => 'add-to-list elevated-button elevation-1', sub {
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/plus.svg';
- Txt 'Add to my list';
- };
-
- Dl class => 'vn-page__dl', sub {
- if($vn->{original}) {
- Dt 'Original Title';
- Dd $vn->{original};
- }
-
- Dt 'Main Title';
- Dd $vn->{title};
-
- if($vn->{alias}) {
- Dt 'Aliases';
- Dd $vn->{alias} =~ s/\n/, /gr;
- }
-
- if($vn->{length}) {
- Dt 'Length';
- Dd vn_length_display $vn->{length};
- }
-
- SidebarProd $vn;
- SidebarRel $vn;
-
- # TODO: Affiliate links
- # TODO: Anime
- };
-}
-
-
-sub Tags {
- my $vn = shift;
-
- my $tag_rating = 'avg(CASE WHEN tv.ignore THEN NULL ELSE tv.vote END)';
- my $tags = tuwf->dbAlli(qq{
- SELECT tv.tag, t.name, t.cat, count(*) as cnt, $tag_rating as rating,
- COALESCE(avg(CASE WHEN tv.ignore THEN NULL ELSE tv.spoiler END), t.defaultspoil) as spoiler
- FROM tags_vn tv
- JOIN tags t ON tv.tag = t.id
- WHERE tv.vid =}, \$vn->{id}, qq{
- AND t.state = 1+1
- GROUP BY tv.tag, t.name, t.cat, t.defaultspoil
- HAVING $tag_rating > 0
- ORDER BY $tag_rating DESC
- });
-
- my $spoil = auth->pref('spoilers') || 0;
- my $cat = auth->pref('tags_cat') || 'cont,tech';
- my %cat = map +($_, !!($cat =~ /$_/)), qw/cont ero tech/;
-
- Div mkclass(
- 'tag-summary__tags' => 1,
- 'tag-summary--collapsed' => 1,
- 'tag-summary--hide-spoil-1' => $spoil < 1,
- 'tag-summary--hide-spoil-2' => $spoil < 2,
- map +("tag-summary--hide-$_", !$cat{$_}), keys %cat
- ), sub {
- for my $tag (@$tags) {
- Div class => sprintf(
- 'tag-summary__tag tag-summary__tag--%s tag-summary__tag--spoil-%d',
- $tag->{cat}, $tag->{spoiler} > 1.3 ? 2 : $tag->{spoiler} > 0.4 ? 1 : 0
- ), sub {
- A href => "/g$tag->{tag}", class => 'link--subtle', $tag->{name};
- Div class => 'tag-summary__tag-meter', style => sprintf('width: %dpx', $tag->{rating}*10), '';
- };
- }
- };
-
- Div class => 'tag-summary__options', sub {
- Div class => 'tag-summary__options-left', sub {
- A href => 'javascript:;', class => 'link--subtle d-none tag-summary__show-all', sub {
- Span class => 'caret caret--pre', '';
- Txt ' Show all tags';
- };
- Debug $tags;
- };
- Div class => 'tag-summary__options-right', sub {
- Div class => 'tag-summary__option dropdown', sub {
- A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub {
- Span class => 'tag-summary_option--spoil', spoil_display $spoil;
- Lit ' ';
- Span class => 'caret', '';
- };
- Div class => 'dropdown-menu', sub {
- A class => 'dropdown-menu__item tag-summary_option--spoil-0', href => 'javascript:;', spoil_display 0;
- A class => 'dropdown-menu__item tag-summary_option--spoil-1', href => 'javascript:;', spoil_display 1;
- A class => 'dropdown-menu__item tag-summary_option--spoil-2', href => 'javascript:;', spoil_display 2;
- };
- };
- Div class => 'tag-summary__option', sub { Switch 'Content', $cat{cont}, 'tag-summary__option--cont' => 1; };
- Div class => 'tag-summary__option', sub { Switch 'Sexual', $cat{ero}, 'tag-summary__option--ero' => 1; };
- Div class => 'tag-summary__option', sub { Switch 'Technical', $cat{tech}, 'tag-summary__option--tech' => 1; };
- };
- };
-}
-
-
-sub Releases {
- my $vn = shift;
-
- my %lang;
- my @lang = grep !$lang{$_}++, map @{$_->{lang}}, @{$vn->{releases}};
-
- for my $lang (@lang) {
- Div class => 'relsm__language', sub {
- Lang $lang;
- Txt " $LANGUAGE{$lang}";
- };
- Div class => 'relsm__table', sub {
- Div class => 'relsm__rel', sub {
- my $rel = $_;
-
- Div class => 'relsm__rel-col relsm__rel-date tabular-nums', sub { ReleaseDate $rel->{released}; };
- A class => 'relsm__rel-col relsm__rel-name', href => "/r$rel->{id}", title => $rel->{original}||$rel->{title}, $rel->{title};
- Div class => 'relsm__rel-col relsm__rel-platforms', sub { Platform $_ for @{$rel->{platforms}} };
- Div class => 'relsm__rel-col relsm__rel-mylist', sub {
- # TODO: Make this do something
- Img class => 'svg-icon', src => tuwf->conf->{url_static}.'/v3/plus-circle.svg';
- };
- if($rel->{website}) {
- Div class => 'relsm__rel-col relsm__rel-link', sub {
- A href => $rel->{website}, 'Link';
- };
- } else {
- Div class => 'relsm__rel-col relsm__rel-link relsm__rel-link--none', 'Link';
- }
-
- # TODO: Age rating
- # TODO: Release type
- # TODO: Release icons
- } for grep grep($_ eq $lang, @{$_->{lang}}), @{$vn->{releases}};
- }
- }
-}
-
-
-sub Staff {
- my $vn = shift;
- return if !@{$vn->{staff}};
-
- my $Role = sub {
- my $role = shift;
- my @staff = grep $_->{role} eq $role, @{$vn->{staff}};
- return if !@staff;
-
- Div class => 'staff-credits__section', sub {
- Div class => 'staff-credits__section-title', $CREDIT_TYPE{$role};
- Div class => 'staff-credits__item', sub {
- A href => "/s$_->{id}", title => $_->{original}||$_->{name}, $_->{name};
- Span class => 'staff-credits__note', " $_->{note}" if $_->{note};
- } for (@staff);
- };
- };
-
- Div class => 'section', id => 'staff', sub {
- H2 class => 'section__title', 'Staff';
- Div class => 'staff-credits js-columnize', 'data-columns' => 3, sub {
- $Role->($_) for keys %CREDIT_TYPE;
- };
- };
-}
-
-
-sub Gallery {
- my $vn = shift;
-
- return if !@{$vn->{screenshots}};
- my $show = auth->pref('show_nsfw');
-
- Div mkclass(section => 1, gallery => 1, 'gallery--show-r18' => $show), id => 'gallery', sub {
- H2 class => 'section__title', sub {
- Switch '18+', $show, 'gallery-r18-toggle' => 1 if grep $_->{nsfw}, @{$vn->{screenshots}};
- Txt 'Gallery';
- };
-
- # TODO: Thumbnails are being upscaled, we should probably recreate all thumbnails at higher resolution
-
- Div class => 'gallery__section', sub {
- for my $s (@{$vn->{screenshots}}) {
- my $r = (grep $_->{id} == $s->{rid}, @{$vn->{releases}})[0];
- my $meta = {
- width => 1*$s->{width},
- height => 1*$s->{height},
- rel => {
- id => 1*$s->{rid},
- title => $r->{title},
- lang => $r->{lang},
- plat => $r->{platforms},
- }
- };
-
- A mkclass('gallery__image-link' => 1, 'gallery__image--r18' => $s->{nsfw}),
- 'data-lightbox-nfo' => JSON::XS->new->encode($meta),
- href => tuwf->imgurl(sf => $s->{scr}),
- sub {
- Img mkclass(gallery__image => 1, 'nsfw-outline' => $s->{nsfw}), src => tuwf->imgurl(st => $s->{scr});
- }
- }
- }
- };
-}
-
-
-sub CharacterList {
- my($vn, $roles, $first_char) = @_;
-
- # TODO: Implement spoiler & sexual stuff settings
- # TODO: Make long character lists collapsable
-
- Div class => 'character-browser__top-item dropdown', sub {
- A href => 'javascript:;', class => 'link--subtle dropdown__toggle', sub {
- Txt spoil_display 0;
- Lit ' ';
- Span class => 'caret', '';
- };
- Div class => 'dropdown-menu', sub {
- A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 0;
- A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 1;
- A class => 'dropdown-menu__item', href => 'javascript:;', spoil_display 2;
- };
- };
- Div class => 'character-browser__top-item d-none d-md-block', sub { Switch 'Sexual traits', 0 };
- Div class => 'character-browser__top-item', sub {
- A href => "/v$vn->{id}/chars", 'View all on one page';
- };
-
- Div class => 'character-browser__list', sub {
- Div class => 'character-browser__list-title', char_role_display $_, scalar @{$roles->{$_}};
- A mkclass('character-browser__char' => 1, 'character-browser__char--active' => $_->{id} == $first_char),
- href => "/c$_->{id}", title => $_->{original}||$_->{name}, 'data-character' => $_->{id}, $_->{name}
- for @{$roles->{$_}};
- } for grep @{$roles->{$_}}, keys %CHAR_ROLE;
-}
-
-
-sub CharacterInfo {
- my $char = shift;
-
- Div class => 'row', sub {
- Div class => 'col-md', sub {
- # TODO: Gender & blood type
- Div class => 'character__name', $char->{name};
- Div class => 'character__subtitle', $char->{original} if $char->{original};
- Div class => 'character__description serif', sub {
- P sub { Lit bb2html $char->{desc}, 0, 1 };
- };
- };
- Div class => 'col-md character__image', sub {
- Img class => 'img img--fit img--rounded',
- src => tuwf->imgurl(ch => $char->{image})
- } if $char->{image};
- };
-
- my(%groups, @groups);
- for(@{$char->{traits}}) {
- push @groups, $_->{gid} if !$groups{$_->{gid}};
- push @{$groups{$_->{gid}}}, $_;
- }
-
- # Create a list of key/value things, so that we can neatly split them in
- # two. The split occurs on the number of sections, so long sections can
- # still cause some imbalance.
- # TODO: Date of birth?
- my @traits = (
- $char->{alias} ? sub {
- Dt 'Aliases';
- Dd $char->{alias} =~ s/\n/, /gr;
- } : (),
-
- $char->{weight} || $char->{height} || $char->{s_bust} || $char->{s_waist} || $char->{s_hip} ? sub {
- Dt 'Measurements';
- Dd join ', ',
- $char->{height} ? "Height: $char->{height}cm" : (),
- $char->{weight} ? "Weight: $char->{weight}kg" : (),
- $char->{s_bust} || $char->{s_waist} || $char->{s_hip} ?
- sprintf 'Bust-Waist-Hips: %s-%s-%scm', $char->{s_bust}||'??', $char->{s_waist}||'??', $char->{s_hip}||'??' : ();
- } : (),
-
- # TODO: Do something with spoiler settings.
- (map { my $g = $_; sub {
- Dt sub { A href => "/i$g", $groups{$g}[0]{group} };
- Dd sub {
- Join ', ', sub {
- A href => "/i$_[0]{tid}", $_[0]{name};
- }, @{$groups{$g}};
- };
- } } @groups),
-
- @{$char->{seiyuu}} ? sub {
- Dt 'Voiced by';
- Dd sub {
- my $prev = '';
- for my $s (sort { $a->{name} cmp $b->{name} } @{$char->{seiyuu}}) {
- next if $s->{name} eq $prev;
- A href => "/s$s->{id}", title => $s->{original}||$s->{name}, $s->{name};
- Txt ' ('.$s->{note}.')' if $s->{note};
- }
- };
- } : (),
- );
-
- Div class => 'character__traits row mt-4', sub {
- Dl class => 'col-md dl--horizontal', sub { $_->() for @traits[0..$#traits/2]; };
- Dl class => 'col-md dl--horizontal', sub { $_->() for @traits[$#traits/2+1..$#traits]; };
- } if @traits;
-}
-
-
-sub Characters {
- my $vn = shift;
-
- # XXX: Fetching and rendering all character details on the VN page is a bit
- # inefficient and bloats the HTML. We should probably load data from other
- # characters on demand.
-
- my $chars = tuwf->dbAlli(q{
- SELECT id, name, original, alias, image, "desc", gender, s_bust, s_waist, s_hip,
- b_month, b_day, height, weight, bloodt
- FROM chars
- WHERE NOT hidden
- AND id IN(SELECT id FROM chars_vns WHERE vid =}, \$vn->{id}, q{)
- ORDER BY name
- });
- return if !@$chars;
-
- enrich_list releases => id => id =>
- sql('SELECT id, rid, spoil, role FROM chars_vns WHERE vid =', \$vn->{id}, ' AND id IN'),
- $chars;
-
- # XXX: Just fetching this list takes ~10ms for a large VN (v92). I worry
- # about formatting and displaying it on every page view. (This query can
- # probably be sped up by grabbing/caching the group tag names separately,
- # there are only 12 groups in the DB anyway).
- enrich_list traits => id => id => sub {sql q{
- SELECT ct.id, ct.tid, ct.spoil, t.name, t.sexual, g.id AS gid, g.name AS group, g.order
- FROM chars_traits ct
- JOIN traits t ON t.id = ct.tid
- JOIN traits g ON g.id = t.group
- WHERE ct.id IN}, $_[0], q{
- ORDER BY g.order, t.name
- }}, $chars;
-
- enrich_list seiyuu => id => cid => sub{sql q{
- SELECT va.id, vs.aid, vs.cid, vs.note, va.name, va.original
- FROM vn_seiyuu_hist vs JOIN staff_alias va ON va.aid = vs.aid
- WHERE vs.chid =}, \$vn->{chid}
- }, $chars;
-
- my %done;
- my %roles = map {
- my $r = $_;
- ($r, [ grep grep($_->{role} eq $r, @{$_->{releases}}) && !$done{$_->{id}}++, @$chars ]);
- } keys %CHAR_ROLE;
-
- my($first_char) = map @{$roles{$_}} ? $roles{$_}[0]{id} : (), keys %CHAR_ROLE;
-
- Div class => 'section', id => 'characters', sub {
- H2 class => 'section__title', sub { Txt 'Characters'; Debug \%roles };
- Div class => 'character-browser', sub {
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md', sub {
- Div class => 'character-browser__top-items', sub { CharacterList $vn, \%roles, $first_char; }
- };
- Div class => 'col-md col-md--3 d-none d-md-block', sub {
- Div mkclass(character => 1, 'd-none' => $_->{id} != $first_char), 'data-character' => $_->{id},
- sub { CharacterInfo $_ }
- for @$chars;
- };
- };
- };
- };
-}
-
-
-sub Stats {
- my $vn = shift;
-
- my($has_data, $Dist) = VoteGraph v => $vn->{id};
- return if !$has_data;
-
- my $recent_votes = tuwf->dbAlli(q{
- SELECT v.vid, v.vote,}, sql_totime('v.date'), q{AS date, u.id, u.username
- FROM votes v JOIN users u ON u.id = v.uid
- WHERE NOT EXISTS(SELECT 1 FROM users_prefs WHERE uid = u.id AND key = 'hide_list')
- AND NOT u.ign_votes
- AND v.vid =}, \$vn->{id}, q{
- ORDER BY v.date DESC LIMIT 10
- });
- my $Recent = sub {
- H4 'Recent votes';
- Div class => 'recent-votes', sub {
- Table class => 'recent-votes__table tabular-numbs', sub {
- Tbody sub {
- Tr sub {
- Td sub { A href => "/u$_->{id}", $_->{username}; };
- Td vote_display $_->{vote};
- Td date_display $_->{date};
- } for @$recent_votes;
- };
- };
- Div class => 'final-text', sub {
- A href => "/v$vn->{id}/votes", 'All votes';
- };
- };
- };
-
-
- my $popularity_rank = tuwf->dbVali(
- 'SELECT COUNT(*)+1 FROM vn WHERE NOT hidden AND c_popularity >',
- \($vn->{c_popularity}||0)
- );
- my $rating_rank = tuwf->dbVali(
- 'SELECT COUNT(*)+1 FROM vn WHERE NOT hidden AND c_rating >',
- \($vn->{c_rating}||0)
- );
-
- my $Popularity = sub {
- H4 'Ranking';
- Dl class => 'stats__ranking', sub {
- Dt 'Popularity';
- Dd sprintf 'ranked #%d with a score of %.2f', $popularity_rank, 100*($vn->{c_popularity}||0);
- Dt 'Bayesian rating';
- Dd sprintf 'ranked #%d with a rating of %.2f', $rating_rank, $vn->{c_rating}/10;
- };
- Div class => 'final-text', sub {
- A href => '/v/all', 'See best rated games';
- };
- };
-
-
- Div class => 'section stats', id => 'stats', sub {
- H2 class => 'section__title', 'Stats';
- Div class => 'row semi-muted', sub {
- Div class => 'stats__col col-md col-md-1', sub {
- H4 'Vote distribution';
- $Dist->();
- };
- Div class => 'stats__col col-md col-md-1', $Recent if @$recent_votes;
- Div class => 'stats__col col-md col-md-1', $Popularity;
- };
- };
-}
-
-
-sub Contents {
- my $vn = shift;
-
- Div class => 'vn-page', sub {
- Div class => 'row', sub {
- Div class => 'col-md', sub {
- Div class => 'row', sub {
- Div class => 'fixed-size-left-sidebar-md vn-page__top-details', sub { Sidebar $vn };
- Div class => 'fixed-size-left-sidebar-md', '';
- Div class => 'col-md', sub {
- Div class => 'description serif', id => 'about', sub {
- P sub { Lit bb2html $vn->{desc}||'No description.' };
- };
- Div class => 'section', id => 'tags', sub {
- Div class => 'tag-summary', sub { Tags $vn };
- };
- Div class => 'section', id => 'releases', sub {
- H2 class => 'section__title', 'Releases';
- Div class => 'relsm', sub { Releases $vn };
- };
- Staff $vn;
- Gallery $vn;
- };
- };
- };
- };
- Div class => 'row', sub {
- Div class => 'col-xxl', sub {
- Characters $vn;
- Stats $vn;
- };
- };
- };
-}
-
-
-TUWF::get qr{/$VREV_RE}, sub {
- my $vn = entry v => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
- return tuwf->resNotFound if !$vn->{id} || $vn->{hidden};
-
- enrich id => q{SELECT id, rgraph, c_languages::text[], c_popularity, c_rating, c_votecount FROM vn WHERE id IN}, $vn;
- enrich scr => q{SELECT id AS scr, width, height FROM screenshots WHERE id IN}, $vn->{screenshots};
- enrich vid => q{SELECT id AS vid, title, original FROM vn WHERE id IN}, $vn->{relations};
- enrich aid => q{SELECT aid, id, name, original FROM staff_alias WHERE aid IN}, $vn->{staff};
-
- enrich_list releases => id => vid => sub {sql q{
- SELECT rv.vid, r.id, r.title, r.original, r.type, r.website, r.released, r.notes,
- r.minage, r.patch, r.freeware, r.doujin, r.resolution, r.voiced, r.ani_story, r.ani_ero
- FROM releases r
- JOIN releases_vn rv ON r.id = rv.id
- WHERE NOT r.hidden AND rv.vid IN}, $_[0], q{
- ORDER BY r.released
- }}, $vn;
-
- enrich_list1 platforms => id => id => 'SELECT id, platform FROM releases_platforms WHERE id IN', $vn->{releases};
- enrich_list1 lang => id => id => 'SELECT id, lang FROM releases_lang WHERE id IN', $vn->{releases};
- enrich_list media => id => id => 'SELECT id, medium, qty FROM releases_media WHERE id IN', $vn->{releases};
-
- Framework
- og => {
- description => bb2text($vn->{desc}),
- $vn->{image} && !$vn->{img_nsfw} ? (
- image => tuwf->imgurl(cv => $vn->{image})
- ) : (($_) = grep !$_->{nsfw}, @{$vn->{screenshots}}) ? (
- image => tuwf->imgurl(st => $_->{scr})
- ) : ()
- },
- title => $vn->{title},
- top => sub { Top $vn },
- sub { Contents $vn };
-};
-
-1;
diff --git a/lib/VN3/Validation.pm b/lib/VN3/Validation.pm
deleted file mode 100644
index 73bf7d62..00000000
--- a/lib/VN3/Validation.pm
+++ /dev/null
@@ -1,168 +0,0 @@
-# This module provides additional validations for tuwf->validate(), and exports
-# a few convenient form handling/validation functions.
-package VN3::Validation;
-
-use strict;
-use warnings;
-use TUWF;
-use VNDBUtil;
-use VNDB::Types;
-use VNWeb::Auth;
-use VN3::DB;
-use VN3::Types;
-use JSON::XS;
-use Exporter 'import';
-use Time::Local 'timegm';
-use Carp 'croak';
-our @EXPORT = ('form_compile', 'form_changed', 'validate_dbid', 'can_edit');
-
-
-TUWF::set custom_validations => {
- id => { uint => 1, max => 1<<40 },
- page => { uint => 1, min => 1, max => 1000, required => 0, default => 1 },
- username => { regex => qr/^[a-z0-9-]{2,15}$/ },
- password => { length => [ 4, 500 ] },
- editsum => { required => 1, length => [ 2, 5000 ] },
- vn_length => { required => 0, default => 0, uint => 1, enum => \%VN_LENGTH },
- vn_relation => { enum => \%VN_RELATION },
- producer_relation => { enum => \%PRODUCER_RELATION },
- staff_role => { enum => \%CREDIT_TYPE },
- char_role => { enum => \%CHAR_ROLE },
- language => { enum => \%LANGUAGE },
- platform => { enum => \%PLATFORM },
- medium => { enum => \%MEDIUM },
- resolution => { enum => \%RESOLUTION },
- gender => { enum => \%GENDER },
- blood_type => { enum => \%BLOOD_TYPE },
- gtin => { uint => 1, func => sub { $_[0] eq 0 || gtintype($_[0]) } },
- minage => { uint => 1, enum => \%AGE_RATING },
- animated => { uint => 1, enum => \%ANIMATED },
- voiced => { uint => 1, enum => \%VOICED },
- rdate => { uint => 1, func => \&_validate_rdate },
- spoiler => { uint => 1, range => [ 0, 2 ] },
- vnlist_status=>{ enum => \%VNLIST_STATUS },
- # Accepts a user-entered vote string (or '-' or empty) and converts that into a DB vote number (or undef)
- vnvote => { regex => qr/^(?:|-|[1-9]|10|[1-9]\.[0-9]|10\.0)$/, required => 0, func => sub { $_[0] = $_[0] eq '-' ? undef : 10*$_[0]; 1 } },
- # Sort an array by the listed hash keys, using string comparison on each key
- sort_keys => sub {
- my @keys = ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0];
- +{ type => 'array', sort => sub {
- for(@keys) {
- my $c = defined($_[0]{$_}) cmp defined($_[1]{$_}) || (defined($_[0]{$_}) && $_[0]{$_} cmp $_[1]{$_});
- return $c if $c;
- }
- 0
- } }
- },
- # Sorted and unique array-of-hashes (default order is sort_keys on the sorted keys...)
- aoh => sub { +{ type => 'array', unique => 1, sort_keys => [sort keys %{$_[0]}], values => { type => 'hash', keys => $_[0] } } },
-};
-
-
-sub _validate_rdate {
- return 0 if $_[0] ne 0 && $_[0] !~ /^([0-9]{4})([0-9]{2})([0-9]{2})$/;
- my($y, $m, $d) = $_[0] eq 0 ? (0,0,0) : ($1, $2, $3);
-
- # Re-normalize
- ($m, $d) = (0, 0) if $y == 0;
- $m = 99 if $y == 9999;
- $d = 99 if $m == 99;
- $_[0] = $y*10000 + $m*100 + $d;
-
- return 0 if $y && $y != 9999 && ($y < 1980 || $y > 2100);
- return 0 if $y && $m != 99 && (!$m || $m > 12);
- return 0 if $y && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) };
- return 1;
-}
-
-
-# Recursively remove keys from hashes that have a '_when' key that doesn't
-# match $when. This is a quick and dirty way to create multiple validation
-# schemas from a single schema. For example:
-#
-# {
-# title => { _when => 'input' },
-# name => { },
-# }
-#
-# If $when is 'input', then this function returns:
-# { title => {}, name => {} }
-# Otherwise, it returns:
-# { name => {} }
-sub stripwhen {
- my($when, $o) = @_;
- return $o if ref $o ne 'HASH';
- +{ map $_ eq '_when' || (ref $o->{$_} eq 'HASH' && defined $o->{$_}{_when} && $o->{$_}{_when} !~ $when) ? () : ($_, stripwhen($when, $o->{$_})), keys %$o }
-}
-
-
-# Short-hand to compile a validation schema for a form. Usage:
-#
-# form_compile $when, {
-# title => { _when => 'input' },
-# name => { },
-# ..
-# };
-sub form_compile {
- tuwf->compile({ type => 'hash', keys => stripwhen @_ });
-}
-
-
-sub eq_deep {
- my($a, $b) = @_;
- return 0 if ref $a ne ref $b;
- return 0 if defined $a != defined $b;
- return 1 if !defined $a;
- return 1 if !ref $a && $a eq $b;
- return 1 if ref $a eq 'ARRAY' && (@$a == @$b && !grep !eq_deep($a->[$_], $b->[$_]), 0..$#$a);
- return 1 if ref $a eq 'HASH' && eq_deep([sort keys %$a], [sort keys %$b]) && !grep !eq_deep($a->{$_}, $b->{$_}), keys %$a;
- 0
-}
-
-
-# Usage: form_changed $schema, $a, $b
-# Returns 1 if there is a difference between the data ($a) and the form input
-# ($b), using the normalization defined in $schema. The $schema must validate.
-sub form_changed {
- my($schema, $a, $b) = @_;
- my $na = $schema->validate($a)->data;
- my $nb = $schema->validate($b)->data;
-
- #warn "a=".JSON::XS->new->pretty->canonical->encode($na);
- #warn "b=".JSON::XS->new->pretty->canonical->encode($nb);
- !eq_deep $na, $nb;
-}
-
-
-# Validate identifiers against an SQL query. The query must end with a 'id IN'
-# clause, where the @ids array is appended. The query must return exactly 1
-# column, the id of each entry. This function throws an error if an id is
-# missing from the query. For example, to test for non-hidden VNs:
-#
-# validate_dbid 'SELECT id FROM vn WHERE NOT hidden AND id IN', 2,3,5,7,...;
-#
-# If any of those ids is hidden or not in the database, an error is thrown.
-sub validate_dbid {
- my($sql, @ids) = @_;
- return if !@ids;
- $sql = ref $sql eq 'CODE' ? sql $sql->(\@ids) : sql $sql, \@ids;
- my %dbids = map +((values %$_)[0],1), @{ tuwf->dbAlli($sql) };
- my @missing = grep !$dbids{$_}, @ids;
- croak "Invalid database IDs: ".join(',', @missing) if @missing;
-}
-
-
-# Returns whether the current user can edit the given database entry.
-sub can_edit {
- my($type, $entry) = @_;
-
- return auth->permUsermod || $entry->{id} == (auth->uid||0) if $type eq 'u';
- return auth->permDbmod if $type eq 'd';
-
- die "Can't do authorization test when entry_hidden/entry_locked fields aren't present"
- if $entry->{id} && (!exists $entry->{entry_hidden} || !exists $entry->{entry_locked});
-
- auth->permDbmod || (auth->permEdit && !($entry->{entry_hidden} || $entry->{entry_locked}));
-}
-
-1;