darcsden :: dbp -> remind -> blob

reminder application, uses a logarithmic falloff to time reminder emails

root / remind_daemon.ml

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 ()