Contact kind administration

diff --git a/TODO b/TODO
new file mode 100644 (file)
index 0000000..859db30
--- /dev/null
+++ b/TODO
@@ -0,0 +1,16 @@
+Member data
+       - Contact information
+       - Geographic location
+       - Hosted web site registry
+       - Summarize these with publicly accessible static pages
+
+Generic support requests
+       - Admin categories of requests, where each has an optional group of responsible parties
+       - Allow subscription to categories to receive e-mail notices
+       - Actual postings to request threads
+       - Maintaining status information
+
+Specific requests
+       - Join, with display of pending applications for all members to read
+       - apt install requests
+       - New domain requests

diff --git a/contact.mlt b/contact.mlt
new file mode 100644 (file)
index 0000000..0dc61d4
--- /dev/null
+++ b/contact.mlt
@@ -0,0 +1,5 @@
+<% @header[("title", ["Contact information"])] %>
+
+
+
+<% @footer[] %>
\ No newline at end of file

diff --git a/contact.sig b/contact.sig
new file mode 100644 (file)
index 0000000..8d7a2eb
--- /dev/null
+++ b/contact.sig
@@ -0,0 +1,10 @@
+signature CONTACT =
+sig
+    type kind = {id :int, name : string, makeUrl : (string * string) option}
+
+    val addKind : string * (string * string) option -> int
+    val lookupKind : int -> kind
+    val modKind : kind -> unit
+    val deleteKind : int -> unit
+    val listKinds : unit -> kind list
+end
\ No newline at end of file

diff --git a/contact.sml b/contact.sml
new file mode 100644 (file)
index 0000000..2214ead
--- /dev/null
+++ b/contact.sml
@@ -0,0 +1,60 @@
+structure Contact :> CONTACT =
+struct
+
+open Util Sql Init
+
+
+(* Managing transactions *)
+
+type kind = {id :int, name : string, makeUrl : (string * string) option}
+
+fun makerToSql NONE = "FALSE, NULL, NULL"
+  | makerToSql (SOME (pre, post)) = $`TRUE, ^(C.stringToSql pre), ^(C.stringToSql post)`
+
+fun makerToSqlUpd NONE = "url = FALSE, urlPrefix = NULL, urlPostfix = NULL"
+  | makerToSqlUpd (SOME (pre, post)) = $`url = TRUE, urlPrefix = ^(C.stringToSql pre), urlPostfix = ^(C.stringToSql post)`
+
+fun mkKindRow [id, name, url, urlPrefix, urlPostfix] =
+    {id = C.intFromSql id, name = C.stringFromSql name, 
+     makeUrl = (if C.boolFromSql url then
+                   SOME (C.stringFromSql urlPrefix, C.stringFromSql urlPostfix)
+               else
+                   NONE)}
+  | mkKindRow row = raise Fail ("Bad kind row : " ^ makeSet id row)
+
+fun addKind (name, makeUrl) =
+    let
+       val db = getDb ()
+       val id = nextSeq (db, "ContactKindSeq")
+    in
+       C.dml db ($`INSERT INTO ContactKind (id, name, url, urlPrefix, urlPostfix)
+                    VALUES (^id, ^(C.stringToSql name), ^(makerToSql makeUrl))`);
+       C.intFromSql id
+    end
+
+fun lookupKind id =
+    let
+       val c = getDb ()
+    in
+       (case C.oneOrNoRows c ($`SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind WHERE id = ^(C.intToSql id)`) of
+            NONE => raise Fail "Contact kind not found"
+          | SOME r => mkKindRow r)
+    end
+
+fun modKind (kind : kind) =
+    let
+       val db = getDb ()
+    in
+       ignore (C.dml db ($`UPDATE ContactKind
+                           SET name = ^(C.stringToSql (#name kind)), ^(makerToSqlUpd (#makeUrl kind))
+                           WHERE id = ^(C.intToSql (#id kind))`))
+    end
+
+fun deleteKind id =
+    ignore (C.dml (getDb ()) ($`DELETE FROM ContactKind WHERE id = ^(C.intToSql id)`))
+
+fun listKinds () =
+    C.map (getDb ()) mkKindRow ($`SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind
+                                 ORDER BY name`)
+
+end
\ No newline at end of file

