From 259cc257e2a9c6e40eb9f7b8bca15a75cfbf3d2e Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 19 Jan 2008 21:30:39 +0000 Subject: [PATCH] Contact info dumper --- contact/.cvsignore | 2 ++ contact/Makefile | 4 +++ contact/contact.sh | 1 + contact/contact.sig | 4 +++ contact/contact.sml | 77 +++++++++++++++++++++++++++++++++++++++++++++ contact/sources.cm | 9 ++++++ 6 files changed, 97 insertions(+) create mode 100644 contact/.cvsignore create mode 100644 contact/Makefile create mode 100755 contact/contact.sh create mode 100644 contact/contact.sig create mode 100644 contact/contact.sml create mode 100644 contact/sources.cm diff --git a/contact/.cvsignore b/contact/.cvsignore new file mode 100644 index 0000000..8afcbd3 --- /dev/null +++ b/contact/.cvsignore @@ -0,0 +1,2 @@ +.cm +*.x86-linux diff --git a/contact/Makefile b/contact/Makefile new file mode 100644 index 0000000..c8cd939 --- /dev/null +++ b/contact/Makefile @@ -0,0 +1,4 @@ +SMLBIN=/usr/local/sml/bin + +all: + $(SMLBIN)/ml-build sources.cm Contact.main contact diff --git a/contact/contact.sh b/contact/contact.sh new file mode 100755 index 0000000..29c979b --- /dev/null +++ b/contact/contact.sh @@ -0,0 +1 @@ +/usr/local/sml/bin/sml @SMLload=/afs/hcoop.net/user/h/hc/hcoop/portal/contact/contact.x86-linux diff --git a/contact/contact.sig b/contact/contact.sig new file mode 100644 index 0000000..1c577aa --- /dev/null +++ b/contact/contact.sig @@ -0,0 +1,4 @@ +signature CONTACT = +sig + val main : string * string list -> OS.Process.status +end diff --git a/contact/contact.sml b/contact/contact.sml new file mode 100644 index 0000000..4b67641 --- /dev/null +++ b/contact/contact.sml @@ -0,0 +1,77 @@ +structure Contact :> CONTACT = +struct + +structure C = PgClient + +fun main _ = + let + val db = C.conn "dbname='hcoop_hcoop'" + + fun allEmails () = + let + fun s [v] = C.stringFromSql v + | s _ = raise Fail "Bad allEmails row" + in + C.map db s + "SELECT v FROM Contact JOIN ContactKind ON knd = ContactKind.id AND ContactKind.name = 'Non-hcoop e-mail' ORDER BY v" + end + + fun kindRow [id, name, url, urlPrefix, urlPostfix] = + {id = C.intFromSql id, + name = C.stringFromSql name, + url = if C.boolFromSql url then + SOME (C.stringFromSql urlPrefix, + C.stringFromSql urlPostfix) + else + NONE} + | kindRow _ = raise Fail "Bad ContactKind row" + + val kinds = C.map db kindRow "SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind ORDER BY name" + + fun doOne (kind : {id : int, name : string, url : (string * string) option}) = + let + fun doOne [name, v] = + let + val name = C.stringFromSql name + val v = C.stringFromSql v + in + print "

"; + print (Web.html name); + print ": "; + case #url kind of + NONE => print (Web.html v) + | SOME (pre, post) => + (print ""; + print (Web.html v); + print ""); + print "

\n" + end + | doOne _ = raise Fail "Bad Contact row" + in + print "

"; + print (#name kind); + print "

\n"; + + C.app db doOne ("SELECT name, v FROM Contact JOIN WebUserActive ON usr = WebUserActive.id" + ^ " WHERE knd = " ^ C.intToSql (#id kind) + ^ " ORDER BY name, v"); + + print "\n\n" + end + in + print "HCoop Emergency Contact Information

HCoop Emergency Contact Information

\n"; + + print "

E-mail everyone (off-HCoop addresses)

\n\n"; + + app doOne kinds; + print "\n"; + C.close db; + OS.Process.success + end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n"); + OS.Process.failure) + +end diff --git a/contact/sources.cm b/contact/sources.cm new file mode 100644 index 0000000..75b9a16 --- /dev/null +++ b/contact/sources.cm @@ -0,0 +1,9 @@ +Group is + $/basis.cm + $/smlnj-lib.cm + /usr/local/share/smlsql/smlsql.cm + /usr/local/share/smlsql/libpq/sources.cm + /usr/local/share/mlt/src/lib/sources.cm + + contact.sig + contact.sml -- 2.20.1