diff options
Diffstat (limited to 'lib/VNDB/Util')
-rw-r--r-- | lib/VNDB/Util/Auth.pm | 129 | ||||
-rw-r--r-- | lib/VNDB/Util/BrowseHTML.pm | 190 | ||||
-rw-r--r-- | lib/VNDB/Util/CommonHTML.pm | 304 | ||||
-rw-r--r-- | lib/VNDB/Util/FormHTML.pm | 282 | ||||
-rw-r--r-- | lib/VNDB/Util/LayoutHTML.pm | 43 | ||||
-rw-r--r-- | lib/VNDB/Util/Misc.pm | 122 | ||||
-rw-r--r-- | lib/VNDB/Util/ValidateTemplates.pm | 110 |
7 files changed, 0 insertions, 1180 deletions
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm deleted file mode 100644 index 4394149f..00000000 --- a/lib/VNDB/Util/Auth.pm +++ /dev/null @@ -1,129 +0,0 @@ -# Compatibility shim around VNWeb::Auth, new code should use that instead. -package VNDB::Util::Auth; - - -use strict; -use warnings; -use Exporter 'import'; -use TUWF ':html'; -use VNWeb::Auth; - - -our @EXPORT = qw| - authInit authLogin authLogout authInfo authCan authSetPass authAdminSetPass - authResetPass authIsValidToken authGetCode authCheckCode authPref -|; - - -# login, arguments: user, password, url-to-redirect-to-on-success -# returns 1 on success (redirected), 0 otherwise (no reply sent) -sub authLogin { - my(undef, $user, $pass, $to) = @_; - my $success = auth->login($user, $pass); - tuwf->resRedirect($to, 'post') if $success; - $success -} - -# clears authentication cookie and redirects to / -sub authLogout { - auth->logout; - tuwf->resRedirect('/', 'temp'); -} - - -# Replaces the user's password with a random token that can be used to reset the password. -sub authResetPass { - my(undef, $mail) = @_; - auth->resetpass($mail) -} - - -sub authIsValidToken { - my(undef, $uid, $token) = @_; - auth->isvalidtoken($uid, $token) -} - - -# uid, new_pass, url_to_redir_to, 'token'|'pass', $token_or_pass -# Changes the user's password, invalidates all existing sessions, creates a new -# session and redirects. -sub authSetPass { - my(undef, $uid, $pass, $redir, $oldtype, $oldpass) = @_; - - my $success = auth->setpass($uid, $oldtype eq 'token' ? $oldpass : undef, $oldtype eq 'pass' ? $oldpass : undef, $pass); - tuwf->resRedirect($redir, 'post') if $success; - $success -} - - -sub authAdminSetPass { - my(undef, $uid, $pass) = @_; - auth->admin_setpass($uid, $pass); -} - - -sub authInfo { - # Used to return a lot more, but only the id is still used now. - # (code using other fields has been migrated) - +{ id => auth->uid } -} - - -# returns whether the currently loggedin or anonymous user can perform -# a certain action. -sub authCan { - my(undef, $act) = @_; - auth->perm() & auth->listPerms->{$act} -} - - -# Generate a code to be used later on to validate that the form was indeed -# submitted from our site and by the same user/visitor. Not limited to -# logged-in users. -# Arguments: -# form-id (ignored nowadyas) -# time (also ignored) -sub authGetCode { - auth->csrftoken; -} - - -# Validates the correctness of the returned code, creates an error page and -# returns false if it's invalid, returns true otherwise. Codes are valid for at -# least two and at most three hours. -# Arguments: -# [ form-id, [ code ] ] -# If the code is not given, uses the 'formcode' form parameter instead. If -# form-id is not given, the path of the current requests is used. -sub authCheckCode { - my $self = shift; - my $id = shift; - my $code = shift || $self->reqParam('formcode'); - return _incorrectcode($self) if !auth->csrfcheck($code); - 1; -} - - -sub _incorrectcode { - my $self = shift; - $self->resInit; - $self->htmlHeader(title => 'Validation code expired', noindex => 1); - - div class => 'mainbox'; - h1 'Validation code expired'; - div class => 'warning'; - p 'Please hit the back-button of your browser, refresh the page and try again.'; - end; - end; - - $self->htmlFooter; - return 0; -} - - -sub authPref { - my(undef, $key, $val) = @_; - @_ == 2 ? auth->pref($key)||'' : auth->prefSet($key, $val); -} - -1; diff --git a/lib/VNDB/Util/BrowseHTML.pm b/lib/VNDB/Util/BrowseHTML.pm deleted file mode 100644 index 29d131c5..00000000 --- a/lib/VNDB/Util/BrowseHTML.pm +++ /dev/null @@ -1,190 +0,0 @@ - -package VNDB::Util::BrowseHTML; - -use strict; -use warnings; -use TUWF ':html', 'xml_escape'; -use Exporter 'import'; -use VNDB::Func; -use VNDB::Types; -use POSIX 'ceil'; - - -our @EXPORT = qw| htmlBrowse htmlBrowseNavigate htmlBrowseVN |; - - -# generates a browse box, arguments: -# items => arrayref with the list items -# options => hashref containing at least the keys s (sort key), o (order) and p (page) -# nextpage => whether there's a next page or not -# sorturl => base URL to append the sort options to (if there are any sortable columns) -# pageurl => base URL to append the page option to -# class => classname of the mainbox -# header => -# can be either an arrayref or subroutine reference, -# in the case of a subroutine, it will be called when the header should be written, -# in the case of an arrayref, the array should contain the header items. Each item -# can again be either an arrayref or subroutine ref. The arrayref would consist of -# two elements: the name of the header, and the name of the sorting column if it can -# be sorted -# row => subroutine ref, which is called for each item in $list, arguments will be -# $self, $item_number (starting from 0), $item_value -# footer => subroutine ref, called after all rows have been processed -sub htmlBrowse { - my($self, %opt) = @_; - - $opt{sorturl} .= $opt{sorturl} =~ /\?/ ? ';' : '?' if $opt{sorturl}; - - # top navigation - $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 't') if $opt{pageurl}; - - div class => 'mainbox browse'.($opt{class} ? ' '.$opt{class} : ''); - table class => 'stripe'; - - # header - thead; - Tr; - if(ref $opt{header} eq 'CODE') { - $opt{header}->($self); - } else { - for(0..$#{$opt{header}}) { - if(ref $opt{header}[$_] eq 'CODE') { - $opt{header}[$_]->($self, $_+1); - } else { - td class => $opt{header}[$_][3]||'tc'.($_+1), $opt{header}[$_][2] ? (colspan => $opt{header}[$_][2]) : (); - lit $opt{header}[$_][0]; - if($opt{header}[$_][1]) { - lit ' '; - $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'a' ? lit "\x{25B4}" : a href => "$opt{sorturl}o=a;s=$opt{header}[$_][1]", "\x{25B4}"; - $opt{options}{s} eq $opt{header}[$_][1] && $opt{options}{o} eq 'd' ? lit "\x{25BE}" : a href => "$opt{sorturl}o=d;s=$opt{header}[$_][1]", "\x{25BE}"; - } - end; - } - } - } - end; - end 'thead'; - - # footer - if($opt{footer}) { - tfoot; - $opt{footer}->($self); - end; - } - - # rows - $opt{row}->($self, $_+1, $opt{items}[$_]) - for 0..$#{$opt{items}}; - - end 'table'; - end 'div'; - - # bottom navigation - $self->htmlBrowseNavigate($opt{pageurl}, $opt{options}{p}, $opt{nextpage}, 'b') if $opt{pageurl}; -} - - -# creates next/previous buttons (tabs), if needed -# Arguments: page url, current page (1..n), nextpage (0/1 or [$total, $perpage]), alignment (t/b), noappend (0/1) -sub htmlBrowseNavigate { - my($self, $url, $p, $np, $al, $na) = @_; - my($cnt, $pp) = ref($np) ? @$np : ($p+$np, 1); - return if $p == 1 && $cnt <= $pp; - - $url .= $url =~ /\?/ ? ';p=' : '?p=' unless $na; - - my $tab = sub { - my($page, $label) = @_; - li; - a href => $url.$page; lit $label; end; - end; - }; - my $ell = sub { - use utf8; - li class => 'ellipsis'; - b '⋯'; - end; - }; - my $nc = 5; # max. number of buttons on each side - - div class => 'maintabs browsetabs '.($al eq 't' ? '' : 'bottom'); - ul; - $p > 2 and ref $np and $tab->(1, '« first'); - $p > $nc+1 and ref $np and $ell->(); - $p > $_ and ref $np and $tab->($p-$_, $p-$_) for (reverse 2..($nc>$p-2?$p-2:$nc-1)); - $p > 1 and $tab->($p-1, '‹ previous'); - end; - - ul; - my $l = ceil($cnt/$pp)-$p+1; - $l > 1 and $tab->($p+1, 'next ›'); - $l > $_ and $tab->($p+$_, $p+$_) for (2..($nc>$l-2?$l-2:$nc-1)); - $l > $nc+1 and $ell->(); - $l > 2 and $tab->($l+$p-1, 'last »'); - end; - end 'div'; -} - - -sub htmlBrowseVN { - my($self, $list, $f, $np, $url, $tagscore) = @_; - $self->htmlBrowse( - class => 'vnbrowse', - items => $list, - options => $f, - nextpage => $np, - pageurl => "$url;o=$f->{o};s=$f->{s}", - sorturl => $url, - header => [ - $tagscore ? [ 'Score', 'tagscore', undef, 'tc_s' ] : (), - [ 'Title', 'title', undef, $tagscore ? 'tc_t' : 'tc1' ], - $f->{vnlist} ? [ '', 0, undef, 'tc7' ] : (), - $f->{wish} ? [ '', 0, undef, 'tc8' ] : (), - [ '', 0, undef, 'tc2' ], - [ '', 0, undef, 'tc3' ], - [ 'Released', 'rel', undef, 'tc4' ], - [ 'Popularity', 'pop', undef, 'tc5' ], - [ 'Rating', 'rating', undef, 'tc6' ], - ], - row => sub { - my($s, $n, $l) = @_; - Tr; - if($tagscore) { - td class => 'tc_s'; - VNWeb::Tags::Lib::tagscore_($l->{tagscore}); - end; - } - td class => $tagscore ? 'tc_t' : 'tc1'; - a href => '/v'.$l->{id}, title => $l->{original}||$l->{title}, shorten $l->{title}, 100; - end; - if($f->{vnlist}) { - td class => 'tc7'; - lit sprintf '<b class="%s">%d/%d</b>', $l->{userlist_obtained} == $l->{userlist_all} ? 'done' : 'todo', $l->{userlist_obtained}, $l->{userlist_all} if $l->{userlist_all}; - abbr title => join(', ', $l->{vnlist_labels}->@*), scalar $l->{vnlist_labels}->@* if $l->{vnlist_labels} && $l->{vnlist_labels}->@*; - abbr title => 'No labels', ' ' if $l->{vnlist_labels} && !$l->{vnlist_labels}->@*; - end 'td'; - } - td class => 'tc2'; - $_ ne 'oth' && cssicon $_, $PLATFORM{$_} - for (sort @{$l->{c_platforms}}); - end; - td class => 'tc3'; - cssicon "lang $_", $LANGUAGE{$_} - for (reverse sort @{$l->{c_languages}}); - end; - td class => 'tc4'; - lit fmtdatestr $l->{c_released}; - end; - td class => 'tc5', sprintf '%.2f', ($l->{c_popularity}||0)*100; - td class => 'tc6'; - txt sprintf '%.2f', ($l->{c_rating}||0)/10; - b class => 'grayedout', sprintf ' (%d)', $l->{c_votecount}; - end; - end 'tr'; - }, - ); -} - - -1; - diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm deleted file mode 100644 index 03b1bd28..00000000 --- a/lib/VNDB/Util/CommonHTML.pm +++ /dev/null @@ -1,304 +0,0 @@ - -package VNDB::Util::CommonHTML; - -use strict; -use warnings; -use TUWF ':html', 'xml_escape', 'html_escape'; -use Exporter 'import'; -use Algorithm::Diff::XS 'compact_diff'; -use Encode 'encode_utf8', 'decode_utf8'; -use VNDB::Func; -use POSIX 'ceil'; - -our @EXPORT = qw| - htmlMainTabs htmlDenied htmlHiddenMessage htmlRevision - htmlEditMessage htmlItemMessage htmlVoteStats htmlSearchBox -|; - - -# generates the "main tabs". These are the commonly used tabs for -# 'objects', i.e. VN/producer/release entries and users -# Arguments: u/v/r/p/g/i/c/d, object, currently selected item (empty=main) -sub htmlMainTabs { - my($self, $type, $obj, $sel) = @_; - $obj->{entry_hidden} = $obj->{hidden}; - $obj->{entry_locked} = $obj->{locked}; - VNWeb::HTML::_maintabs_({ type => $type, dbobj => $obj, tab => $sel||''}); -} - - -# generates a full error page, including header and footer -sub htmlDenied { shift->resDenied } - - -# Generates message saying that the current item has been deleted, -# Arguments: [pvrc], obj -# Returns 1 if the use doesn't have access to the page, 0 otherwise -sub htmlHiddenMessage { - my($self, $type, $obj) = @_; - return 0 if !$obj->{hidden}; - my $board = $type =~ /[csd]/ ? 'db' : $type eq 'r' ? 'v'.$obj->{vn}[0]{vid} : $type.$obj->{id}; - # fetch edit summary (not present in $obj, requires the db*GetRev() methods) - my $editsum = $type eq 'v' ? $self->dbVNGetRev(id => $obj->{id})->[0]{comments} - : $type eq 'r' ? $self->dbReleaseGetRev(id => $obj->{id})->[0]{comments} - : $type eq 'c' ? $self->dbCharGetRev(id => $obj->{id})->[0]{comments} - : $self->dbProducerGetRev(id => $obj->{id})->[0]{comments}; - div class => 'mainbox'; - h1 $obj->{title}||$obj->{name}; - div class => 'warning'; - h2 'Item deleted'; - p; - lit 'This item has been deleted from the database. File a request on the <a href="/t/'.$board.'">discussion board</a> to undelete this page.'; - br; br; - lit bb2html $editsum; - end; - end; - end 'div'; - return $self->htmlFooter() || 1 if !$self->authCan('dbmod'); - return 0; -} - - -# Shows a revision, including diff if there is a previous revision. -# Arguments: v|p|r|c|d, old revision, new revision, @fields -# Where @fields is a list of fields as arrayrefs with: -# [ shortname, displayname, %options ], -# Where %options: -# diff => 1/0/regex, whether to show a diff on this field, and what to split it with (1 = character-level diff) -# short_diff=> 1/0, when set, cut off long context in diffs -# serialize => coderef, should convert the field into a readable string, no HTML allowed -# htmlize => same as serialize, but HTML is allowed and this can't be diff'ed -# split => coderef, should return an array of HTML strings that can be diff'ed. (implies diff => 1) -# join => used in combination with split, specifies the string used for joining the HTML strings -sub htmlRevision { - my($self, $type, $old, $new, @fields) = @_; - div class => 'mainbox revision'; - h1 "Revision $new->{rev}"; - - # previous/next revision links - a class => 'prev', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}-1), '<- earlier revision' if $new->{rev} > 1; - a class => 'next', href => sprintf('/%s%d.%d', $type, $new->{id}, $new->{rev}+1), 'later revision ->' if !$new->{lastrev}; - p class => 'center'; - a href => "/$type$new->{id}", "$type$new->{id}"; - end; - - # no previous revision, just show info about the revision itself - if(!$old) { - div class => 'rev'; - revheader($self, $type, $new); - br; - b 'Edit summary'; - br; br; - lit bb2html($new->{comments})||'-'; - end; - } - - # otherwise, compare the two revisions - else { - table class => 'stripe'; - thead; - Tr; - td; lit ' '; end; - td; revheader($self, $type, $old); end; - td; revheader($self, $type, $new); end; - end; - Tr; - td; lit ' '; end; - td colspan => 2; - b "Edit summary of revision $new->{rev}:"; - br; br; - lit bb2html($new->{comments})||'-'; - end; - end; - end; - revdiff($type, $old, $new, @$_) for ( - [ ihid => 'Deleted', serialize => sub { $_[0] ? 'Yes' : 'No' } ], - [ ilock => 'Locked', serialize => sub { $_[0] ? 'Yes' : 'No' } ], - @fields - ); - end 'table'; - } - end 'div'; -} - -sub revheader { # type, obj - my($self, $type, $obj) = @_; - b "Revision $obj->{rev}"; - txt ' ('; - a href => "/$type$obj->{id}.$obj->{rev}/edit", 'revert to'; - if($obj->{user_id} && $self->authCan('board')) { - lit ' / '; - a href => "/t/u$obj->{user_id}/new?title=Regarding%20$type$obj->{id}.$obj->{rev}", 'msg user'; - } - txt ')'; - br; - txt 'By '; - VNWeb::HTML::user_($obj); - txt ' on '; - txt fmtdate $obj->{added}, 'full'; -} - -sub revdiff { - my($type, $old, $new, $short, $display, %o) = @_; - - $o{serialize} ||= $o{htmlize}; - $o{diff} = 1 if $o{split}; - $o{join} ||= ''; - - my $ser1 = $o{serialize} ? $o{serialize}->($old->{$short}, $old) : $old->{$short}; - my $ser2 = $o{serialize} ? $o{serialize}->($new->{$short}, $new) : $new->{$short}; - return if $ser1 eq $ser2; - - if($o{diff} && $ser1 && $ser2) { - my $sep = ref $o{diff} ? qr/($o{diff})/ : qr//; - my @ser1 = map encode_utf8($_), $o{split} ? $o{split}->($ser1) : map html_escape($_), split $sep, $ser1; - my @ser2 = map encode_utf8($_), $o{split} ? $o{split}->($ser2) : map html_escape($_), split $sep, $ser2; - return if $o{split} && $#ser1 == $#ser2 && !grep $ser1[$_] ne $ser2[$_], 0..$#ser1; - - $ser1 = $ser2 = ''; - my @d = compact_diff(\@ser1, \@ser2); - my $lastchunk = int (($#d-2)/2); - for my $i (0..$lastchunk) { - # $i % 2 == 0 -> equal, otherwise it's different - my $a = join($o{join}, @ser1[ $d[$i*2] .. $d[$i*2+2]-1 ]); - my $b = join($o{join}, @ser2[ $d[$i*2+1] .. $d[$i*2+3]-1 ]); - # Reduce context if we have too much - if($o{short_diff} && $i % 2 == 0 && length($a) > 300) { - my $sep = '<b class="standout"><...></b>'; - my $ctx = 100; - $a = $i == 0 ? $sep.'<br>'.substr $a, -$ctx : - $i == $lastchunk ? substr($a, 0, $ctx).'<br>'.$sep : - substr($a, 0, $ctx)."<br><br>$sep<br><br>".substr($a, -$ctx); - $b = $a; - } - $ser1 .= ($ser1?$o{join}:'').($i % 2 ? qq|<b class="diff_del">$a</b>| : $a) if $a ne ''; - $ser2 .= ($ser2?$o{join}:'').($i % 2 ? qq|<b class="diff_add">$b</b>| : $b) if $b ne ''; - } - $ser1 = decode_utf8($ser1); - $ser2 = decode_utf8($ser2); - } elsif(!$o{htmlize}) { - $ser1 = html_escape $ser1; - $ser2 = html_escape $ser2; - } - - $ser1 = '[empty]' if !$ser1 && $ser1 ne '0'; - $ser2 = '[empty]' if !$ser2 && $ser2 ne '0'; - - Tr; - td $display; - td class => 'tcval'; lit $ser1; end; - td class => 'tcval'; lit $ser2; end; - end; -} - - -# Generates a generic message to show as the header of the edit forms -# Arguments: v/r/p, obj, title, copy -sub htmlEditMessage { - shift; VNWeb::HTML::editmsg_(@_); -} - - -# Generates a small message when the user can't edit the item, -# or the item is locked. -# Arguments: v/r/p/c, obj -sub htmlItemMessage { - my($self, $type, $obj) = @_; - # $type isn't being used at all... oh well. - - if($obj->{locked}) { - p class => 'locked', 'Locked for editing'; - } elsif($self->authInfo->{id} && !$self->authCan('edit')) { - p class => 'locked', 'You are not allowed to edit this page'; - } -} - - -# generates two tables, one with a vote graph, other with recent votes -# Only supports $type eq 'v' now. -sub htmlVoteStats { - my($self, $type, $obj, $stats) = @_; - - my($max, $count, $total) = (0, 0, 0); - for (0..$#$stats) { - $max = $stats->[$_][0] if $stats->[$_][0] > $max; - $count += $stats->[$_][0]; - $total += $stats->[$_][1]; - } - div class => 'votestats'; - table class => 'votegraph'; - thead; Tr; - td colspan => 2, 'Vote stats'; - end; end; - tfoot; Tr; - td colspan => 2, sprintf '%d vote%s total, average %.2f%s', $count, $count == 1 ? '' : 's', $total/$count/10, - $type eq 'v' ? ' ('.fmtrating(ceil($total/$count/10-1)||1).')' : ''; - end; end; - for (reverse 0..$#$stats) { - Tr; - td class => 'number', $_+1; - td class => 'graph'; - div style => 'width: '.($stats->[$_][0]/$max*250).'px', ' '; - txt $stats->[$_][0]; - end; - end; - } - end 'table'; - - my $recent = $self->dbAlli(' - SELECT uv.vote,', VNWeb::DB::sql_totime('uv.vote_date '), 'as date, ', VNWeb::DB::sql_user(), ' - , NOT EXISTS(SELECT 1 FROM ulist_vns_labels uvl JOIN ulist_labels ul ON ul.uid = uvl.uid AND ul.id = uvl.lbl WHERE uvl.uid = uv.uid AND uvl.vid = uv.vid AND NOT ul.private) AS hide_list - FROM ulist_vns uv - JOIN users u ON u.id = uv.uid - WHERE uv.vid =', \$obj->{id}, 'AND uv.vote IS NOT NULL - AND NOT EXISTS(SELECT 1 FROM users u WHERE u.id = uv.uid AND u.ign_votes) - ORDER BY uv.vote_date DESC - LIMIT', \8 - ); - - if(@$recent) { - table class => 'recentvotes stripe'; - thead; Tr; - td colspan => 3; - txt 'Recent votes'; - b; - txt '('; - a href => "/$type$obj->{id}/votes", 'show all'; - txt ')'; - end; - end; - end; end; - for (@$recent) { - Tr; - td; - if($_->{hide_list}) { - b class => 'grayedout', 'hidden'; - } else { - VNWeb::HTML::user_($_); - } - end; - td fmtvote $_->{vote}; - td fmtdate $_->{date}; - end; - } - end 'table'; - } - - clearfloat; - if($type eq 'v' && $obj->{c_votecount}) { - div; - h3 'Ranking'; - p sprintf 'Popularity: ranked #%d with a score of %.2f', $obj->{p_ranking}, ($obj->{c_popularity}||0)*100; - p sprintf 'Bayesian rating: ranked #%d with a rating of %.2f', $obj->{r_ranking}, $obj->{c_rating}/10; - end; - } - end 'div'; -} - - -sub htmlSearchBox { - shift; VNWeb::HTML::searchbox_(@_); -} - - -1; diff --git a/lib/VNDB/Util/FormHTML.pm b/lib/VNDB/Util/FormHTML.pm deleted file mode 100644 index 85b7fab9..00000000 --- a/lib/VNDB/Util/FormHTML.pm +++ /dev/null @@ -1,282 +0,0 @@ - -package VNDB::Util::FormHTML; - -use strict; -use warnings; -use TUWF ':html'; -use Exporter 'import'; -use POSIX 'strftime'; -use VNDB::Func; - -our @EXPORT = qw| htmlFormError htmlFormPart htmlForm |; - - -# Displays friendly error message when form validation failed -# Argument is the return value of formValidate, and an optional -# argument indicating whether we should create a special mainbox -# for the errors. -sub htmlFormError { - my($self, $frm, $mainbox) = @_; - return if !$frm->{_err}; - if($mainbox) { - div class => 'mainbox'; - h1 'Error'; - } - div class => 'warning'; - h2 'Form could not be sent:'; - ul; - for my $e (@{$frm->{_err}}) { - if(!ref $e) { - li $e; - next; - } - if(ref $e eq 'SCALAR') { - li; lit $$e; end; - next; - } - my($field, $type, $rule) = @$e; - ($type, $rule) = ('template', 'editsum') if $type eq 'required' && $field eq 'editsum'; - - li "$field is a required field" if $type eq 'required';; - li "$field: minimum number of values is $rule" if $type eq 'mincount'; - li "$field: maximum number of values is $rule" if $type eq 'maxcount'; - li "$field: should have at least $rule characters" if $type eq 'minlength'; - li "$field: only $rule characters allowed" if $type eq 'maxlength'; - li "$field must be one of the following: ".join(', ', @$rule) if $type eq 'enum'; - li $rule->[1] if $type eq 'func' || $type eq 'regex'; - if($type eq 'template') { - li "$field: Invalid number" if $rule eq 'int' || $rule eq 'num' || $rule eq 'uint' || $rule eq 'page' || $rule eq 'id'; - li "$field: Invalid URL" if $rule eq 'weburl'; - li "$field: only ASCII characters allowed" if $rule eq 'ascii'; - li "Invalid email address" if $rule eq 'email'; - li "$field may only contain lowercase alphanumeric characters and a hyphen" if $rule eq 'uname'; - li 'Invalid JAN/UPC/EAN' if $rule eq 'gtin'; - li "$field: Malformed data or invalid input" if $rule eq 'json'; - li 'Invalid release date' if $rule eq 'rdate'; - li 'Invalid Wikidata ID' if $rule eq 'wikidata'; - if($rule eq 'editsum') { - li; lit 'Please read <a href="/d5#4">the guidelines</a> on how to use the edit summary.'; end; - } - } - } - end; - end 'div'; - end if $mainbox; -} - - -# Generates a form part. -# A form part is a arrayref, with the first element being the type of the part, -# and all other elements forming a hash with options specific to that type. -# Type Options -# hidden short, (value) -# json short, (value) # Same as hidden, but value is passed through json_encode() -# input short, name, (value, allow0, width, pre, post) -# passwd short, name -# static content, (label, nolabel) -# check name, short, (value) -# select name, short, options, (width, multi, size) -# radio name, short, options -# text name, short, (rows, cols) -# date name, short -# part title -sub htmlFormPart { - my($self, $frm, $fp) = @_; - my($type, %o) = @$fp; - local $_ = $type; - - if(/hidden/ || /json/) { - Tr class => 'hidden'; - td colspan => 2; - my $val = $o{value}||$frm->{$o{short}}; - input type => 'hidden', id => $o{short}, name => $o{short}, value => /json/ ? json_encode($val||[]) : $val||''; - end; - end; - return - } - - if(/part/) { - Tr class => 'newpart'; - td colspan => 2, $o{title}; - end; - return; - } - - if(/check/) { - Tr class => 'newfield'; - td class => 'label'; - lit ' '; - end; - td class => 'field'; - input type => 'checkbox', name => $o{short}, id => $o{short}, tabindex => 10, - value => $o{value}||1, ($frm->{$o{short}}||0) eq ($o{value}||1) ? ( checked => 'checked' ) : (); - label for => $o{short}; - lit $o{name}; - end; - end; - end; - return; - } - - Tr $o{name}||$o{label} ? (class => 'newfield') : (); - if(!$o{nolabel}) { - td class => 'label'; - if($o{short} && $o{name}) { - label for => $o{short}; - lit $o{name}; - end; - } elsif($o{label}) { - txt $o{label}; - } else { - lit ' '; - } - end; - } - td class => 'field', $o{nolabel} ? (colspan => 2) : (); - if(/input/) { - lit $o{pre} if $o{pre}; - input type => 'text', class => 'text', name => $o{short}, id => $o{short}, tabindex => 10, - value => $o{value} // ($o{allow0} ? $frm->{$o{short}}//'' : $frm->{$o{short}}||''), $o{width} ? (style => "width: $o{width}px") : (); - lit $o{post} if $o{post}; - } - if(/passwd/) { - input type => 'password', class => 'text', name => $o{short}, id => $o{short}, tabindex => 10, - value => $frm->{$o{short}}||''; - } - if(/static/) { - lit ref $o{content} eq 'CODE' ? $o{content}->($self, \%o) : $o{content}; - } - if(/select/) { - my $l=''; - Select name => $o{short}, id => $o{short}, tabindex => 10, - $o{width} ? (style => "width: $o{width}px") : (), $o{multi} ? (multiple => 'multiple', size => $o{size}||5) : (); - for my $p (@{$o{options}}) { - if($p->[2] && $l ne $p->[2]) { - end if $l; - $l = $p->[2]; - optgroup label => $l; - } - my $sel = defined $frm->{$o{short}} && ($frm->{$o{short}} eq $p->[0] || ref($frm->{$o{short}}) eq 'ARRAY' && grep $_ eq $p->[0], @{$frm->{$o{short}}}); - option value => $p->[0], $sel ? (selected => 'selected') : (), $p->[1]; - } - end if $l; - end; - } - if(/radio/) { - for my $p (@{$o{options}}) { - input type => 'radio', id => "$o{short}_$p->[0]", name => $o{short}, value => $p->[0], tabindex => 10, - defined $frm->{$o{short}} && $frm->{$o{short}} eq $p->[0] ? (checked => 'checked') : (); - label for => "$o{short}_$p->[0]", $p->[1]; - } - } - if(/date/) { - input type => 'hidden', id => $o{short}, name => $o{short}, value => $frm->{$o{short}}||'', class => 'dateinput'; - } - if(/text/) { - textarea name => $o{short}, id => $o{short}, rows => $o{rows}||5, cols => $o{cols}||60, tabindex => 10, $frm->{$o{short}}||''; - } - end; - end 'tr'; -} - - -# Generates a form, first argument is a hashref with global options, keys: -# frm => the $frm as returned by formValidate, -# action => The location the form should POST to (also used as form id) -# method => post/get -# upload => 1/0, adds an enctype. -# nosubmit => 1/0, hides the submit button -# editsum => 1/0, adds an edit summary field before the submit button -# continue => 2/1/0, replace submit button with continue buttons -# preview => 1/0, add preview button -# noformcode=> 1/0, remove the formcode field -# The other arguments are a list of subforms in the form -# of (subform-name => [form parts]). Each subform is shown as a -# (JavaScript-powered) tab, and has it's own 'mainbox'. This function -# automatically calls htmlFormError and adds a 'formcode' field. -sub htmlForm { - my($self, $options, @subs) = @_; - form action => '/nospam?'.$options->{action}, method => $options->{method}||'post', 'accept-charset' => 'utf-8', - $options->{upload} ? (enctype => 'multipart/form-data') : (); - - if(!$options->{noformcode}) { - div class => 'hidden'; - input type => 'hidden', name => 'formcode', value => $self->authGetCode($options->{action}); - end; - } - - $self->htmlFormError($options->{frm}, 1); - - # tabs - if(@subs > 2) { - div class => 'maintabs left'; - ul id => 'jt_select'; - for (0..$#subs/2) { - li class => 'left'; - a href => "#$subs[$_*2]", id => "jt_sel_$subs[$_*2]", $subs[$_*2+1][0]; - end; - } - li class => 'left'; - a href => '#all', id => 'jt_sel_all', 'All items'; - end; - end 'ul'; - end 'div'; - } - - # form subs - while(my($short, $parts) = (shift(@subs), shift(@subs))) { - last if !$short || !$parts; - my $name = shift @$parts; - div class => 'mainbox', id => 'jt_box_'.$short; - h1 $name; - fieldset; - legend $name; - table class => 'formtable'; - $self->htmlFormPart($options->{frm}, $_) for @$parts; - end; - end; - end 'div'; - } - - # db mod / edit summary / submit button - if(!$options->{nosubmit}) { - div class => 'mainbox'; - fieldset class => 'submit'; - if($options->{editsum}) { - # hidden / locked checkbox - if($self->authCan('dbmod')) { - input type => 'checkbox', name => 'ihid', id => 'ihid', value => 1, - tabindex => 10, $options->{frm}{ihid} ? (checked => 'checked') : (); - label for => 'ihid', 'Deleted'; - input type => 'checkbox', name => 'ilock', id => 'ilock', value => 1, - tabindex => 10, $options->{frm}{ilock} ? (checked => 'checked') : (); - label for => 'ilock', 'Locked'; - br; txt 'Note: edit summary of the last edit should indicate the reason for the deletion.'; br; - } - - # edit summary - h2; - txt 'Edit summary'; - b class => 'standout', ' (English please!)'; - end; - textarea name => 'editsum', id => 'editsum', rows => 4, cols => 50, tabindex => 10, $options->{frm}{editsum}||''; - br; - } - if(!$options->{continue}) { - input type => 'submit', value => 'Submit', class => 'submit', tabindex => 10; - } else { - input type => 'submit', value => 'Continue', class => 'submit', tabindex => 10; - input type => 'submit', name => 'continue_ign', value => 'Continue and ignore duplicates', - class => 'submit', style => 'width: auto', tabindex => 10 if $options->{continue} == 2; - } - input type => 'submit', value => 'Preview', id => 'preview', name => 'preview', class => 'submit', tabindex => 10 if $options->{preview}; - end; - end 'div'; - } - - end 'form'; -} - - -1; - diff --git a/lib/VNDB/Util/LayoutHTML.pm b/lib/VNDB/Util/LayoutHTML.pm deleted file mode 100644 index 6bafbeda..00000000 --- a/lib/VNDB/Util/LayoutHTML.pm +++ /dev/null @@ -1,43 +0,0 @@ - -package VNDB::Util::LayoutHTML; - -use strict; -use warnings; -use TUWF ':html'; -use VNWeb::HTML; -use Exporter 'import'; - -our @EXPORT = qw|htmlHeader htmlFooter|; - -sub htmlHeader { # %options->{ title, noindex, search, feeds, metadata } - my($self, %o) = @_; - %VNWeb::HTML::pagevars = (); - - $o{og} = $o{metadata} ? +{ map +(s/og://r, $o{metadata}{$_}), keys $o{metadata}->%* } : undef; - $o{index} = !$o{noindex}; - - html lang => 'en'; - head sub { VNWeb::HTML::_head_(\%o) }; - body; - div id => 'bgright', ' '; - div id => 'header', sub { h1 sub { a href => '/', 'the visual novel database' } }; - div id => 'menulist', sub { VNWeb::HTML::_menu_(\%o) }; - div id => 'maincontent'; -} - - -sub htmlFooter { # %options => { pref_code => 1 } - my($self, %o) = @_; - div id => 'footer', sub { VNWeb::HTML::_footer_ }; - end 'div'; # maincontent - - # Abuse an empty noscript tag for the formcode to update a preference setting, if the page requires one. - noscript id => 'pref_code', title => $self->authGetCode('/xml/prefs.xml'), '' - if $o{pref_code} && $self->authInfo->{id}; - script type => 'text/javascript', src => $self->{url_static}.'/f/vndb.js?'.$self->{version}, ''; - VNWeb::HTML::v2rwjs_() if $o{v2rwjs}; - end 'body'; - end 'html'; -} - -1; diff --git a/lib/VNDB/Util/Misc.pm b/lib/VNDB/Util/Misc.pm deleted file mode 100644 index b314bf08..00000000 --- a/lib/VNDB/Util/Misc.pm +++ /dev/null @@ -1,122 +0,0 @@ - -package VNDB::Util::Misc; - -use strict; -use warnings; -use Exporter 'import'; -use TUWF ':html'; -use VNDB::Func; -use VNDB::Types; -use VNDB::BBCode; - -our @EXPORT = qw|filFetchDB filCompat bbSubstLinks|; - - -our %filfields = ( - vn => [qw|date_before date_after released length hasani hasshot tag_inc tag_exc taginc tagexc tagspoil lang olang plat staff_inc staff_exc ul_notblack ul_onwish ul_voted ul_onlist|], - release => [qw|type patch freeware doujin uncensored date_before date_after released minage lang olang resolution plat prod_inc prod_exc med voiced ani_story ani_ero engine|], - char => [qw|gender bloodt bust_min bust_max waist_min waist_max hip_min hip_max height_min height_max va_inc va_exc weight_min weight_max cup_min cup_max trait_inc trait_exc tagspoil role|], - staff => [qw|gender role truename lang|], -); - - -# Arguments: -# type ('vn', 'release' or 'char'), -# filter overwrite (string or undef), -# when defined, these filters will be used instead of the preferences, -# must point to a variable, will be modified in-place with the actually used filters -# options to pass to db*Get() before the filters (hashref or undef) -# these options can be overwritten by the filters or the next option -# options to pass to db*Get() after the filters (hashref or undef) -# these options overwrite all other options (pre-options and filters) - -sub filFetchDB { - my($self, $type, $overwrite, $pre, $post) = @_; - $pre = {} if !$pre; - $post = {} if !$post; - my $dbfunc = $self->can($type eq 'vn' ? 'dbVNGet' : $type eq 'release' ? 'dbReleaseGet' : $type eq 'char' ? 'dbCharGet' : 'dbStaffGet'); - my $prefname = 'filter_'.$type; - my $pref = $self->authPref($prefname); - - my $filters = fil_parse $overwrite // $pref, @{$filfields{$type}}; - - # compatibility - my $compat = $self->filCompat($type, $filters); - $self->authPref($prefname => fil_serialize $filters) if $compat && !defined $overwrite; - - # write the definite filter string in $overwrite - $_[2] = fil_serialize({map +( - exists($post->{$_}) ? ($_ => $post->{$_}) : - exists($filters->{$_}) ? ($_ => $filters->{$_}) : - exists($pre->{$_}) ? ($_ => $pre->{$_}) : (), - ), @{$filfields{$type}}}) if defined $overwrite; - - return $dbfunc->($self, %$pre, %$filters, %$post) if defined $overwrite or !keys %$filters;; - - # since incorrect filters can throw a database error, we have to special-case - # filters that originate from a preference setting, so that in case these are - # the cause of an error, they are removed. Not doing this will result in VNDB - # throwing 500's even for non-browse pages. We have to do some low-level - # PostgreSQL stuff with savepoints to ensure that an error won't affect our - # existing transaction. - my $dbh = $self->dbh; - $dbh->pg_savepoint('filter'); - my($r, $np); - my $OK = eval { - ($r, $np) = $dbfunc->($self, %$pre, %$filters, %$post); - 1; - }; - $dbh->pg_rollback_to('filter') if !$OK; - $dbh->pg_release('filter'); - - # error occured, let's try again without filters. if that succeeds we know - # it's the fault of the filter preference, and we should remove it. - if(!$OK) { - ($r, $np) = $dbfunc->($self, %$pre, %$post); - # if we're here, it means the previous function didn't die() (duh!) - $self->authPref($prefname => ''); - warn sprintf "Reset filter preference for userid %d. Old: %s\n", $self->authInfo->{id}||0, $pref; - } - return wantarray ? ($r, $np) : $r; -} - - -# Compatibility with old filters. Modifies the filter in-place and returns the number of changes made. -sub filCompat { - my($self, $type, $fil) = @_; - my $mod = 0; - - # older tag specification (by name rather than ID) - if($type eq 'vn' && ($fil->{taginc} || $fil->{tagexc})) { - my $tagfind = sub { - return map { - my $i = $self->dbTagGet(name => $_)->[0]; - $i && $i->{searchable} ? $i->{id} : (); - } grep $_, ref $_[0] ? @{$_[0]} : ($_[0]||'') - }; - $fil->{tag_inc} //= [ $tagfind->(delete $fil->{taginc}) ] if $fil->{taginc}; - $fil->{tag_exc} //= [ $tagfind->(delete $fil->{tagexc}) ] if $fil->{tagexc}; - $mod++; - } - - if($type eq 'release' && $fil->{resolution}) { - $fil->{resolution} = [ map { - if(/^[0-9]+$/) { - $mod++; - (keys %RESOLUTION)[$_] || 'unknown' - } else { $_ } - } ref $fil->{resolution} ? @{$fil->{resolution}} : $fil->{resolution} ]; - } - - $mod; -} - - - -sub bbSubstLinks { - shift; bb_subst_links @_; -} - - -1; - diff --git a/lib/VNDB/Util/ValidateTemplates.pm b/lib/VNDB/Util/ValidateTemplates.pm deleted file mode 100644 index 7966b319..00000000 --- a/lib/VNDB/Util/ValidateTemplates.pm +++ /dev/null @@ -1,110 +0,0 @@ -# This module implements various templates for formValidate() - -package VNDB::Util::ValidateTemplates; - -use strict; -use warnings; -use TUWF 'kv_validate'; -use VNDB::Func 'json_decode'; -use VNDBUtil 'gtintype'; -use Time::Local 'timegm'; - - -TUWF::set( - validate_templates => { - id => { template => 'uint', max => 1<<40 }, - page => { template => 'uint', max => 1000 }, - uname => { regex => qr/^[a-z0-9-]*$/, func => sub { $_[0] !~ /^-*[a-z][0-9]+-*$/ }, minlength => 2, maxlength => 15 }, - gtin => { func => \>intype }, - editsum => { maxlength => 5000, minlength => 2 }, - json => { func => \&json_validate, inherit => ['json_fields','json_maxitems','json_unique','json_sort'], default => [] }, - rdate => { template => 'uint', min => 0, max => 99999999, func => \&rdate_validate, default => 0 }, - wikidata => { func => \&wikidata_id, default => undef }, - } -); - - -sub wikidata_id { - $_[0] =~ s/^Q//; - $_[0] =~ /^([0-9]{1,9})$/ -} - - -# Figure out if a field is treated as a number in kv_validate(). -sub json_validate_is_num { - my $opts = shift; - return 0 if !$opts->{template}; - return 1 if $opts->{template} eq 'num' || $opts->{template} eq 'int' || $opts->{template} eq 'uint'; - my $t = TUWF::set('validate_templates')->{$opts->{template}}; - return $t && json_validate_is_num($t); -} - - -sub json_validate_sort { - my($sort, $fields, $data) = @_; - - # Figure out which fields need to use number comparison - my %nums; - for my $k (@$sort) { - my $f = (grep $_->{field} eq $k, @$fields)[0]; - $nums{$k}++ if json_validate_is_num($f); - } - - # Sort - return [sort { - for(@$sort) { - my $r = $nums{$_} ? $a->{$_} <=> $b->{$_} : $a->{$_} cmp $b->{$_}; - return $r if $r; - } - 0 - } @$data]; -} - -# Special validation function for simple JSON structures as form fields. It can -# only validate arrays of key-value objects. The key-value objects are then -# validated using kv_validate. -# TODO: json_unique implies json_sort on the same fields? These options tend to be the same. -sub json_validate { - my($val, $opts) = @_; - my $fields = $opts->{json_fields}; - my $maxitems = $opts->{json_maxitems}; - my $unique = $opts->{json_unique}; - my $sort = $opts->{json_sort}; - $unique = [$unique] if $unique && !ref $unique; - $sort = [$sort] if $sort && !ref $sort; - - my $data = eval { json_decode $val }; - $_[0] = $@ ? [] : $data; - return 0 if $@ || ref $data ne 'ARRAY'; - return 0 if defined($maxitems) && @$data > $maxitems; - - my %known_fields = map +($_->{field},1), @$fields; - my %unique; - - for my $i (0..$#$data) { - return 0 if ref $data->[$i] ne 'HASH'; - # Require that all keys are known and have a scalar value. - return 0 if grep !$known_fields{$_} || ref($data->[$i]{$_}), keys %{$data->[$i]}; - $data->[$i] = kv_validate({ field => sub { $data->[$i]{shift()} } }, $TUWF::OBJ->{_TUWF}{validate_templates}, $fields); - return 0 if $data->[$i]{_err}; - return 0 if $unique && $unique{ join '|||', map $data->[$i]{$_}, @$unique }++; - } - - $_[0] = json_validate_sort($sort, $fields, $data) if $sort; - return 1; -} - - -sub rdate_validate { - return 0 if $_[0] ne 0 && $_[0] !~ /^(\d{4})(\d{2})(\d{2})$/; - my($y, $m, $d) = defined $1 ? ($1, $2, $3) : (0,0,0); - - # Normalization ought to be done in JS, but do it here again because we can't trust browsers - ($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 && $d != 99 && !eval { timegm(0, 0, 0, $d, $m-1, $y) }; - return 1; -} |