Commit | Line | Data |
---|---|---|
259cc257 AC |
1 | structure Contact :> CONTACT = |
2 | struct | |
3 | ||
4 | structure C = PgClient | |
5 | ||
6 | fun main _ = | |
7 | let | |
52a07965 | 8 | val db = C.conn "dbname='hcoop_hcoop' host='postgres'" |
259cc257 AC |
9 | |
10 | fun allEmails () = | |
11 | let | |
12 | fun s [v] = C.stringFromSql v | |
13 | | s _ = raise Fail "Bad allEmails row" | |
14 | in | |
15 | C.map db s | |
eafe3d52 | 16 | "SELECT v FROM Contact JOIN ContactKind ON knd = ContactKind.id AND ContactKind.name = 'Non-HCoop e-mail' ORDER BY v" |
259cc257 AC |
17 | end |
18 | ||
19 | fun kindRow [id, name, url, urlPrefix, urlPostfix] = | |
20 | {id = C.intFromSql id, | |
21 | name = C.stringFromSql name, | |
22 | url = if C.boolFromSql url then | |
23 | SOME (C.stringFromSql urlPrefix, | |
24 | C.stringFromSql urlPostfix) | |
25 | else | |
26 | NONE} | |
27 | | kindRow _ = raise Fail "Bad ContactKind row" | |
28 | ||
29 | val kinds = C.map db kindRow "SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind ORDER BY name" | |
30 | ||
31 | fun doOne (kind : {id : int, name : string, url : (string * string) option}) = | |
32 | let | |
33 | fun doOne [name, v] = | |
34 | let | |
35 | val name = C.stringFromSql name | |
36 | val v = C.stringFromSql v | |
37 | in | |
38 | print "<li> "; | |
39 | print (Web.html name); | |
40 | print ": "; | |
41 | case #url kind of | |
42 | NONE => print (Web.html v) | |
43 | | SOME (pre, post) => | |
44 | (print "<a href=\""; | |
45 | print (Web.html (pre ^ v ^ post)); | |
46 | print "\">"; | |
47 | print (Web.html v); | |
48 | print "</a>"); | |
49 | print "</li>\n" | |
50 | end | |
51 | | doOne _ = raise Fail "Bad Contact row" | |
52 | in | |
53 | print "<h2>"; | |
54 | print (#name kind); | |
55 | print "</h2>\n<ol>\n"; | |
56 | ||
57 | C.app db doOne ("SELECT name, v FROM Contact JOIN WebUserActive ON usr = WebUserActive.id" | |
58 | ^ " WHERE knd = " ^ C.intToSql (#id kind) | |
59 | ^ " ORDER BY name, v"); | |
60 | ||
61 | print "</ol>\n\n" | |
62 | end | |
5067126d AC |
63 | |
64 | fun peer1 () = | |
65 | let | |
66 | val inf = TextIO.openIn "/afs/hcoop.net/user/h/hc/hcoop/contact/peer1.html" | |
67 | ||
68 | fun loop () = | |
69 | case TextIO.inputLine inf of | |
70 | NONE => () | |
71 | | SOME line => (print line; | |
72 | loop ()) | |
73 | in | |
74 | loop (); | |
75 | TextIO.closeIn inf | |
76 | end | |
259cc257 AC |
77 | in |
78 | print "<html><head><title>HCoop Emergency Contact Information</title></head><body><h1>HCoop Emergency Contact Information</h1>\n"; | |
79 | ||
a483e18c | 80 | print "<h2><a href=\"mailto:?Bcc="; |
259cc257 AC |
81 | print (String.concatWith "," (allEmails ())); |
82 | print "\">E-mail everyone (off-HCoop addresses)</a></h2>\n\n"; | |
83 | ||
84 | app doOne kinds; | |
5067126d AC |
85 | |
86 | print "<h2>Peer 1 phone numbers</h2>\n\n"; | |
87 | peer1 (); | |
88 | ||
259cc257 AC |
89 | print "</body></html>\n"; |
90 | C.close db; | |
91 | OS.Process.success | |
92 | end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n"); | |
93 | OS.Process.failure) | |
94 | ||
95 | end |