diff options
| -rw-r--r-- | elm/TraitEdit.elm | 209 | ||||
| -rw-r--r-- | lib/VNDB/DB/Traits.pm | 29 | ||||
| -rw-r--r-- | lib/VNDB/Handler/Traits.pm | 140 | ||||
| -rw-r--r-- | lib/VNDB/Util/FormHTML.pm | 282 | ||||
| -rw-r--r-- | lib/VNDB/Util/Misc.pm | 9 | ||||
| -rw-r--r-- | lib/VNDB/Util/ValidateTemplates.pm | 96 | ||||
| -rw-r--r-- | lib/VNWeb/Traits/Edit.pm | 139 |
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 ' '; - 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/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 => \>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; -} +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; |