[bpt/portal.git] / contact / 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

	fun peer1 () =
	    let
		val inf = TextIO.openIn "/afs/hcoop.net/user/h/hc/hcoop/contact/peer1.html"

		fun loop () =
		    case TextIO.inputLine inf of
			NONE => ()
		      | SOME line => (print line;
				      loop ())
	    in
		loop ();
		TextIO.closeIn inf
	    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:?Bcc=";
	print (String.concatWith "," (allEmails ()));
	print "\">E-mail everyone (off-HCoop addresses)</a></h2>\n\n";

	app doOne kinds;

	print "<h2>Peer 1 phone numbers</h2>\n\n";
	peer1 ();

	print "</body></html>\n";
	C.close db;
	OS.Process.success
    end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n");
			   OS.Process.failure)

end
Commit	Line	Data
259cc257 AC	1	structure Contact :> CONTACT =
	2	struct
	3
	4	structure C = PgClient
	5
	6	fun main _ =
	7	let
	8	val db = C.conn "dbname='hcoop_hcoop'"
	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