From: Adam Chlipala Date: Fri, 15 Apr 2005 01:44:05 +0000 (+0000) Subject: Contact kind administration X-Git-Url: http://git.hcoop.net/hcoop/portal.git/commitdiff_plain/d6223be994735931643a8205a2c2c9724640fa21 Contact kind administration --- diff --git a/TODO b/TODO new file mode 100644 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 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 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 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 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)) + %>

Contact kind added

+ +<% elseif $"mod" <> "" then + showNormal := false; + val id = Web.stoi ($"mod"); + val kind = Contact.lookupKind id %> + +
+ + + + + +
Name:
URL pattern: <% + switch #makeUrl kind of + NONE => %> ...<% + | SOME (pre, post) => %> ...<% + end +%>
+
+ +<% 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)} + %>

Contact kind modified

+ +<% elseif $"del" <> "" then + showNormal := false; + val id = Web.stoi ($"del"); + val kind = Contact.lookupKind id %> +

Are you sure you want to delete "<% Web.html (#name kind) %>"?

+ + ">Yes, delete "<% Web.html (#name kind) %>"! + +<% elseif $"del2" <> "" then + val id = Web.stoi ($"del2"); + val kind = Contact.lookupKind id; + Contact.deleteKind id %> +

"<% Web.html (#name kind) %>" deleted

+ +<% end %> + +<% if showNormal then %> + +

Add a contact kind

+ +
+ + + + + +
Name:
URL pattern: ...
+
+ +

Current contact kinds

+ + + +<% foreach kind in Contact.listKinds () do %> + + + + + +<% end %> + +<% end %> + +<% @footer[] %> \ No newline at end of file diff --git a/tables.sql b/tables.sql index e35fe1d..5481e29 100644 --- 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
Kind URL pattern
<% Web.html (#name kind) %><% switch #makeUrl kind of + NONE => %>none<% + | SOME (pre, post) => Web.html pre %>...<% Web.html post + end %>[Modify] [Delete]