summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-09-29 14:11:14 +0200
committerYorhel <git@yorhel.nl>2020-09-29 14:11:16 +0200
commit7e4097baaddb3b3cf37343bb204f65beeb8a27f6 (patch)
tree4a8c061ae0f862504ee54da2a7694a7df4d1c657
parent4d021b9a0c9db93b8a9ca710a532c9409dc57391 (diff)
v2rw/TraitEdit: Rewrite trait edit form + cleanup bunch of old code
This was the last form in the old v2 code, so this allowed me to get rid of the old form validation and generation abstractions. The form is mostly a duplicate of the tag editing form, as expected. It's really annoying to have to maintain pretty much duplicate code for tags and traits, but there are just enough differences that the complexity of sharing code or creating a new abstraction outweigh the benefits. :(
-rw-r--r--elm/TraitEdit.elm209
-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
7 files changed, 351 insertions, 553 deletions
diff --git a/elm/TraitEdit.elm b/elm/TraitEdit.elm
new file mode 100644
index 00000000..f7090af1
--- /dev/null
+++ b/elm/TraitEdit.elm
@@ -0,0 +1,209 @@
+module TraitEdit exposing (main)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Browser
+import Browser.Navigation exposing (load)
+import Lib.Html exposing (..)
+import Lib.TextPreview as TP
+import Lib.Api as Api
+import Lib.Util exposing (..)
+import Lib.Autocomplete as A
+import Lib.Ffi as Ffi
+import Gen.Api as GApi
+import Gen.TraitEdit as GTE
+
+
+main : Program GTE.Recv Model Msg
+main = Browser.element
+ { init = \e -> (init e, Cmd.none)
+ , view = view
+ , update = update
+ , subscriptions = always Sub.none
+ }
+
+
+type alias Model =
+ { formstate : Api.State
+ , id : Maybe Int
+ , name : String
+ , alias : String
+ , state : Int
+ , sexual : Bool
+ , description : TP.Model
+ , searchable : Bool
+ , applicable : Bool
+ , defaultspoil : Int
+ , parents : List GTE.RecvParents
+ , parentAdd : A.Model GApi.ApiTraitResult
+ , order : Int
+ , addedby : String
+ , canMod : Bool
+ , dupNames : List GApi.ApiDupNames
+ }
+
+
+init : GTE.Recv -> Model
+init d =
+ { formstate = Api.Normal
+ , id = d.id
+ , name = d.name
+ , alias = d.alias
+ , state = d.state
+ , sexual = d.sexual
+ , description = TP.bbcode d.description
+ , searchable = d.searchable
+ , applicable = d.applicable
+ , defaultspoil = d.defaultspoil
+ , parents = d.parents
+ , parentAdd = A.init ""
+ , order = d.order
+ , addedby = d.addedby
+ , canMod = d.can_mod
+ , dupNames = []
+ }
+
+
+splitAliases : String -> List String
+splitAliases l = String.lines l |> List.map String.trim |> List.filter (\s -> s /= "")
+
+findDup : Model -> String -> List GApi.ApiDupNames
+findDup model a = List.filter (\t -> String.toLower t.name == String.toLower a) model.dupNames
+
+isValid : Model -> Bool
+isValid model = not (List.any (findDup model >> List.isEmpty >> not) (model.name :: splitAliases model.alias))
+
+parentConfig : A.Config Msg GApi.ApiTraitResult
+parentConfig = { wrap = ParentSearch, id = "parentadd", source = A.traitSource }
+
+
+encode : Model -> GTE.Send
+encode m =
+ { id = m.id
+ , name = m.name
+ , alias = m.alias
+ , state = m.state
+ , sexual = m.sexual
+ , description = m.description.data
+ , searchable = m.searchable
+ , applicable = m.applicable
+ , defaultspoil = m.defaultspoil
+ , parents = List.map (\l -> {id=l.id}) m.parents
+ , order = m.order
+ }
+
+
+type Msg
+ = Name String
+ | Alias String
+ | State Int
+ | Searchable Bool
+ | Applicable Bool
+ | Sexual Bool
+ | DefaultSpoil Int
+ | Description TP.Msg
+ | ParentDel Int
+ | ParentSearch (A.Msg GApi.ApiTraitResult)
+ | Order String
+ | Submit
+ | Submitted (GApi.Response)
+
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+ case msg of
+ Name s -> ({ model | name = s }, Cmd.none)
+ Alias s -> ({ model | alias = String.replace "," "\n" s }, Cmd.none)
+ State n -> ({ model | state = n }, Cmd.none)
+ Searchable b -> ({ model | searchable = b }, Cmd.none)
+ Applicable b -> ({ model | applicable = b }, Cmd.none)
+ Sexual b -> ({ model | sexual = b }, Cmd.none)
+ DefaultSpoil n-> ({ model | defaultspoil = n }, Cmd.none)
+ Order s -> ({ model | order = Maybe.withDefault 0 (String.toInt s) }, Cmd.none)
+ Description m -> let (nm,nc) = TP.update m model.description in ({ model | description = nm }, Cmd.map Description nc)
+
+ ParentDel i -> ({ model | parents = delidx i model.parents }, Cmd.none)
+ ParentSearch m ->
+ let (nm, c, res) = A.update parentConfig m model.parentAdd
+ in case res of
+ Nothing -> ({ model | parentAdd = nm }, c)
+ Just p ->
+ if List.any (\e -> e.id == p.id) model.parents
+ then ({ model | parentAdd = nm }, c)
+ else ({ model | parentAdd = A.clear nm "", parents = model.parents ++ [{ id = p.id, name = p.name, group = p.group_name }] }, c)
+
+ Submit -> ({ model | formstate = Api.Loading }, GTE.send (encode model) Submitted)
+ Submitted (GApi.DupNames l) -> ({ model | dupNames = l, formstate = Api.Normal }, Cmd.none)
+ Submitted (GApi.Redirect s) -> (model, load s)
+ Submitted r -> ({ model | formstate = Api.Error r }, Cmd.none)
+
+
+view : Model -> Html Msg
+view model =
+ form_ Submit (model.formstate == Api.Loading)
+ [ div [ class "mainbox" ]
+ [ h1 [] [ text <| if model.id == Nothing then "Submit new trait" else "Edit trait" ]
+ , table [ class "formtable" ]
+ [ if model.id == Nothing then text "" else
+ formField "Added by" [ span [ Ffi.innerHtml model.addedby ] [], br_ 2 ]
+ , formField "name::Primary name" [ inputText "name" model.name Name GTE.valName ]
+ , formField "alias::Aliases"
+ -- BUG: Textarea doesn't validate the maxlength and patterns for aliases, we don't have a client-side fallback check either.
+ [ inputTextArea "alias" model.alias Alias []
+ , let dups = List.concatMap (findDup model) (model.name :: splitAliases model.alias)
+ in if List.isEmpty dups
+ then span [] [ br [] [], text "Trait name and aliases must be self-describing and unique within the same group." ]
+ else div []
+ [ b [ class "standout" ] [ text "The following trait names are already present in the same group:" ]
+ , ul [] <| List.map (\t ->
+ li [] [ a [ href ("/i"++String.fromInt t.id) ] [ text t.name ] ]
+ ) dups
+ ]
+ ]
+ , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ]
+ , if not model.canMod then text "" else
+ formField "state::State" [ inputSelect "state" model.state State GTE.valState
+ [ (0, "Awaiting Moderation")
+ , (1, "Deleted/hidden")
+ , (2, "Approved")
+ ]
+ ]
+ , if not model.canMod then text "" else
+ formField "" [ label [] [ inputCheck "" model.searchable Searchable, text " Searchable (people can use this trait to find characters)" ] ]
+ , if not model.canMod then text "" else
+ formField "" [ label [] [ inputCheck "" model.applicable Applicable, text " Applicable (people can apply this trait to characters)" ] ]
+ , formField "" [ label [] [ inputCheck "" model.sexual Sexual, text " Indicates sexual content" ] ]
+ , formField "defaultspoil::Default spoiler level" [ inputSelect "defaultspoil" model.defaultspoil DefaultSpoil GTE.valDefaultspoil
+ [ (0, "No spoiler")
+ , (1, "Minor spoiler")
+ , (2, "Major spoiler")
+ ] ]
+ , text "" -- aliases
+ , formField "description::Description"
+ [ TP.view "description" model.description Description 700 ([rows 12, cols 50] ++ GTE.valDescription) []
+ , text "What should the trait be used for? Having a good description helps users choose which traits to assign to characters."
+ ]
+ , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ]
+ , formField "Parent traits"
+ [ table [ class "compact" ] <| List.indexedMap (\i p -> tr []
+ [ td [ style "text-align" "right" ] [ b [ class "grayedout" ] [ text <| "i" ++ String.fromInt p.id ++ ":" ] ]
+ , td []
+ [ Maybe.withDefault (text "") <| Maybe.map (\g -> b [ class "grayedout" ] [ text (g ++ " / ") ]) p.group
+ , a [ href <| "/i" ++ String.fromInt p.id ] [ text p.name ]
+ ]
+ , td [] [ inputButton "remove" (ParentDel i) [] ]
+ ]
+ ) model.parents
+ , A.view parentConfig model.parentAdd [placeholder "Add parent trait..."]
+ ]
+ , if not (List.isEmpty model.parents) then text "" else
+ formField "order::Group order"
+ [ inputText "order" (String.fromInt model.order) Order (style "width" "50px" :: GTE.valOrder)
+ , text " Only meaningful if this trait is as a \"group\", i.e. a trait without any parents."
+ , text " This number determines the order in which the groups are displayed on character pages."
+ ]
+ ]
+ ]
+ , div [ class "mainbox" ]
+ [ fieldset [ class "submit" ] [ submitButton "Submit" model.formstate (isValid model) ] ]
+ ]
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;