HCoop
/
bpt
/
portal.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use 'vos listvol' for quota stats
[bpt/portal.git]
/
support.sml
diff --git
a/support.sml
b/support.sml
index
701737b
..
43bb9fb
100644
(file)
--- a/
support.sml
+++ b/
support.sml
@@
-9,7
+9,8
@@
datatype status =
| CLOSED
type category = { id : int, grp : int, name : string, descr : string }
| 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 }
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"
| 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,
{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 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 () =
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`)
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 =
| 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
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 =
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) =
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)
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 =
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)
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
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),
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
id
end
@@
-152,6
+156,10
@@
fun modIssue (iss : issue) =
let
val db = getDb ()
in
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)),
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)`))
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
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
@@
-261,7
+269,9
@@
fun writeRecipients (mail, iss : issue, cat : category, noName) =
FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
else
$`SELECT name
FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
else
$`SELECT name
- FROM WebUser JOIN SupSubscription ON (usr = id AND cat = ^(C.intToSql (#id cat)))`
+ FROM WebUser JOIN SupSubscription ON (usr = id AND cat = ^(C.intToSql (#id cat)))
+ UNION SELECT name
+ FROM WebUser JOIN Membership ON (usr = id AND grp = ^(C.intToSql (#grp cat)))`
fun doOne [name] =
let
fun doOne [name] =
let
@@
-271,6
+281,7
@@
fun writeRecipients (mail, iss : issue, cat : category, noName) =
()
else
(Mail.mwrite (mail, name);
()
else
(Mail.mwrite (mail, name);
+ Mail.mwrite (mail, emailSuffix);
Mail.mwrite (mail, ","))
end
in
Mail.mwrite (mail, ","))
end
in
@@
-287,9
+298,12
@@
fun notify (prefix, f) iss =
val mail = Mail.mopen ()
in
val mail = Mail.mopen ()
in
- Mail.mwrite (mail, "From: Hcoop Support System <support@hcoop.net>\nTo: ");
+ Mail.mwrite (mail, "From: Hcoop Support System <support");
+ Mail.mwrite (mail, emailSuffix);
+ Mail.mwrite (mail, ">\nTo: ");
Mail.mwrite (mail, #name user);
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);
writeRecipients (mail, iss, cat, #name user);
Mail.mwrite (mail, "Subject: ");
Mail.mwrite (mail, prefix);
@@
-345,7
+359,7
@@
fun notifyStatus (usr, oldStatus, newStatus, iss) =
val user = Init.lookupUser usr
in
notify ("[" ^ statusToString newStatus ^ "] ",
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);
(Mail.mwrite (mail, #name user);
Mail.mwrite (mail, " changed status from ");
Mail.mwrite (mail, statusToString oldStatus);
@@
-354,4
+368,4
@@
fun notifyStatus (usr, oldStatus, newStatus, iss) =
Mail.mwrite (mail, ".\n"))) iss
end
Mail.mwrite (mail, ".\n"))) iss
end
-end
\ No newline at end of file
+end