Join script should rule out retired usernames

[bpt/portal.git] / request.sml

diff --git a/request.sml b/request.sml
index 395bab4..e3a6dec 100644 (file)
--- a/request.sml
+++ b/request.sml
@@ -11,7 +11,8 @@ datatype status =
        | INSTALLED
        | REJECTED
 
-type request = { id : int, usr : int, data : string, msg : string, status : status, stamp : C.timestamp }
+type request = { id : int, usr : int, data : string, msg : string, status : status,
+                stamp : C.timestamp, cstamp : C.timestamp option }
 
 val statusFromInt =
     fn 0 => NEW
@@ -27,9 +28,10 @@ val statusToInt =
 fun statusFromSql v = statusFromInt (C.intFromSql v)
 fun statusToSql s = C.intToSql (statusToInt s)
 
-fun mkRow [id, usr, data, msg, status, stamp] =
+fun mkRow [id, usr, data, msg, status, stamp, cstamp] =
     {id = C.intFromSql id, usr = C.intFromSql usr, data = C.stringFromSql data,
-     msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp}
+     msg = C.stringFromSql msg, status = statusFromSql status, stamp = C.timestampFromSql stamp,
+     cstamp = if C.isNull cstamp then NONE else SOME (C.timestampFromSql cstamp)}
   | mkRow r = rowError ("APT request", r)
 
 fun add (usr, data, msg) =
@@ -37,9 +39,9 @@ fun add (usr, data, msg) =
        val db = getDb ()
        val id = nextSeq (db, seq)
     in
-       C.dml db ($`INSERT INTO ^table (id, usr, data, msg, status, stamp)
+       C.dml db ($`INSERT INTO ^table (id, usr, data, msg, status, stamp, cstamp)
                    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql data), ^(C.stringToSql msg),
-                           0, CURRENT_TIMESTAMP)`);
+                           0, CURRENT_TIMESTAMP, NULL)`);
        id
     end
 
@@ -47,6 +49,10 @@ fun modify (req : request) =
     let
        val db = getDb ()
     in
+       if #status req <> NEW then
+           ignore (C.dml db ($`UPDATE ^table SET cstamp = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql (#id req))`))
+       else
+           ();
        ignore (C.dml db ($`UPDATE ^table SET
                            usr = ^(C.intToSql (#usr req)), data = ^(C.stringToSql (#data req)),
                               msg = ^(C.stringToSql (#msg req)), status = ^(statusToSql (#status req))
@@ -57,7 +63,7 @@ fun delete id =
     ignore (C.dml (getDb ()) ($`DELETE FROM ^table WHERE id = ^(C.intToSql id)`))
 
 fun lookup id =
-    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, data, msg, status, stamp
+    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, data, msg, status, stamp, cstamp
                                     FROM ^table
                                     WHERE id = ^(C.intToSql id)`) of
        SOME row => mkRow row
@@ -67,12 +73,12 @@ fun mkRow' (name :: rest) = (C.stringFromSql name, mkRow rest)
   | mkRow' r = rowError ("Apt.request'", r)
 
 fun list () =
-    C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, data, msg, status, stamp
+    C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, data, msg, status, stamp, cstamp
                               FROM ^table JOIN WebUser ON usr = WebUser.id
                               ORDER BY stamp DESC`)
 
 fun listOpen () =
-    C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, data, msg, status, stamp
+    C.map (getDb ()) mkRow' ($`SELECT name, ^table.id, usr, data, msg, status, stamp, cstamp
                               FROM ^table JOIN WebUser ON usr = WebUser.id
                               WHERE status = 0
                               ORDER BY stamp DESC`)
@@ -97,14 +103,17 @@ fun notify f req =
                    ()
                else
                    (Mail.mwrite (mail, name);
+                    Mail.mwrite (mail, emailSuffix);
                     Mail.mwrite (mail, ","))
            end
          | doOne r = rowError (table ^ ".doOne", r)
     in
-       Mail.mwrite (mail, "From: Hcoop Portal <portal@hcoop.net>\nTo: ");
+       Mail.mwrite (mail, "From: Hcoop Portal <portal");
+       Mail.mwrite (mail, emailSuffix);
+       Mail.mwrite (mail, ">\nTo: ");
        Mail.mwrite (mail, #name user);
-       Mail.mwrite (mail, "@hcoop.net\n");
-       Mail.mwrite (mail, "Bcc: ");
+       Mail.mwrite (mail, emailSuffix);                     
+       Mail.mwrite (mail, "\nBcc: ");
        C.app (getDb ()) doOne ($`SELECT name
                                  FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql grp))`);
        Mail.mwrite (mail, "\nSubject: ");
@@ -138,12 +147,17 @@ val statusToString =
      | REJECTED => "Rejected"
 
 fun notifyMod (oldStatus, newStatus, changer, req) =
-    notify (fn (_, mail) =>
-              (Mail.mwrite (mail, changer);
-               Mail.mwrite (mail, " has changed the status of this request from ");
-               Mail.mwrite (mail, statusToString oldStatus);
-               Mail.mwrite (mail, " to ");
-               Mail.mwrite (mail, statusToString newStatus);
-               Mail.mwrite (mail, ".\n\n"))) req
+    if oldStatus = newStatus then
+       notify (fn (_, mail) =>
+                  (Mail.mwrite (mail, changer);
+                   Mail.mwrite (mail, " has added a comment to this request.\n\n"))) req
+    else
+       notify (fn (_, mail) =>
+                  (Mail.mwrite (mail, changer);
+                   Mail.mwrite (mail, " has changed the status of this request from ");
+                   Mail.mwrite (mail, statusToString oldStatus);
+                   Mail.mwrite (mail, " to ");
+                   Mail.mwrite (mail, statusToString newStatus);
+                   Mail.mwrite (mail, ".\n\n"))) req
                
-end
\ No newline at end of file
+end