v2rw: Convert staff adding/editing form

This is the first major editing form to be converted, so I'm expecting a
little breakage. A good chunk of this code has been copied from v3.

In terms of the UI there has been a small change: aliases that are still
referenced do not have the 'remove' link and instead have a flag that
shows that they are still referenced. This ought to be a bit friendlier
than throwing an error message after the user has submitted the form.

Some other things I'd like to improve in this form:
- BBCode preview
- Pasting in external links and letting the form figure out the Pixiv
  ID, etc.
- Or perhaps even: Integrate AniDB/Wikidata search/autocompletion.

5 files changed, 223 insertions, 6 deletions

diff --git a/lib/VNWeb/DB.pm b/lib/VNWeb/DB.pm
index 27d04b64..1583e731 100644
--- a/lib/VNWeb/DB.pm
+++ b/lib/VNWeb/DB.pm
@@ -161,7 +161,7 @@ sub _enrich {
     return if !keys %ids;
 
     # Fetch the data
-    $sql = ref $sql eq 'CODE' ? $sql->([keys %ids]) : sql $sql, [keys %ids];
+    $sql = ref $sql eq 'CODE' ? do { local $_ = [keys %ids]; sql $sql->($_) } : sql $sql, [keys %ids];
     my $data = tuwf->dbAlli($sql);
 
     # And merge
@@ -237,7 +237,7 @@ my $entry_types = do {
 # Returns everything for a specific entry ID. The top-level hash also includes
 # the following keys:
 #
-#   id, chid, rev, maxrev, hidden, locked, entry_hidden, entry_locked
+#   id, chid, chrev, maxrev, hidden, locked, entry_hidden, entry_locked
 #
 # (Ordering of arrays is unspecified)
 #
@@ -318,10 +318,11 @@ sub db_edit {
 
     while(my($name, $tbl) = each $t->{tables}->%*) {
         my $base = $tbl->{name} =~ s/_hist$//r;
-        my @cols = sql_comma(map sql_identifier($_->{name}), $tbl->{cols}->$@);
+        my @colnames = grep $_ ne 'chid', map $_->{name}, $tbl->{cols}->@*;
+        my @cols = sql_comma(map sql_identifier($_), @colnames);
         my @rows = map {
             my $d = $_;
-            sql '(', sql_comma(map \$d, $tbl->{cols}->@*), ')'
+            sql '(', sql_comma(map \$d->{$_}, @colnames), ')'
         } $data->{$name}->@*;
 
         tuwf->dbExeci("DELETE FROM edit_${base}");
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
index e83faf25..1cdfcb88 100644
--- a/lib/VNWeb/Elm.pm
+++ b/lib/VNWeb/Elm.pm
@@ -234,6 +234,9 @@ sub write_types {
     $data .= def skins      => 'List (String, String)' =>
                 list map tuple(string $_, string tuwf->{skins}{$_}[0]),
                 sort { tuwf->{skins}{$a}[0] cmp tuwf->{skins}{$b}[0] } keys tuwf->{skins}->%*;
+    $data .= def languages  => 'List (String, String)' =>
+                list map tuple(string $_, string $LANGUAGE{$_}),
+                sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE;
 
     write_module Types => $data;
 }
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index f11019ca..2223c4cf 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -9,6 +9,7 @@ use JSON::XS;
 use TUWF ':html5_', 'uri_escape', 'html_escape', 'mkclass';
 use Exporter 'import';
 use POSIX 'ceil';
+use Carp 'croak';
 use JSON::XS;
 use VNDB::Config;
 use VNDB::BBCode;
@@ -28,6 +29,7 @@ our @EXPORT = qw/
     paginate_
     sortable_
     searchbox_
+    editmsg_
 /;
 
 
@@ -336,6 +338,15 @@ sub _maintabs_ {
 }
 
 
+# Attempt to figure out the board id from a database entry ($type, $dbobj) combination
+sub _board_id {
+    my($type, $obj) = @_;
+    $type =~ /[vp]/ ? $type.$obj->{id} :
+       $type eq 'r' && $obj->{vn}->@*  ? 'v'.$obj->{vn}[0]{vid} :
+       $type eq 'c' && $obj->{vns}->@* ? 'v'.$obj->{vns}[0]{vid} : 'db';
+}
+
+
 # Returns 1 if the page contents should be hidden.
 sub _hidden_msg_ {
     my $o = shift;
@@ -349,14 +360,13 @@ sub _hidden_msg_ {
           WHERE', { type => $o->{type}, itemid => $o->{dbobj}{id} },
          'ORDER BY id DESC LIMIT 1'
     );
-    my $board = $o->{type} =~ /[vp]/ ? $o->{type}.$o->{dbobj}{id} : 'db'; # TODO: Link to VN board for characters and releases?
     div_ class => 'mainbox', sub {
         h1_ $o->{title};
         div_ class => 'warning', sub {
             h2_ 'Item deleted';
             p_ sub {
                 txt_ 'This item has been deleted from the database. You may file a request on the ';
-                a_ href => "/t/$board", "discussion board";
+                a_ href => '/t/'._board_id($o->{type}, $o->{dbobj}), "discussion board";
                 txt_ ' if you believe that this entry should be restored.';
                 br_;
                 br_;
@@ -669,4 +679,68 @@ sub searchbox_ {
       };
 }
 
+
+# Generate the initial mainbox when adding or editing a database entry, with a
+# friendly message pointing to the guidelines and stuff.
+# Args: $type ('v','r', etc), $obj (from db_entry(), or undef for new page), $page_title, $is_this_a_copy?
+sub editmsg_ {
+  my($type, $obj, $title, $copy) = @_;
+  my $typename   = {v => 'visual novel', r => 'release', p => 'producer', c => 'character', s => 'person'}->{$type};
+  my $guidelines = {v => 2,              r => 3,         p => 4,          c => 12,          s => 16      }->{$type};
+  croak "Unknown type: $type" if !$typename;
+
+  div_ class => 'mainbox', sub {
+      h1_ sub {
+          txt_ $title;
+          debug_ $obj if $obj;
+      };
+      if($copy) {
+          div_ class => 'warning', sub {
+              h2_ "You're not editing an entry!";
+              p_ sub {;
+                  txt_ "You're about to insert a new entry into the database with information based on ";
+                  a_ href => "/$type$obj->{id}", "$type$obj->{id}";
+                  txt_ '.';
+                  br_;
+                  txt_ "Hit the 'edit' tab on the right-top if you intended to edit the entry instead of creating a new one.";
+              }
+          }
+      }
+      # 'lastrev' is for compatibility with VNDB::*
+      if($obj && ($obj->{maxrev} ? $obj->{maxrev} != $obj->{chrev} : !$obj->{lastrev})) {
+          div_ class => 'warning', sub {
+              h2_ 'Reverting';
+              p_ "You are editing an old revision of this $typename. If you save it, all changes made after this revision will be reverted!";
+          }
+      }
+      div_ class => 'notice', sub {
+          h2_ 'Before editing:';
+          ul_ sub {
+              li_ sub {
+                  txt_ 'Read the ';
+                  a_ href=> "/d$guidelines", 'guidelines';
+                  txt_ '!';
+              };
+              if($obj) {
+                  li_ sub {
+                      txt_ 'Check for any existing discussions on the ';
+                      a_ href => '/t/'._board_id($type, $obj), 'discussion board';
+                  };
+                  # TODO: Include a list of the most recent edits in this page.
+                  li_ sub {
+                      txt_ 'Browse the ';
+                      a_ href => "/$type$obj->{id}/hist", 'edit history';
+                      txt_ ' for any recent changes related to what you want to change.';
+                  };
+              } elsif($type ne 'r') {
+                  li_ sub {
+                      a_ href => "/$type/all", 'Search the database';
+                      txt_ " to see if we already have information about this $typename.";
+                  }
+              }
+          }
+      };
+  }
+}
+
 1;
diff --git a/lib/VNWeb/Staff/Edit.pm b/lib/VNWeb/Staff/Edit.pm
new file mode 100644
index 00000000..b3c69db7
--- /dev/null
+++ b/lib/VNWeb/Staff/Edit.pm
@@ -0,0 +1,103 @@
+package VNWeb::Staff::Edit;
+
+use VNWeb::Prelude;
+
+
+my $FORM = {
+    aid         => { int => 1, range => [ -1000, 1<<40 ] }, # X
+    alias       => { maxlength => 100, sort_keys => 'aid', aoh => {
+        aid       => { int => 1, range => [ -1000, 1<<40 ] }, # X, negative IDs are for new aliases
+        name      => { maxlength => 200 },
+        original  => { maxlength => 200, required => 0, default => '' },
+        inuse     => { anybool => 1, _when => 'out' },
+    } },
+    desc       => { required => 0, default => '', maxlength => 5000 },
+    gender     => { required => 0, default => 'unknown', enum => [qw[unknown m f]] },
+    lang       => { language => 1 },
+    l_site     => { required => 0, default => '', weburl => 1 },
+    l_wikidata => { required => 0, default => 0,  id => 1 },
+    l_twitter  => { required => 0, default => '', regex => qr/^\S+$/, maxlength => 16 },
+    l_anidb    => { required => 0, id => 1, default => undef },
+    l_pixiv    => { required => 0, id => 1, default => 0 },
+    hidden     => { anybool => 1 },
+    locked     => { anybool => 1 },
+
+    id         => { _when => 'out', id => 1 },
+    authmod    => { _when => 'out', anybool => 1 },
+    editsum    => { _when => 'in out', editsum => 1 },
+};
+
+my $FORM_OUT = form_compile out => $FORM;
+my $FORM_IN  = form_compile in  => $FORM;
+my $FORM_CMP = form_compile cmp => $FORM;
+
+elm_form StaffEdit => $FORM_OUT, $FORM_IN;
+
+
+TUWF::get qr{/$RE{srev}/edit} => sub {
+    my $e = db_entry s => tuwf->capture('id'), tuwf->capture('rev') or return tuwf->resNotFound;
+    return tuwf->resDenied if !can_edit s => $e;
+
+    $e->{authmod} = auth->permDbmod;
+    $e->{editsum} = $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision s$e->{id}.$e->{chrev}";
+
+    enrich_merge aid => sub {
+        'SELECT aid, EXISTS(SELECT 1 FROM vn_staff WHERE aid = x.aid UNION ALL SELECT 1 FROM vn_seiyuu WHERE aid = x.aid) AS inuse
+           FROM unnest(', sql_array(@$_), '::int[]) AS x(aid)'
+    }, $e->{alias};
+
+    my $name = (grep $_->{aid} == $e->{aid}, @{$e->{alias}})[0]{name};
+    framework_ title => "Edit $name", type => 's', dbobj => $e, tab => 'edit',
+    sub {
+        editmsg_ s => $e, "Edit $name";
+        elm_ 'StaffEdit.Main' => $FORM_OUT, $e;
+    };
+};
+
+
+TUWF::get qr{/s/new}, sub {
+    return tuwf->resDenied if !can_edit s => undef;
+    framework_ title => 'Add staff member',
+    sub {
+        editmsg_ s => undef, 'Add staff member';
+        elm_ 'StaffEdit.New';
+    };
+};
+
+
+json_api qr{/(?:$RE{sid}/edit|s/add)}, $FORM_IN, sub {
+    my $data = shift;
+    my $new = !tuwf->capture('id');
+    my $e = $new ? { id => 0 } : db_entry s => tuwf->capture('id') or return tuwf->resNotFound;
+    return elm_Unauth if !can_edit s => $e;
+
+    if(!auth->permDbmod) {
+        $data->{hidden} = $e->{hidden}||0;
+        $data->{locked} = $e->{locked}||0;
+    }
+    $data->{l_wp} = $e->{l_wp}||'';
+    $data->{desc} = bb_subst_links $data->{desc};
+
+    # The form validation only checks for duplicate aid's, but the name+original should also be unique.
+    my %names;
+    die "Duplicate aliases" if grep $names{"$_->{name}\x00$_->{original}"}++, $data->{alias}->@*;
+
+    # For positive alias IDs: Make sure they exist and are owned by this entry.
+    validate_dbid
+        sql('SELECT aid FROM staff_alias WHERE id =', \$e->{id}, 'AND aid IN'),
+        grep $_>=0, map $_->{aid}, $data->{alias}->@*;
+
+    # For negative alias IDs: Assign a new ID.
+    for my $alias (grep $_->{aid} < 0, $data->{alias}->@*) {
+        my $new = tuwf->dbVali(select => sql_func nextval => \'staff_alias_aid_seq');
+        $data->{aid} = $new if $alias->{aid} == $data->{aid};
+        $alias->{aid} = $new;
+    }
+    # We rely on Postgres to throw an error if we attempt to delete an alias that is still being referenced.
+
+    return elm_Unchanged if !$new && !form_changed $FORM_CMP, $data, $e;
+    my($id,undef,$rev) = db_edit s => $e->{id}, $data;
+    elm_Changed $id, $rev;
+};
+
+1;
diff --git a/lib/VNWeb/Validation.pm b/lib/VNWeb/Validation.pm
index eb29a52c..ee3bc386 100644
--- a/lib/VNWeb/Validation.pm
+++ b/lib/VNWeb/Validation.pm
@@ -3,14 +3,18 @@ package VNWeb::Validation;
 use v5.26;
 use TUWF;
 use PWLookup;
+use VNDB::Types;
 use VNDB::Config;
 use VNWeb::Auth;
+use VNWeb::DB;
+use Carp 'croak';
 use Exporter 'import';
 
 our @EXPORT = qw/
     is_insecurepass
     form_compile
     form_changed
+    validate_dbid
     can_edit
 /;
 
@@ -22,6 +26,20 @@ TUWF::set custom_validations => {
     upage       => { uint => 1, min => 1, required => 0, default => 1 }, # pagination without a maximum
     username    => { regex => qr/^(?!-*[a-z][0-9]+-*$)[a-z0-9-]*$/, minlength => 2, maxlength => 15 },
     password    => { length => [ 4, 500 ] },
+    language    => { enum => \%LANGUAGE },
+    # Sort an array by the listed hash keys, using string comparison on each key
+    sort_keys   => sub {
+        my @keys = ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0];
+        +{ type => 'array', sort => sub {
+            for(@keys) {
+                my $c = defined($_[0]{$_}) cmp defined($_[1]{$_}) || (defined($_[0]{$_}) && $_[0]{$_} cmp $_[1]{$_});
+                return $c if $c;
+            }
+            0
+        } }
+    },
+    # Sorted and unique array-of-hashes (default order is sort_keys on the sorted keys...)
+    aoh         => sub { +{ type => 'array', unique => 1, sort_keys => [sort keys %{$_[0]}], values => { type => 'hash', keys => $_[0] } } },
 };
 
 
@@ -88,6 +106,24 @@ sub form_changed {
 }
 
 
+# Validate identifiers against an SQL query. The query must end with a 'id IN'
+# clause, where the @ids array is appended. The query must return exactly 1
+# column, the id of each entry. This function throws an error if an id is
+# missing from the query. For example, to test for non-hidden VNs:
+#
+#   validate_dbid 'SELECT id FROM vn WHERE NOT hidden AND id IN', 2,3,5,7,...;
+#
+# If any of those ids is hidden or not in the database, an error is thrown.
+sub validate_dbid {
+    my($sql, @ids) = @_;
+    return if !@ids;
+    $sql = ref $sql eq 'CODE' ? do { local $_ = \@ids; sql $sql->(\@ids) } : sql $sql, \@ids;
+    my %dbids = map +((values %$_)[0],1), @{ tuwf->dbAlli($sql) };
+    my @missing = grep !$dbids{$_}, @ids;
+    croak "Invalid database IDs: ".join(',', @missing) if @missing;
+}
+
+
 # Returns whether the current user can edit the given database entry.
 sub can_edit {
     my($type, $entry) = @_;