X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=goaljobs.ml;h=b5981ad78a6988c9f7c701ac411512ea39ee5f4a;hb=90eaa31d3acea2c640d662323142776a3eab517c;hp=48765aa244db0125025cb316b05015530186207c;hpb=f921f7b52fe82782fe6ef1bc72e58200fed77d5a;p=goaljobs.git

diff --git a/goaljobs.ml b/goaljobs.ml
index 48765aa..b5981ad 100644
--- a/goaljobs.ml
+++ b/goaljobs.ml
@@ -58,7 +58,7 @@ let periodic_jobs = ref []
 (* Register a periodic job. *)
 let every ?name i (j, t) f =
   let period = i*j, t in (* 5 minutes -> ((5 * 60), Seconds) *)
-  periodic_jobs := (period, name, f) :: !periodic_jobs
+  periodic_jobs := (period, (name, f)) :: !periodic_jobs
 
 (* [next_time t period] returns the earliest event of [period]
    strictly after time [t].
@@ -323,6 +323,18 @@ let with_memory_locked ?(write = false) f =
   let filename = getenv "HOME" // ".goaljobs-memory" in
   let fd = openfile filename [O_RDWR; O_CREAT] 0o644 in
   lockf fd (if write then F_LOCK else F_RLOCK) 0;
+  (* If the file is newly created with zero size, write an
+   * empty hash table.
+   *)
+  if (fstat fd).st_size = 0 then (
+    let empty : (string, string) Hashtbl.t = Hashtbl.create 13 in
+    let chan = out_channel_of_descr fd in
+    output_value chan empty;
+    Pervasives.flush chan;
+    ignore (lseek fd 0 SEEK_SET)
+  );
+
+  (* Run the function. *)
   let r = try Either (f fd) with exn -> Or (exn) in
   lockf fd F_ULOCK 0;
   match r with
@@ -353,7 +365,8 @@ let memory_set key value =
       Hashtbl.replace memory key value;
       let chan = out_channel_of_descr fd in
       seek_out chan 0;
-      output_value chan memory
+      output_value chan memory;
+      Pervasives.flush chan;
   )
 
 let memory_delete key =
@@ -364,7 +377,8 @@ let memory_delete key =
       Hashtbl.remove memory key;
       let chan = out_channel_of_descr fd in
       seek_out chan 0;
-      output_value chan memory
+      output_value chan memory;
+      Pervasives.flush chan;
   )
 
 let published_goals = ref []
@@ -377,6 +391,11 @@ let goal_file_exists filename =
     let msg = sprintf "file '%s' required but not found" filename in
     goal_failed msg
   )
+let goal_directory_exists path =
+  if not (directory_exists path) then (
+    let msg = sprintf "directory '%s' required but not found" path in
+    goal_failed msg
+  )
 let goal_file_newer_than f1 f2 =
   if not (file_newer_than f1 f2) then (
     let msg = sprintf "file %s is required to be newer than %s" f1 f2 in
@@ -409,8 +428,18 @@ let goal_memory_exists k =
     goal_failed msg
   )
 
+let guard fn arg =
+  try fn arg; true
+  with
+  | Goal_result (Goal_failed msg) ->
+    prerr_endline ("error: " ^ msg);
+    false
+  | exn ->
+    prerr_endline (Printexc.to_string exn);
+    false
+
 (* Run the program. *)
-let init () =
+let rec init () =
   let prog = Sys.executable_name in
   let prog = Filename.basename prog in
 
@@ -455,10 +484,11 @@ Options:
   let args = List.rev !args in
 
   (* Was a goal named on the command line? *)
-  match args with
+  (match args with
   | name :: args ->
     (match get_goal name with
-    | Some fn -> fn args
+    | Some fn ->
+      exit (if guard fn args then 0 else 1)
     | None ->
       eprintf "error: no goal called '%s' was found.\n" name;
       eprintf "Use %s -l to list all published goals in this script.\n" name;
@@ -484,20 +514,31 @@ Options:
   while true do
     (* Find the next job to run. *)
     let now = time () in
-    let next = List.map (
-      fun (period, name, f) ->
-        next_time now period, name, f
+    let jobs = List.map (
+      fun (period, (_, _ as name_f)) ->
+        next_time now period, name_f
     ) !periodic_jobs in
-    let next = List.sort (fun (t1,_,_) (t2,_,_) -> compare t1 t2) next in
-    let next_t, name, f = List.hd next in
-
-    let name = match name with Some name -> name | None -> "[unnamed]" in
-
-    (* Run it after waiting for the appropriate amount of time. *)
-    let seconds = int_of_float (next_t -. now) in
-    eprintf "next job '%s' will run in %s\n%!" name (printable_seconds seconds);
+    let jobs = List.sort (fun (t1,_) (t2,_) -> compare t1 t2) jobs in
+
+    (* Find all jobs that have the same next time.
+     * XXX When we can handle parallel jobs we can do better here,
+     * but until them run all the ones which have the same time
+     * in series.
+     *)
+    let next_t = int_of_float (fst (List.hd jobs)) in
+    let jobs = List.filter (fun (t, _) -> int_of_float t = next_t) jobs in
+
+    (* Run next job(s) after waiting for the appropriate amount of time. *)
+    let seconds = next_t - int_of_float now in
+    eprintf "next job will run in %s\n%!" (printable_seconds seconds);
     sleep seconds;
-    ignore (guard f ())
+
+    List.iter (
+      fun (_, (name, f)) ->
+        eprintf "running job: %s\n%!"
+          (match name with Some name -> name | None -> "[unnamed]");
+        ignore (guard f ())
+    ) jobs
   done
 
 and printable_seconds s =