X-Git-Url: http://git.hcoop.net/hcoop/zz_old/portal.git/blobdiff_plain/4b8df0b1e0ef6900d3d78b7169cb5d662ed6c657..924e9320fb8512db9b8df383e5e308f0f55bc123:/support.sml diff --git a/support.sml b/support.sml index 84c0744..43bb9fb 100644 --- a/support.sml +++ b/support.sml @@ -9,7 +9,8 @@ datatype status = | CLOSED type category = { id : int, grp : int, name : string, descr : string } -type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status, stamp : C.timestamp } +type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status, + stamp : C.timestamp, cstamp : C.timestamp option, pstamp : C.timestamp option } type post = { id : int, usr : int, iss : int, body : string, stamp : C.timestamp } type subscription = { usr : int, cat : int } @@ -79,19 +80,22 @@ fun statusFromSql v = | 2 => CLOSED | _ => raise Fail "Bad support issue status" -fun mkIssueRow [id, usr, cat, title, priv, status, stamp] = +fun mkIssueRow [id, usr, cat, title, priv, status, stamp, pstamp, cstamp] = {id = C.intFromSql id, usr = C.intFromSql usr, cat = C.intFromSql cat, title = C.stringFromSql title, priv = C.boolFromSql priv, - status = statusFromSql status, stamp = C.timestampFromSql stamp} + status = statusFromSql status, stamp = C.timestampFromSql stamp, + pstamp = if C.isNull pstamp then NONE else SOME (C.timestampFromSql pstamp), + cstamp = if C.isNull cstamp then NONE else SOME (C.timestampFromSql cstamp)} + | mkIssueRow row = rowError ("issue", row) fun lookupIssue id = - mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp + mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue WHERE id = ^(C.intToSql id)`)) fun listIssues () = - C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp + C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue ORDER BY stamp DESC`) @@ -99,7 +103,7 @@ fun mkIssueRow' (name :: rest) = (C.stringFromSql name, mkIssueRow rest) | mkIssueRow' r = Init.rowError ("issue'", r) fun listOpenIssues usr = - C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, SupIssue.usr, SupIssue.cat, title, priv, status, stamp + C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, SupIssue.usr, SupIssue.cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue JOIN SupCategory ON cat = SupCategory.id JOIN WebUser ON WebUser.id = SupIssue.usr WHERE status < 2 @@ -113,14 +117,14 @@ fun listOpenIssues usr = ORDER BY stamp DESC`) fun listCategoryIssues cat = - C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, usr, cat, title, priv, status, stamp + C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue JOIN WebUser ON WebUser.id = usr WHERE cat = ^(C.intToSql cat) ORDER BY stamp DESC`) fun listOpenCategoryIssues (cat, usr) = - C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp + C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue JOIN WebUser ON WebUser.id = usr WHERE cat = ^(C.intToSql cat) @@ -129,7 +133,7 @@ fun listOpenCategoryIssues (cat, usr) = ORDER BY stamp DESC`) fun listOpenCategoryIssuesAdmin cat = - C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp + C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp FROM SupIssue JOIN WebUser ON WebUser.id = usr WHERE cat = ^(C.intToSql cat) @@ -141,10 +145,10 @@ fun addIssue (usr, cat, title, priv, status) = val db = getDb () val id = nextSeq (db, "SupIssueSeq") in - C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp) + C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp, pstamp, cstamp) VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql cat), ^(C.stringToSql title), ^(C.boolToSql priv), - ^(statusToSql status), CURRENT_TIMESTAMP)`); + ^(statusToSql status), CURRENT_TIMESTAMP, NULL, NULL)`); id end @@ -152,6 +156,10 @@ fun modIssue (iss : issue) = let val db = getDb () in + case #status iss of + PENDING => ignore (C.dml db ($`UPDATE SupIssue SET pstamp = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql (#id iss))`)) + | CLOSED => ignore (C.dml db ($`UPDATE SupIssue SET cstamp = CURRENT_TIMESTAMP WHERE id = ^(C.intToSql (#id iss))`)) + | _ => (); ignore (C.dml db ($`UPDATE SupIssue SET usr = ^(C.intToSql (#usr iss)), cat = ^(C.intToSql (#cat iss)), title = ^(C.stringToSql (#title iss)), priv = ^(C.boolToSql (#priv iss)), @@ -232,7 +240,7 @@ fun unsubscribe {usr, cat} = ignore (C.dml (getDb ()) ($`DELETE FROM SupSubscription WHERE usr = ^(C.intToSql usr) AND cat = ^(C.intToSql cat)`)) -val okChars = [#" ", #"-", #".", #"!", #"?", #":", #";", #"'", #"\""] +val okChars = [#" ", #"-", #".", #"!", #"?", #":", #",", #";", #"'", #"\"", #"/", #"(", #")", #"{", #"}", #"[", #"]"] fun validTitle s = CharVector.exists (fn ch => not (Char.isSpace ch)) s andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse List.exists (fn ch' => ch = ch') okChars) s @@ -273,6 +281,7 @@ fun writeRecipients (mail, iss : issue, cat : category, noName) = () else (Mail.mwrite (mail, name); + Mail.mwrite (mail, emailSuffix); Mail.mwrite (mail, ",")) end in @@ -289,9 +298,12 @@ fun notify (prefix, f) iss = val mail = Mail.mopen () in - Mail.mwrite (mail, "From: Hcoop Support System \nTo: "); + Mail.mwrite (mail, "From: Hcoop Support System \nTo: "); Mail.mwrite (mail, #name user); - Mail.mwrite (mail, "@hcoop.net\n"); + Mail.mwrite (mail, emailSuffix); + Mail.mwrite (mail, "\n"); writeRecipients (mail, iss, cat, #name user); Mail.mwrite (mail, "Subject: "); Mail.mwrite (mail, prefix); @@ -347,7 +359,7 @@ fun notifyStatus (usr, oldStatus, newStatus, iss) = val user = Init.lookupUser usr in notify ("[" ^ statusToString newStatus ^ "] ", - fn (iss, cat, user, mail) => + fn (iss, cat, user', mail) => (Mail.mwrite (mail, #name user); Mail.mwrite (mail, " changed status from "); Mail.mwrite (mail, statusToString oldStatus); @@ -356,4 +368,4 @@ fun notifyStatus (usr, oldStatus, newStatus, iss) = Mail.mwrite (mail, ".\n"))) iss end -end \ No newline at end of file +end