X-Git-Url: http://git.hcoop.net/hcoop/zz_old/portal.git/blobdiff_plain/ff2b7604ffdbdae8ddd86c2a4366830ae9d32084..ef48ed9eaeea982b8580c44c0027edff6abde4d8:/request.sml diff --git a/request.sml b/request.sml index 08b7853..8e3dbc5 100644 --- 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 \nTo: "); + Mail.mwrite (mail, "From: Hcoop Portal \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: "); @@ -130,7 +139,7 @@ val notifyNew = notify (fn (user, mail) => (Mail.mwrite (mail, #name user); Mail.mwrite (mail, " has requested the following "); Mail.mwrite (mail, T.descr); - Mail.mwrite (mail, " packages:\n\n"))) + Mail.mwrite (mail, ":\n\n"))) val statusToString = fn NEW => "New" @@ -146,4 +155,4 @@ fun notifyMod (oldStatus, newStatus, changer, req) = Mail.mwrite (mail, statusToString newStatus); Mail.mwrite (mail, ".\n\n"))) req -end \ No newline at end of file +end