summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/VNDB/DB/Traits.pm29
-rw-r--r--lib/VNDB/Handler/Traits.pm140
-rw-r--r--lib/VNDB/Util/FormHTML.pm282
-rw-r--r--lib/VNDB/Util/Misc.pm9
-rw-r--r--lib/VNDB/Util/ValidateTemplates.pm96
-rw-r--r--lib/VNWeb/Traits/Edit.pm139
6 files changed, 142 insertions, 553 deletions
diff --git a/lib/VNDB/DB/Traits.pm b/lib/VNDB/DB/Traits.pm
index 019f512f..ac0e81b4 100644
--- a/lib/VNDB/DB/Traits.pm
+++ b/lib/VNDB/DB/Traits.pm
@@ -10,7 +10,7 @@ use strict;
use warnings;
use Exporter 'import';
-our @EXPORT = qw|dbTraitGet dbTraitEdit dbTraitAdd|;
+our @EXPORT = qw|dbTraitGet|;
# Options: id noid search name state searchable applicable what results page sort reverse
@@ -82,32 +82,5 @@ sub dbTraitGet {
}
-# args: trait id, %options->{ columns in the traits table + parents }
-sub dbTraitEdit {
- my($self, $id, %o) = @_;
-
- $self->dbExec('UPDATE traits !H WHERE id = ?', {
- $o{upddate} ? ('added = NOW()' => 1) : (),
- map exists($o{$_}) ? ("\"$_\" = ?" => $o{$_}) : (), qw|name searchable applicable description state alias group order sexual defaultspoil|
- }, $id);
- if($o{parents}) {
- $self->dbExec('DELETE FROM traits_parents WHERE trait = ?', $id);
- $self->dbExec('INSERT INTO traits_parents (trait, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- }
-}
-
-
-# same args as dbTraitEdit, without the first trait id
-# returns the id of the new trait
-sub dbTraitAdd {
- my($self, %o) = @_;
- my $id = $self->dbRow('INSERT INTO traits (name, searchable, applicable, description, state, alias, "group", "order", sexual, defaultspoil, addedby) VALUES (!l, ?) RETURNING id',
- [ map $o{$_}, qw|name searchable applicable description state alias group order sexual defaultspoil| ], $o{addedby}||$self->authInfo->{id}
- )->{id};
- $self->dbExec('INSERT INTO traits_parents (trait, parent) VALUES (?, ?)', $id, $_) for(@{$o{parents}});
- return $id;
-}
-
-
1;
diff --git a/lib/VNDB/Handler/Traits.pm b/lib/VNDB/Handler/Traits.pm
index 3cb8d5f9..3ed6b43c 100644
--- a/lib/VNDB/Handler/Traits.pm
+++ b/lib/VNDB/Handler/Traits.pm
@@ -9,9 +9,6 @@ use VNDB::Func;
TUWF::register(
qr{i([1-9]\d*)}, \&traitpage,
- qr{i([1-9]\d*)/(edit)}, \&traitedit,
- qr{i([1-9]\d*)/(add)}, \&traitedit,
- qr{i/new}, \&traitedit,
qr{i/list}, \&traitlist,
qr{i}, \&traitindex,
qr{xml/traits\.xml}, \&traitxml,
@@ -134,143 +131,6 @@ sub traitpage {
}
-sub traitedit {
- my($self, $trait, $act) = @_;
-
- my($frm, $par);
- if($act && $act eq 'add') {
- $par = $self->dbTraitGet(id => $trait)->[0];
- return $self->resNotFound if !$par;
- $frm->{parents} = $par->{id};
- $trait = undef;
- }
-
- return $self->htmlDenied if !$self->authCan('edit') || $trait && !$self->authCan('tagmod');
-
- my $t = $trait && $self->dbTraitGet(id => $trait, what => 'parents(1) addedby')->[0];
- return $self->resNotFound if $trait && !$t;
-
- if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode;
- $frm = $self->formValidate(
- { post => 'name', required => 1, maxlength => 250, regex => [ qr/^[^,]+$/, 'A comma is not allowed in trait names' ] },
- { post => 'state', required => 0, default => 0, enum => [ 0..2 ] },
- { post => 'searchable', required => 0, default => 0 },
- { post => 'applicable', required => 0, default => 0 },
- { post => 'sexual', required => 0, default => 0 },
- { post => 'alias', required => 0, maxlength => 1024, default => '', regex => [ qr/^[^,]+$/s, 'No comma allowed in aliases' ] },
- { post => 'description', required => 0, maxlength => 10240, default => '' },
- { post => 'parents', required => !$self->authCan('tagmod'), default => '', regex => [ qr/^(?:$|(?:[1-9]\d*)(?: +[1-9]\d*)*)$/, 'Parent traits must be a space-separated list of trait IDs' ] },
- { post => 'order', required => 0, default => 0, template => 'uint' },
- { post => 'defaultspoil',required => 0, default => 0, enum => [0..2] },
- );
- my @parents = split /[\t ]+/, $frm->{parents};
- my $group = undef;
- if(!$frm->{_err}) {
- for(@parents) {
- my $c = $self->dbTraitGet(id => $_);
- push @{$frm->{_err}}, "Trait '$_' not found" if !@$c;
- $group //= $c->[0]{group}||$c->[0]{id} if @$c;
- }
- }
- if(!$frm->{_err}) {
- my @dups = @{$self->dbTraitGet(name => $frm->{name}, noid => $trait, group => $group)};
- push @dups, @{$self->dbTraitGet(name => $_, noid => $trait, group => $group)} for split /[\t\s]*\n[\t\s]*/, $frm->{alias};
- push @{$frm->{_err}}, \sprintf 'Trait <a href="/i%d">%s</a> already exists within the same group.', $_->{id}, xml_escape $_->{name} for @dups;
- }
-
- if(!$frm->{_err}) {
- if(!$self->authCan('tagmod')) {
- $frm->{state} = 0;
- $frm->{applicable} = $frm->{searchable} = 1;
- }
- my %opts = (
- name => $frm->{name},
- state => $frm->{state},
- description => $frm->{description},
- searchable => $frm->{searchable}?1:0,
- applicable => $frm->{applicable}?1:0,
- sexual => $frm->{sexual}?1:0,
- alias => $frm->{alias},
- order => $frm->{order},
- defaultspoil => $frm->{defaultspoil},
- parents => \@parents,
- group => $group,
- );
- if(!$trait) {
- $trait = $self->dbTraitAdd(%opts);
- } else {
- $self->dbTraitEdit($trait, %opts, upddate => $frm->{state} == 2 && $t->{state} != 2) if $trait;
- _set_childs_group($self, $trait, $group||$trait) if ($group||0) != ($t->{group}||0);
- }
- $self->resRedirect("/i$trait", 'post');
- return;
- }
- }
-
- if($t) {
- $frm->{$_} ||= $t->{$_} for (qw|name searchable applicable sexual description state alias order defaultspoil|);
- $frm->{parents} ||= join ' ', map $_->{id}, @{$t->{parents}};
- }
-
- my $title = $par ? "Add child trait to $par->{name}" : $t ? "Edit trait: $t->{name}" : 'Add new trait';
- $self->htmlHeader(title => $title, noindex => 1);
- $self->htmlMainTabs('i', $par || $t, 'edit') if $t || $par;
-
- if(!$self->authCan('tagmod')) {
- div class => 'mainbox';
- h1 'Requesting new trait';
- div class => 'notice';
- h2 'Your trait must be approved';
- p;
- lit 'Because all traits have to be approved by moderators, it can take a while before your trait will show up in the listings or can be used on character entries.';
- end;
- end;
- end;
- }
-
- $self->htmlForm({ frm => $frm, action => $par ? "/i$par->{id}/add" : $t ? "/i$trait/edit" : '/i/new' }, 'traitedit' => [ $title,
- [ input => short => 'name', name => 'Primary name' ],
- $self->authCan('tagmod') ? (
- $t ?
- [ static => label => 'Added by', content => sub { VNWeb::HTML::user_($t); '' } ] : (),
- [ select => short => 'state', name => 'State', options => [
- [0,'Awaiting moderation'], [1,'Deleted/hidden'], [2,'Approved'] ] ],
- [ checkbox => short => 'searchable', name => 'Searchable (people can use this trait to filter characters)' ],
- [ checkbox => short => 'applicable', name => 'Applicable (people can apply this trait to characters)' ],
- ) : (),
- [ checkbox => short => 'sexual', name => 'Indicates sexual content' ],
- [ textarea => short => 'alias', name => "Aliases\n(Separated by newlines)", cols => 30, rows => 4 ],
- [ textarea => short => 'description', name => 'Description' ],
- [ select => short => 'defaultspoil', name => 'Default spoiler level', options => [ map [$_, fmtspoil $_], 0..2 ] ],
- [ static => content => 'This is the spoiler level that will be selected by default when adding this trait to a character.' ],
- [ input => short => 'parents', name => 'Parent traits' ],
- [ static => content => 'List of trait IDs to be used as parent for this trait, separated by a space.' ],
- $self->authCan('tagmod') ? (
- [ input => short => 'order', name => 'Group number', width => 50, post => ' (Only used if this trait is a group. Used for ordering, lowest first)' ],
- ) : (),
- ]);
-
- $self->htmlFooter;
-}
-
-# recursively edit all child traits and set the group field
-sub _set_childs_group {
- my($self, $trait, $group) = @_;
- my %done;
-
- my $e;
- $e = sub {
- my $l = shift;
- for (@$l) {
- $self->dbTraitEdit($_->{id}, group => $group) if !$done{$_->{id}}++;
- $e->($_->{sub}) if $_->{sub};
- }
- };
- $e->($self->dbTTTree(trait => $trait, 25));
-}
-
-
sub traitlist {
my $self = shift;
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 '&#xa0;';
- 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 '&#xa0;';
- }
- 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/Misc.pm b/lib/VNDB/Util/Misc.pm
index 0423e35b..6342c0c5 100644
--- a/lib/VNDB/Util/Misc.pm
+++ b/lib/VNDB/Util/Misc.pm
@@ -7,9 +7,8 @@ use Exporter 'import';
use TUWF ':html';
use VNDB::Func;
use VNDB::Types;
-use VNDB::BBCode;
-our @EXPORT = qw|filFetchDB filCompat bbSubstLinks|;
+our @EXPORT = qw|filFetchDB filCompat|;
our %filfields = (
@@ -90,11 +89,5 @@ sub filCompat {
}
-
-sub bbSubstLinks {
- shift; bb_subst_links @_;
-}
-
-
1;
diff --git a/lib/VNDB/Util/ValidateTemplates.pm b/lib/VNDB/Util/ValidateTemplates.pm
index 7966b319..e28abcb2 100644
--- a/lib/VNDB/Util/ValidateTemplates.pm
+++ b/lib/VNDB/Util/ValidateTemplates.pm
@@ -4,107 +4,13 @@ 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 => \&gtintype },
- 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;
-}
+1;
diff --git a/lib/VNWeb/Traits/Edit.pm b/lib/VNWeb/Traits/Edit.pm
new file mode 100644
index 00000000..c3299ad5
--- /dev/null
+++ b/lib/VNWeb/Traits/Edit.pm
@@ -0,0 +1,139 @@
+package VNWeb::Traits::Edit;
+
+use VNWeb::Prelude;
+
+my $FORM = {
+ id => { required => 0, id => 1 },
+ name => { maxlength => 250, regex => qr/^[^,\r\n]+$/ },
+ alias => { maxlength => 1024, regex => qr/^[^,]+$/, required => 0, default => '' },
+ state => { uint => 1, range => [0,2] },
+ sexual => { anybool => 1 },
+ description => { maxlength => 10240 },
+ searchable => { anybool => 1, default => 1 },
+ applicable => { anybool => 1, default => 1 },
+ defaultspoil => { uint => 1, range => [0,2] },
+ parents => { aoh => {
+ id => { id => 1 },
+ name => { _when => 'out' },
+ group => { _when => 'out', required => 0 },
+ } },
+ order => { uint => 1 },
+
+ addedby => { _when => 'out' },
+ can_mod => { _when => 'out', anybool => 1 },
+};
+
+my $FORM_OUT = form_compile out => $FORM;
+my $FORM_IN = form_compile in => $FORM;
+
+
+TUWF::get qr{/$RE{iid}/edit}, sub {
+ my $e = tuwf->dbRowi('
+ SELECT i.id, i.name, i.alias, i.description, i.state, i.sexual, i.defaultspoil, i.searchable, i.applicable, i.order
+ , ', sql_user('u', 'addedby_'), '
+ FROM traits i
+ LEFT JOIN users u ON i.addedby = u.id
+ WHERE i.id =', \tuwf->capture('id')
+ );
+ return tuwf->resNotFound if !$e->{id};
+
+ enrich parents => id => trait => '
+ SELECT ip.trait, i.id, i.name, g.name AS group
+ FROM traits_parents ip JOIN traits i ON i.id = ip.parent LEFT JOIN traits g ON g.id = i.group WHERE ip.trait IN', $e;
+
+ return tuwf->resDenied if !can_edit i => $e;
+
+ $e->{addedby} = xml_string sub { user_ $e, 'addedby_'; };
+ $e->{can_mod} = auth->permTagmod;
+
+ framework_ title => "Edit $e->{name}", type => 'i', dbobj => $e, tab => 'edit', sub {
+ elm_ TraitEdit => $FORM_OUT, $e;
+ };
+};
+
+
+TUWF::get qr{/(?:$RE{iid}/add|i/new)}, sub {
+ my $id = tuwf->capture('id');
+ my $i = tuwf->dbRowi('SELECT i.id, i.name, g.name AS "group", i.sexual FROM traits i LEFT JOIN traits g ON g.id = i."group" WHERE i.id =', \$id);
+ return tuwf->resDenied if !can_edit i => {};
+ return tuwf->resNotFound if $id && !$i->{id};
+
+ my $e = elm_empty($FORM_OUT);
+ $e->{can_mod} = auth->permTagmod;
+ if($id) {
+ $e->{parents} = [$i];
+ $e->{sexual} = $i->{sexual};
+ }
+
+ framework_ title => 'Submit a new trait', sub {
+ div_ class => 'mainbox', sub {
+ h1_ 'Requesting new trait';
+ div_ class => 'notice', sub {
+ h2_ 'Your trait must be approved';
+ p_ sub {
+ txt_ 'All traits have to be approved by a moderator, so it can take a while before it will show up in the trait list.';
+ br_;
+ br_;
+ txt_ 'Make sure you\'ve read the '; a_ href => '/d10', 'guidelines'; txt_ ' to increase the chances of getting your trait accepted.';
+ }
+ }
+ } if !auth->permTagmod;
+ elm_ TraitEdit => $FORM_OUT, $e;
+ };
+};
+
+
+elm_api TraitEdit => $FORM_OUT, $FORM_IN, sub {
+ my($data) = @_;
+ my $id = delete $data->{id};
+ my $e = !$id ? {} : tuwf->dbRowi('SELECT id, addedby FROM traits WHERE id =', \$id);
+ return tuwf->resNotFound if $id && !$e->{id};
+ return elm_Unauth if !can_edit i => $e;
+
+
+ $data->{addedby} = $e->{addedby} // auth->uid;
+ if(!auth->permTagmod) {
+ $data->{state} = 0;
+ $data->{applicable} = $data->{searchable} = 1;
+ }
+ $data->{order} = 0 if $data->{parents}->@*;
+
+ # Make sure parent IDs exists and are not a child trait of the current trait (i.e. don't allow cycles)
+ my @parents = map $_->{id}, $data->{parents}->@*;
+ validate_dbid sub {
+ 'SELECT id FROM traits WHERE', sql_and
+ $id ? sql 'id NOT IN(WITH RECURSIVE t(id) AS (SELECT', \$id, '::int UNION SELECT trait FROM traits_parents tp JOIN t ON t.id = tp.parent) SELECT id FROM t)' : (),
+ sql 'id IN', $_[0]
+ }, @parents;
+
+ # It's technically possible for a trait to be in multiple groups, but the DB schema doesn't support that so let's get the group from the first parent (sorted by id).
+ $data->{group} = tuwf->dbVali('SELECT coalesce("group",id) FROM traits WHERE id IN', \@parents, 'ORDER BY id LIMIT 1');
+
+ # (Ideally this checks all groups that this trait applies in, but that's more annoying to implement)
+ my $re = '[\t\s]*\n[\t\s]*';
+ my $dups = tuwf->dbAlli('
+ SELECT n.id, n.name
+ FROM (SELECT id, name FROM traits UNION ALL SELECT id, s FROM traits, regexp_split_to_table(alias, ', \$re, ') a(s) WHERE s <> \'\') n(id,name)
+ JOIN traits t ON n.id = t.id
+ WHERE ', sql_and(
+ $id ? sql 'n.id <>', \$id : (),
+ sql('t."group" IS NOT DISTINCT FROM', \$data->{group}),
+ sql 'lower(n.name) IN', [ map lc($_), $data->{name}, grep length($_), split /$re/, $data->{alias} ]
+ )
+ );
+ return elm_DupNames $dups if @$dups;
+
+ my %set = map +($_,$data->{$_}), qw/name alias description state addedby sexual defaultspoil searchable applicable order/;
+ $set{'"group"'} = delete $set{group};
+ $set{'"order"'} = delete $set{order};
+ tuwf->dbExeci('UPDATE traits SET', \%set, 'WHERE id =', \$id) if $id;
+ $id = tuwf->dbVali('INSERT INTO traits', \%set, 'RETURNING id') if !$id;
+
+ tuwf->dbExeci('DELETE FROM traits_parents WHERE trait =', \$id);
+ tuwf->dbExeci('INSERT INTO traits_parents (trait,parent) VALUES(', \$id, ',', \$_->{id}, ')') for $data->{parents}->@*;
+
+ auth->audit(undef, 'trait edit', "i$id") if $id; # Since we don't have edit histories for traits yet.
+ elm_Redirect "/i$id";
+};
+
+1;