reminder application, uses a logarithmic falloff to time reminder emails
type reminder = { id : string; description: string; registered: float; due: float;
contact : string list; inactive : string list} with orm
type account = { email : string; token : string; count : int } with orm
let db_name = "/var/www/ocsigen/reminder.db"
let frequency = 60. (* seconds *)
let time_left due =
match (due -. (Unix.time ())) with
| t when t < 0. -> " is OVERDUE!"
| t when t < 60. -> " in less than a minute"
| t when t < 3600. -> " in " ^ (string_of_int (int_of_float (t/.60.))) ^ " minutes"
| t when t < 86400. -> " in " ^ (string_of_int (int_of_float (t/.3600.))) ^ " hours"
| t when t < 2678400. -> " in " ^ (string_of_int (int_of_float (t/.86400.))) ^ " days"
| t when t < 32140800. -> " in " ^ (string_of_int (int_of_float (t/.2678400.))) ^ " months"
| t -> "in over a year"
let done_uri id em tok =
"http://lab.dbpatterson.com/remind/done?id=" ^ id
^ "&email=" ^ em ^ "&token=" ^ tok
let send_reminder r =
let db_acc = account_init_read_only db_name in
List.iter (fun em ->
(* No one should be in 'contact' if they have no acnt, so this should be safe*)
let a = List.hd (account_get ~email:(`Eq em) db_acc) in
begin
Printf.printf "Sending to %s...\nReminder:\n %s \nDUE %s\n%s\n" em r.description (time_left r.due) (done_uri r.id em a.token);
if BatString.ends_with em "@txt.att.net"
then (* wicked short version for my mobile *)
Sendmail.sendmail
("", em)
"REMINDER"
((BatString.slice ~last:40 r.description) ^ " due " ^ (time_left r.due) ^ (done_uri r.id em a.token))
()
else (* Regular email version *)
Sendmail.sendmail
("", em)
("REMINDER: " ^ (BatString.slice ~last:40 r.description) ^ " due " ^ (time_left r.due))
("Reminder: " ^ r.description ^ " due " ^ (time_left r.due) ^ "\n\n"
^ "Mark done: " ^ (done_uri r.id em a.token) ^ "\n\nView all your tasks: http://lab.dbpatterson.com/remind/who?email=" ^ em ^ "&token=" ^ a.token)
()
end) r.contact
let rec half_life n = if n < 60. then [] else ((n /. 2.) :: (half_life (n /. 2.)))
let updateable r =
let now = Unix.time () in
let eta = r.due -. now in
let start_diff = r.due -. r.registered in
match (List.filter (fun t -> abs_float(eta -. t) < ((frequency /. 2.) +. 1.)) (BatList.take 5 (half_life start_diff))) with
|[] -> false
|(_::_) -> true
let run_reminders () =
let db = reminder_init_read_only db_name in
let outstanding = reminder_get db in
let update_ready = List.filter updateable outstanding in
begin
Printf.printf "Outstanding: %d\nUpdate_ready: %d\n" (List.length outstanding) (List.length update_ready);
List.iter (fun r -> send_reminder r)
update_ready
end
let rec main () = begin
Printf.printf "Running reminders\n";
run_reminders ();
flush_all();
Unix.sleep (int_of_float frequency);
main ()
end
let () = main ()
|