Periodic tasks

5 files changed, 97 insertions, 8 deletions

diff --git a/src/c/request.c b/src/c/request.c
index e51f95ae..b49a524e 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -79,9 +79,44 @@ static void *ticker(void *data) {
   return NULL;
 }
 
+typedef struct {
+  uw_app *app;
+  void *logger_data;
+  uw_logger log_error, log_debug;
+} loggers;
+
+typedef struct {
+  loggers *ls;
+  uw_periodic pdic;
+} periodic;
+
+static void *periodic_loop(void *data) {
+  periodic *p = (periodic *)data;
+  uw_context ctx = uw_request_new_context(p->ls->app, p->ls->logger_data, p->ls->log_error, p->ls->log_debug);
+
+  if (!ctx)
+    exit(1);
+
+  while (1) {
+    failure_kind r;
+    do {
+      r = uw_runCallback(ctx, p->pdic.callback);
+    } while (r == UNLIMITED_RETRY);
+
+    sleep(p->pdic.period);
+  };
+}
+
 void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug) {
   uw_context ctx;
   failure_kind fk;
+  uw_periodic *ps;
+  loggers *ls = malloc(sizeof(loggers));
+
+  ls->app = app;
+  ls->logger_data = logger_data;
+  ls->log_error = log_error;
+  ls->log_debug = log_debug;
 
   uw_global_init();
   uw_app_init(app);
@@ -113,6 +148,18 @@ void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_log
   }
 
   uw_free(ctx);
+
+  for (ps = app->periodics; ps->callback; ++ps) {
+    pthread_t thread;
+    periodic *arg = malloc(sizeof(periodic));
+    arg->ls = ls;
+    arg->pdic = *ps;
+    
+    if (pthread_create(&thread, NULL, periodic_loop, arg)) {
+      fprintf(stderr, "Error creating periodic thread\n");
+      exit(1);
+    }
+  }  
 }
 
 
@@ -468,12 +515,6 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
   }
 }
 
-typedef struct {
-  uw_app *app;
-  void *logger_data;
-  uw_logger log_error, log_debug;
-} loggers;
-
 void *client_pruner(void *data) {
   loggers *ls = (loggers *)data;
   uw_context ctx = uw_request_new_context(ls->app, ls->logger_data, ls->log_error, ls->log_debug);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 2b54e87c..0356e0fa 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -3492,3 +3492,19 @@ uw_Basis_postBody uw_getPostBody(uw_context ctx) {
   else
     uw_error(ctx, FATAL, "Asked for POST body when none exists");
 }
+
+failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) {
+  int r = setjmp(ctx->jmp_buf);
+
+  if (ctx->app->db_begin(ctx))
+    uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN");
+
+  if (r == 0) {
+    callback(ctx);
+    uw_commit(ctx);
+  }
+  else
+    uw_rollback(ctx, 0);
+
+  return r;
+}
diff --git a/src/cjr.sml b/src/cjr.sml
index c57128cf..7ea665ce 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -103,7 +103,7 @@ datatype exp' =
 
 withtype exp = exp' located
 
-datatype task = Initialize | ClientLeaves
+datatype task = Initialize | ClientLeaves | Periodic of Int64.int
 
 datatype decl' =
          DStruct of int * (string * typ) list
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 2bb5775e..b4f75eb5 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2796,6 +2796,7 @@ fun p_file env (ds, ps) =
 
         val initializers = List.mapPartial (fn (DTask (Initialize, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
         val expungers = List.mapPartial (fn (DTask (ClientLeaves, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds
+        val periodics = List.mapPartial (fn (DTask (Periodic n, x1, x2, e), _) => SOME (n, x1, x2, e) | _ => NONE) ds
 
         val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds
 
@@ -2887,6 +2888,36 @@ fun p_file env (ds, ps) =
              newline,
              newline,
 
+             box (ListUtil.mapi (fn (i, (_, x1, x2, e)) =>
+                                    box [string "static void uw_periodic",
+                                         string (Int.toString i),
+                                         string "(uw_context ctx) {",
+                                         newline,
+                                         box [string "uw_unit __uwr_",
+                                              string x1,
+                                              string "_0 = uw_unit_v, __uwr_",
+                                              string x2,
+                                              string "_1 = uw_unit_v;",
+                                              newline,
+                                              p_exp (E.pushERel (E.pushERel env x1 dummyt) x2 dummyt) e,
+                                              string ";",
+                                              newline],
+                                         string "}",
+                                         newline,
+                                         newline]) periodics),
+
+             string "static uw_periodic my_periodics[] = {",
+             box (ListUtil.mapi (fn (i, (n, _, _, _)) =>
+                                    box [string "{uw_periodic",
+                                         string (Int.toString i),
+                                         string ",",
+                                         space,
+                                         string (Int64.toString n),
+                                         string "},"]) periodics),
+             string "{NULL}};",
+             newline,
+             newline,
+
              string "static const char begin_xhtml[] = \"<?xml version=\\\"1.0\\\" encoding=\\\"utf-8\\\" ?>\\n<!DOCTYPE html PUBLIC \\\"-//W3C//DTD XHTML 1.0 Transitional//EN\\\" \\\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\\\">\\n<html xmlns=\\\"http://www.w3.org/1999/xhtml\\\" xml:lang=\\\"en\\\" lang=\\\"en\\\">\";",
              newline,
              newline,
@@ -3043,7 +3074,7 @@ fun p_file env (ds, ps) =
                          "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close",
                          "uw_handle",
                          "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime",
-                         case onError of NONE => "NULL" | SOME _ => "uw_onError"],
+                         case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics"],
              string "};",
              newline]
     end
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 0505af62..9c297fad 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -667,6 +667,7 @@ fun cifyDecl ((d, loc), sm) =
                  val tk = case #1 e1 of
                               L.EFfi ("Basis", "initialize") => L'.Initialize
                             | L.EFfi ("Basis", "clientLeaves") => L'.ClientLeaves
+                            | L.EFfiApp ("Basis", "periodic", [(L.EPrim (Prim.Int n), _)]) => L'.Periodic n
                             | _ => (ErrorMsg.errorAt loc "Task kind not fully determined";
                                     L'.Initialize)
                  val (e, sm) = cifyExp (e, sm)