Update of /cvsroot/hcoop/portal/contact
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv20698/contact
Added Files:
.cvsignore Makefile contact.sh contact.sig contact.sml
sources.cm
Log Message:
Contact info dumper
--- NEW FILE: .cvsignore ---
.cm
*.x86-linux
--- NEW FILE: contact.sml ---
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 "<li> ";
print (Web.html name);
print ": ";
case #url kind of
NONE => print (Web.html v)
| SOME (pre, post) =>
(print "<a href=\"";
print (Web.html (pre ^ v ^ post));
print "\">";
print (Web.html v);
print "</a>");
print "</li>\n"
end
| doOne _ = raise Fail "Bad Contact row"
in
print "<h2>";
print (#name kind);
print "</h2>\n<ol>\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 "</ol>\n\n"
end
in
print "<html><head><title>HCoop Emergency Contact
Information</title></head><body><h1>HCoop Emergency Contact Information</h1>\n";
print "<h2><a href=\"mailto:";;
print (String.concatWith "," (allEmails ()));
print "\">E-mail everyone (off-HCoop addresses)</a></h2>\n\n";
app doOne kinds;
print "</body></html>\n";
C.close db;
OS.Process.success
end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n");
OS.Process.failure)
end
--- NEW FILE: Makefile ---
SMLBIN=/usr/local/sml/bin
all:
$(SMLBIN)/ml-build sources.cm Contact.main contact
--- NEW FILE: contact.sh ---
/usr/local/sml/bin/sml
@SMLload=/afs/hcoop.net/user/h/hc/hcoop/portal/contact/contact.x86-linux
--- NEW FILE: sources.cm ---
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
--- NEW FILE: contact.sig ---
signature CONTACT =
sig
val main : string * string list -> OS.Process.status
end
-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
hcoop-cvs mailing list
hcoop-cvs@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/hcoop-cvs