diff --git a/kind.mlt b/kind.mlt
new file mode 100644 (file)
index 0000000..2f8f08c
--- /dev/null
+++ b/kind.mlt
@@ -0,0 +1,82 @@
+<% @header[("title", ["Contact kind admin"])];
+
+Group.requireGroupName "contact";
+
+ref showNormal = true;
+
+if $"cmd" = "add" then
+       val id = Contact.addKind ($"name", (iff $"url" = "on" then SOME ($"urlPrefix", $"urlPostfix") else NONE))
+       %> <h3><b>Contact kind added</b></h3>
+
+<% elseif $"mod" <> "" then
+       showNormal := false;
+       val id = Web.stoi ($"mod");
+       val kind = Contact.lookupKind id %>
+
+<form action="kind">
+<input type="hidden" name="save" value="<% id %>">
+<table>
+<tr> <td align="right"><b>Name</b>:</td> <td><input name="name" value="<% Web.html (#name kind) %>"></td> </tr>
+<tr> <td align="right"><b>URL pattern</b>:</td> <td><%
+       switch #makeUrl kind of
+                 NONE => %><input type="checkbox" name="url"> <input name="urlPrefix">...<input name="urlPostfix"><%
+               | SOME (pre, post) => %><input type="checkbox" name="url" checked> <input name="urlPrefix" value="<% Web.html pre %>">...<input name="urlPostfix" value="<% Web.html post %>"><%
+       end
+%></td> </tr>
+<tr> <td><input type="submit" value="Save"></td> </tr>
+</table>
+</form>
+
+<% elseif $"save" <> "" then
+       val id = Web.stoi ($"save");
+       val kind = Contact.lookupKind id;
+       Contact.modKind {kind with name = $"name", makeUrl = (iff $"url" = "on" then SOME ($"urlPrefix", $"urlPostfix") else NONE)}
+       %> <h3><b>Contact kind modified</b></h3>
+
+<% elseif $"del" <> "" then
+       showNormal := false;
+       val id = Web.stoi ($"del");
+       val kind = Contact.lookupKind id %>
+       <h3><b>Are you sure you want to delete "<% Web.html (#name kind) %>"?</b></h3>
+
+       <a href="kind?del2=<% $"del" %>">Yes, delete "<% Web.html (#name kind) %>"!</a>
+
+<% elseif $"del2" <> "" then
+       val id = Web.stoi ($"del2");
+       val kind = Contact.lookupKind id;
+       Contact.deleteKind id %>
+       <h3><b>"<% Web.html (#name kind) %>" deleted</b></h3>
+
+<% end %>
+
+<% if showNormal then %>
+
+<h3><b>Add a contact kind</b></h3>
+
+<form action="kind">
+<input type="hidden" name="cmd" value="add">
+<table>
+<tr> <td align="right"><b>Name</b>:</td> <td><input name="name"></td> </tr>
+<tr> <td align="right"><b>URL pattern</b>:</td> <td><input type="checkbox" name="url"> <input name="urlPrefix">...<input name="urlPostfix"></td> </tr>
+<tr> <td><input type="submit" value="Add"></td> </tr>
+</table>
+</form>
+
+<h3><b>Current contact kinds</b></h3>
+
+<table>
+<tr> <td><b>Kind</b></td> <td><b>URL pattern</b></td> </tr>
+<% foreach kind in Contact.listKinds () do %>
+       <tr>
+       <td><% Web.html (#name kind) %></td>
+       <td><% switch #makeUrl kind of
+                 NONE => %><i>none</i><%
+               | SOME (pre, post) => Web.html pre %>...<% Web.html post
+       end %></td>
+       <td><a href="kind?mod=<% #id kind %>">[Modify]</a> <a href="kind?del=<% #id kind %>">[Delete]</a></td>
+       </tr>
+<% end %>
+
+<% end %>
+
+<% @footer[] %>
\ No newline at end of file

diff --git a/tables.sql b/tables.sql
index e35fe1d..5481e29 100644 (file)
--- a/tables.sql
+++ b/tables.sql
@@ -101,5 +101,21 @@ CREATE TABLE Vote(
        FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE,
        FOREIGN KEY (cho) REFERENCES PollChoice(id) ON DELETE CASCADE);
 
+CREATE TABLE ContactKind(
+       id INTEGER PRIMARY KEY,
+       name TEXT NOT NULL,
+       url BOOLEAN NOT NULL,
+       urlPrefix TEXT,
+       urlPostfix TEXT);
 
+CREATE SEQUENCE ContactKindSeq START 1;
 
+CREATE TABLE Contact(
+       usr INTEGER NOT NULL,
+       knd INTEGER NOT NULL,
+       v TEXT NOT NULL,
+       priv INTEGER NOT NULL,
+       PRIMARY KEY (usr, knd),
+       FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE,
+       FOREIGN KEY (knd) REFERENCES ContactKind(id) ON DELETE CASCADE);
+       
\ No newline at end of file