From dda99898ec5a066642ae8e47550f6f6b518a9f56 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 22 Oct 2005 17:33:15 +0000 Subject: [PATCH] Low balance reminders --- config.sig | 9 +++++++++ config.sml | 10 ++++++++++ init.sig | 3 +++ init.sml | 9 ++------- remind/.cvsignore | 2 ++ remind/Makefile | 4 ++++ remind/remind.sh | 1 + remind/remind.sig | 4 ++++ remind/remind.sml | 38 ++++++++++++++++++++++++++++++++++++++ remind/sources.cm | 15 +++++++++++++++ support.sml | 2 +- 11 files changed, 89 insertions(+), 8 deletions(-) create mode 100644 config.sig create mode 100644 config.sml create mode 100644 remind/.cvsignore create mode 100644 remind/Makefile create mode 100755 remind/remind.sh create mode 100644 remind/remind.sig create mode 100644 remind/remind.sml create mode 100644 remind/sources.cm diff --git a/config.sig b/config.sig new file mode 100644 index 0000000..1fe37f8 --- /dev/null +++ b/config.sig @@ -0,0 +1,9 @@ +signature CONFIG = sig + +val scratchDir : string +val urlPrefix : string +val emailSuffix : string +val boardEmail : string +val dbstring : string + +end diff --git a/config.sml b/config.sml new file mode 100644 index 0000000..bb09703 --- /dev/null +++ b/config.sml @@ -0,0 +1,10 @@ +structure Config :> CONFIG = struct + +val scratchDir = "/home/hcoop" +val urlPrefix = "https://members.hcoop.net/portal/" +val emailSuffix = "@hcoop.net" +val boardEmail = "board" ^ emailSuffix + +val dbstring = "dbname='hcoop_hcoop'" + +end diff --git a/init.sig b/init.sig index 40db908..360b94e 100644 --- a/init.sig +++ b/init.sig @@ -17,6 +17,9 @@ signature INIT = sig val mkUserRow : C.value list -> user + (* Direct access to database connections *) + val conn : unit -> C.conn + (* Open or close a session, wrapped in a transaction *) val init : unit -> unit val done : unit -> unit diff --git a/init.sml b/init.sml index d8ceeb3..2507a45 100644 --- a/init.sml +++ b/init.sml @@ -1,18 +1,13 @@ structure Init :> INIT = struct -open Util Sql +open Util Sql Config structure C = PgClient exception Access of string exception NeedTos -val scratchDir = "/home/hcoop" -val urlPrefix = "https://members.hcoop.net/portal/" -val emailSuffix = "@hcoop.net" -val boardEmail = "board" ^ emailSuffix - -fun conn () = C.conn "dbname='hcoop_hcoop'" +fun conn () = C.conn dbstring val close = C.close type user = {id : int, name : string, rname : string, bal : int, joined : C.timestamp, diff --git a/remind/.cvsignore b/remind/.cvsignore new file mode 100644 index 0000000..8afcbd3 --- /dev/null +++ b/remind/.cvsignore @@ -0,0 +1,2 @@ +.cm +*.x86-linux diff --git a/remind/Makefile b/remind/Makefile new file mode 100644 index 0000000..d36b515 --- /dev/null +++ b/remind/Makefile @@ -0,0 +1,4 @@ +SMLBIN=/usr/local/sml/bin + +all: + $(SMLBIN)/ml-build sources.cm Remind.main remind diff --git a/remind/remind.sh b/remind/remind.sh new file mode 100755 index 0000000..06f8dbb --- /dev/null +++ b/remind/remind.sh @@ -0,0 +1 @@ +/usr/local/sml/bin/sml @SMLload=/home/hcoop/portal/remind/remind.x86-linux \ No newline at end of file diff --git a/remind/remind.sig b/remind/remind.sig new file mode 100644 index 0000000..f0f7bb9 --- /dev/null +++ b/remind/remind.sig @@ -0,0 +1,4 @@ +signature REMIND = +sig + val main : string * string list -> OS.Process.status +end diff --git a/remind/remind.sml b/remind/remind.sml new file mode 100644 index 0000000..b1252c1 --- /dev/null +++ b/remind/remind.sml @@ -0,0 +1,38 @@ +structure Remind :> REMIND = +struct + +open Config + +structure C = PgClient + +fun main _ = + let + val db = C.conn dbstring + + fun getEmail [name] = C.stringFromSql name ^ emailSuffix + | getEmail row = raise Fail "remind getName" + + val names = C.map db getEmail "SELECT WebUser.name FROM WebUser JOIN Balance ON Balance.name = WebUser.name WHERE amount < 10" + + val m = Mail.mopen () + in + Mail.mwrite (m, "Subject: Reminder of low HCoop balance\n"); + Mail.mwrite (m, "From: HCoop Portal \n"); + Mail.mwrite (m, "Bcc: "); + Mail.mwrite (m, String.concatWith "," names); + Mail.mwrite (m, "\n\n"); + Mail.mwrite (m, "This is a friendly reminder that your monetary balance at HCoop has dropped below\n"); + Mail.mwrite (m, "the US$10 \"deposit\" amount. You can check your balance at:\n"); + Mail.mwrite (m, "\t"); + Mail.mwrite (m, urlPrefix); + Mail.mwrite (m, "money\n\n"); + Mail.mwrite (m, "It would be great if you could bring your balance above that amount soon.\n"); + Mail.mwrite (m, "Information on how to pay can be found at:\n"); + Mail.mwrite (m, "\thttp://wiki.hcoop.net/wiki/MemberDues\n"); + C.close db; + OS.Process.success + end + +end diff --git a/remind/sources.cm b/remind/sources.cm new file mode 100644 index 0000000..8fb376b --- /dev/null +++ b/remind/sources.cm @@ -0,0 +1,15 @@ +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 + + ../mail.sig + ../mail.sml + + ../config.sig + ../config.sml + + remind.sig + remind.sml diff --git a/support.sml b/support.sml index 9c30d24..b8e7a80 100644 --- a/support.sml +++ b/support.sml @@ -1,4 +1,4 @@ -\structure Support :> SUPPORT = +structure Support :> SUPPORT = struct open Util Sql Init -- 2.20.1