Hosted site link database

diff --git a/TODO b/TODO
index 19777c3..d6a985c 100644 (file)
--- a/TODO
+++ b/TODO
@@ -1,5 +1,4 @@
 Member data
-       - Hosted web site registry
        - Summarize these with publicly accessible static pages
 
 Generic support requests

diff --git a/group.sml b/group.sml
index 5daf76c..3481eb2 100644 (file)
--- a/group.sml
+++ b/group.sml
@@ -67,7 +67,7 @@ fun userInGroupName (usr, grp) =
     in
        (case C.oneOrNoRows c ($`SELECT COUNT( * )
                                    FROM Membership, WebGroup
-                                   WHERE (id = 0 OR (name = ^(C.stringToSql grp) AND grp = id))
+                                   WHERE (grp = 0 OR (name = ^(C.stringToSql grp) AND grp = id))
                                       AND usr = ^(C.intToSql usr)`) of
             SOME[x] => not (C.isNull x) andalso C.intFromSql x <> 0
           | _ => false)

diff --git a/link.mlt b/link.mlt
new file mode 100644 (file)
index 0000000..ddfea35
--- /dev/null
+++ b/link.mlt
@@ -0,0 +1,93 @@
+<% @header[("title", ["Hosted sites"])];
+
+val admin = Group.inGroupName "links";
+val you = Init.getUserId ();
+
+ref showNormal = true;
+
+if $"cmd" = "add" then
+       val id = Link.addLink (you, $"title", $"url", $"descr") %>
+       <h3><b>Link added</b></h3>
+
+<% elseif $"mod" <> "" then
+       val id = Web.stoi ($"mod");
+       val link = Link.lookupLink id;
+       if (iff admin then false else you <> #usr link) then
+               %><h3><b>You can't modify somebody else's link.</b></h3><%
+       else
+               showNormal := false %>
+
+<h3><b>Modify link</b></h3>
+
+<form action="link">
+<input type="hidden" name="save" value="<% id %>">
+<table>
+<tr> <td align="right"><b>Title</b>:</td> <td><input name="title" value="<% Web.html (#title link) %>"></td> </tr>
+<tr> <td align="right"><b>URL</b>:</td> <td><input name="url" value="<% Web.html (#url link) %>"></td> </tr>
+<tr> <td align="right"><b>Description</b>:</td> <td><input name="descr" value="<% Web.html (#descr link) %>"></td> </tr>
+<tr> <td><input type="submit" value="Save"></td> </t>
+</table>
+</form>
+<%     end
+
+elseif $"save" <> "" then
+       val id = Web.stoi ($"save");
+       val link = Link.lookupLink id;
+       if (iff admin then false else you <> #usr link) then
+               %><h3><b>You can't modify somebody else's link.</b></h3><%
+       else
+               Link.modLink {link with title = $"title", url = $"url", descr = $"descr"}
+               %><h3><b>Link modified</b></h3><%
+       end
+
+elseif $"del" <> "" then
+       val id = Web.stoi ($"del");
+       val link = Link.lookupLink id;
+       if (iff admin then false else you <> #usr link) then
+               %><h3><b>You can't delete somebody else's link.</b></h3><%
+       else
+               showNormal := false %>
+               <h3><b>Are you sure you want to delete link to "<% Web.html (#title link) %>"?</b></h3>
+               <a href="link?del2=<% id %>">Yes, delete "<% Web.html (#title link) %>"!</a><%
+       end
+
+elseif $"del2" <> "" then
+       val id = Web.stoi ($"del2");
+       val link = Link.lookupLink id;
+       if (iff admin then false else you <> #usr link) then
+               %><h3><b>You can't delete somebody else's link.</b></h3><%
+       else
+               Link.deleteLink id;
+               %><h3><b>Link "<% Web.html (#title link) %>" deleted</b></h3><%
+       end
+end;
+
+if showNormal then %>
+
+<table>
+<% foreach (name, link) in Link.listLinks () do %>
+       <tr> <td><a href="<% Web.html (#url link) %>"><% Web.html (#title link) %></a></td>
+       <td><% Web.html (#descr link) %></td>
+       <td>(<a href="user?id=<% #usr link %>"><% name %></a>)</td>
+<% if (iff admin then true else you = #usr link) then %>
+       <td><a href="link?mod=<% #id link %>">[Modify]</a> <a href="link?del=<% #id link %>">[Delete]</a></td>
+<% end %>
+       </tr>
+<% end %>
+</table>
+
+<h3><b>Add a link to a site you host with Hcoop</b></h3>
+
+<form action="link">
+<input type="hidden" name="cmd" value="add">
+<table>
+<tr> <td align="right"><b>Title</b>:</td> <td><input name="title"></td> </tr>
+<tr> <td align="right"><b>URL</b>:</td> <td><input name="url" value="http://"></td> </tr>
+<tr> <td align="right"><b>Description</b>:</td> <td><input name="descr"></td> </tr>
+<tr> <td><input type="submit" value="Add"></td> </t>
+</table>
+</form>
+
+<% end %>
+
+<% @footer[] %>
\ No newline at end of file

diff --git a/link.sig b/link.sig
new file mode 100644 (file)
index 0000000..f0d78dc
--- /dev/null
+++ b/link.sig
@@ -0,0 +1,11 @@
+signature LINK =
+sig
+    type link = {id : int, usr : int, title : string, url : string, descr : string}
+
+    val lookupLink : int -> link
+    val listLinks : unit -> (string * link) list
+    val listUserLinks : int -> link list
+    val addLink : int * string * string * string -> int
+    val modLink : link -> unit
+    val deleteLink : int -> unit
+end
\ No newline at end of file

diff --git a/link.sml b/link.sml
new file mode 100644 (file)
index 0000000..dffd86d
--- /dev/null
+++ b/link.sml
@@ -0,0 +1,55 @@
+structure Link :> LINK =
+struct
+
+open Util Sql Init
+
+type link = {id : int, usr : int, title : string, url : string, descr : string}
+
+fun mkLinkRow [id, usr, title, url, descr] =
+    {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title,
+     url = C.stringFromSql url, descr = C.stringFromSql descr}
+  | mkLinkRow row = rowError ("link", row)
+
+fun lookupLink id =
+    mkLinkRow (C.oneRow (getDb ()) ($`SELECT id, usr, title, url, descr
+                                     FROM Link
+                                     WHERE id = ^(C.intToSql id)`))
+
+fun mkLinkRow' (name :: rest) = (C.stringFromSql name, mkLinkRow rest)
+  | mkLinkRow' row = Init.rowError ("user'", row)
+
+fun listLinks () =
+    C.map (getDb ()) mkLinkRow' ($`SELECT name, Link.id, usr, title, url, descr
+                                  FROM Link JOIN WebUser ON usr = WebUser.id
+                                  ORDER BY title`)
+
+fun listUserLinks usr =
+    C.map (getDb ()) mkLinkRow ($`SELECT id, usr, title, url, descr
+                                 FROM Link
+                                 WHERE usr = ^(C.intToSql usr)
+                                 ORDER BY title`)
+
+fun addLink (usr, title, url, descr) =
+    let
+       val db = getDb ()
+       val id = nextSeq (db, "LinkSeq")
+    in
+       C.dml db ($`INSERT INTO Link (id, usr, title, url, descr)
+                   VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql url), ^(C.stringToSql descr))`);
+       id
+    end
+
+fun modLink (link : link) =
+    let
+       val db = getDb ()
+    in
+       ignore (C.dml db ($`UPDATE Link SET
+                           usr = ^(C.intToSql (#usr link)), title = ^(C.stringToSql (#title link)),
+                              url = ^(C.stringToSql (#url link)), descr = ^(C.stringToSql (#descr link))
+                           WHERE id = ^(C.intToSql (#id link))`))
+    end
+
+fun deleteLink id =
+    ignore (C.dml (getDb ()) ($`DELETE FROM Link WHERE id = ^(C.intToSql id)`))
+
+end

diff --git a/tables.sql b/tables.sql
index 1ffc2a4..b4996bb 100644 (file)
--- a/tables.sql
+++ b/tables.sql
@@ -33,18 +33,6 @@ INSERT INTO WebGroup
        (id, name) VALUES
        (0, 'root');
 
-INSERT INTO WebGroup
-       (id, name) VALUES
-       (1, 'money');
-
-INSERT INTO WebGroup
-       (id, name) VALUES
-       (2, 'paying');
-
-INSERT INTO WebGroup
-       (id, name) VALUES
-       (3, 'poll');
-
 CREATE TABLE Membership(
        grp INTEGER NOT NULL,
        usr INTEGER NOT NULL,
@@ -135,3 +123,14 @@ CREATE TABLE Lives(
        PRIMARY KEY (usr, loc),
        FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE,
        FOREIGN KEY (loc) REFERENCES Location(id) ON DELETE CASCADE);
+
+CREATE TABLE Link(
+       id INTEGER PRIMARY KEY,
+       usr INTEGER NOT NULL,
+       title TEXT NOT NULL,
+       url TEXT NOT NULL,
+       descr TEXT NOT NULL,
+       FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
+
+CREATE SEQUENCE LinkSeq START 1;
+

diff --git a/user.mlt b/user.mlt
index 7316db6..013cb73 100644 (file)
--- a/user.mlt
+++ b/user.mlt
@@ -19,16 +19,36 @@ val user = Init.lookupUser id;
                %><a href="location?id=<% #id loc %>"><% Web.html (#name loc) %></a><%
        end %></td> </tr>
 
+<% val links = Link.listUserLinks id;
+
+switch links of
+       (_::_) => %>
 <tr> </tr>
 
-<tr> <td><b>Contact information</b></td> </tr>
+<tr> <td><b>Hosted sites</b></td> </tr>
+
+<% foreach link in links do %>
+       <tr> <td></td> <td><b><a href="<% Web.html (#url link) %>"><% Web.html (#title link) %></a></b><%
+               if #descr link <> "" then %>: <% Web.html (#descr link) end
+       %></td> </tr>
+<% end
+end;
+
+val level = iff Group.inGroupName "contact" then Contact.ADMINS else Contact.MEMBERS;
 
-<% val level = iff Group.inGroupName "contact" then Contact.ADMINS else Contact.MEMBERS;
+val contacts = Contact.listUserContacts (id, level);
+
+switch contacts of
+       (_::_) => %>
+<tr> </tr>
+
+<tr> <td><b>Contact information</b></td> </tr>
 
-foreach (kind, cont) in Contact.listUserContacts (id, level) do %>
+<% foreach (kind, cont) in contacts  do %>
        <tr> <td align="right" valign="top"><b><% Web.html (#name kind) %></b>:</td>
        <td><% Contact.format (kind, cont) %></td> </tr>
-<% end %>
+<% end
+end %>
 
 </table>