Commit | Line | Data |
---|---|---|
a75ed94b AC |
1 | structure Qos :> QOS = struct |
2 | ||
3 | open Util Sql Init | |
4 | ||
5 | type entry = { kind : string, kindUrl : string option, name : string, url : string option, usr : int, uname : string, | |
6 | stamp : C.timestamp, pstamp : C.timestamp option, cstamp : C.timestamp option} | |
7 | ||
8 | fun mkEntryRow [kind, kindUrl, name, url, usr, uname, stamp, pstamp, cstamp] = | |
9 | {kind = C.stringFromSql kind, kindUrl = if C.isNull kindUrl then NONE else SOME (C.stringFromSql kindUrl), | |
10 | name = C.stringFromSql name, url = if C.isNull url then NONE else SOME (C.stringFromSql url), | |
11 | usr = C.intFromSql usr, uname = C.stringFromSql uname, stamp = C.timestampFromSql stamp, | |
12 | pstamp = if C.isNull pstamp then NONE else SOME (C.timestampFromSql pstamp), | |
13 | cstamp = if C.isNull cstamp then NONE else SOME (C.timestampFromSql cstamp)} | |
14 | | mkEntryRow row = rowError ("QOS", row) | |
15 | ||
16 | fun recent days = | |
17 | let | |
18 | val usr = Init.getUserId () | |
19 | val db = getDb () | |
20 | in | |
21 | C.map db mkEntryRow ($`SELECT SupCategory.name, 'issue?cat=' || SupCategory.id, title, | |
22 | 'issue?cat=' || SupCategory.id || '&id=' || SupIssue.id, usr, WebUser.name, | |
23 | stamp, COALESCE(pstamp, cstamp), cstamp | |
24 | FROM SupIssue JOIN SupCategory ON SupCategory.id = cat | |
25 | JOIN WebUser ON WebUser.id = usr | |
26 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
27 | AND (NOT priv OR usr = ^(C.intToSql usr) | |
28 | OR (SELECT COUNT(*) FROM Membership WHERE Membership.usr = ^(C.intToSql usr) | |
29 | AND (Membership.grp = 0 OR Membership.grp = SupCategory.grp)) > 0) | |
30 | UNION SELECT 'APT package', NULL, data, NULL, usr, name, stamp, cstamp, cstamp | |
31 | FROM Apt JOIN WebUser ON WebUser.id = usr | |
32 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
33 | UNION SELECT 'Domain', NULL, data, NULL, usr, name, stamp, cstamp, cstamp | |
34 | FROM Domain JOIN WebUser ON WebUser.id = usr | |
35 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
36 | UNION SELECT 'Mailing list', NULL, data, NULL, usr, name, stamp, cstamp, cstamp | |
37 | FROM MailingList JOIN WebUser ON WebUser.id = usr | |
38 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
39 | UNION SELECT 'Security', NULL, data, NULL, usr, name, stamp, cstamp, cstamp | |
40 | FROM Sec JOIN WebUser ON WebUser.id = usr | |
41 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
42 | ORDER BY stamp DESC`) | |
43 | end | |
44 | ||
f7cc3697 AC |
45 | type grade = { count : int, minutes : int } |
46 | type grades = { pending : grade, closed : grade } | |
47 | type reportCard = { misc : grades, | |
48 | apt : grade, | |
49 | domain : grade, | |
50 | mailingList : grade, | |
51 | sec : grade } | |
52 | ||
53 | fun mkGradeRow [count, minutes] = | |
54 | {count = C.intFromSql count, | |
55 | minutes = if C.isNull minutes then 0 else C.intFromSql minutes} | |
56 | | mkGradeRow row = rowError ("grade", row) | |
57 | ||
58 | fun reportCard days = | |
59 | let | |
60 | val db = getDb () | |
61 | ||
62 | fun gradeRow s = mkGradeRow (C.oneRow db s) | |
63 | ||
64 | fun default tab = | |
8236c6f3 | 65 | gradeRow ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(cstamp - stamp)) |
f7cc3697 AC |
66 | FROM ^tab |
67 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
68 | AND cstamp IS NOT NULL`) | |
69 | in | |
70 | {misc = {pending = gradeRow | |
8236c6f3 | 71 | ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(COALESCE(pstamp, cstamp) - stamp)) |
f7cc3697 AC |
72 | FROM SupIssue |
73 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
74 | AND COALESCE(pstamp, cstamp) IS NOT NULL`), | |
75 | closed = gradeRow | |
8236c6f3 | 76 | ($`SELECT COUNT(*), EXTRACT(MINUTE FROM AVG(cstamp - stamp)) |
f7cc3697 AC |
77 | FROM SupIssue |
78 | WHERE stamp >= CURRENT_TIMESTAMP - interval '^(C.intToSql days) DAYS' | |
79 | AND cstamp IS NOT NULL`)}, | |
80 | apt = default "Apt", | |
81 | domain = default "Domain", | |
82 | mailingList = default "MailingList", | |
83 | sec = default "Sec"} | |
84 | end | |
85 | ||
a75ed94b | 86 | end |