X-Git-Url: http://git.hcoop.net/bpt/portal.git/blobdiff_plain/cebd52f715dd2572c567d44c2d58a634e38859e4..2581e0222b4def4ba8cc38b73edf0a3dfe425c1e:/support.sml

diff --git a/support.sml b/support.sml
index 9c30d24..43bb9fb 100644
--- a/support.sml
+++ b/support.sml
@@ -1,4 +1,4 @@
-\structure Support :> SUPPORT =
+structure Support :> SUPPORT =
 struct
 
 open Util Sql Init
@@ -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