+
+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 rec init () =
+ let prog = Sys.executable_name in
+ let prog = Filename.basename prog in
+
+ (* Save the current working directory when the program started. *)
+ putenv "builddir" (getcwd ());
+
+ let args = ref [] in
+
+ let display_version () =
+ printf "%s %s\n" package_name package_version;
+ exit 0
+ in
+
+ let list_goals () =
+ let names = !published_goals in
+ let names = List.map fst names in
+ let names = List.sort compare names in
+ List.iter print_endline names;
+ exit 0
+ in
+
+ let argspec = Arg.align [
+ "--goals", Arg.Unit list_goals, " List all goals";
+ "-l", Arg.Unit list_goals, " List all goals";
+ "-V", Arg.Unit display_version, " Display version number and exit";
+ "--version", Arg.Unit display_version, " Display version number and exit";
+ ] in
+ let anon_fun str = args := str :: !args in
+ let usage_msg = sprintf "\
+%s: a script generated by goaljobs
+
+List all goals: %s -l
+Run a single goal like this: %s <name-of-goal> [<goal-args ...>]
+
+For more information see the goaljobs(1) man page.
+
+Options:
+" prog prog prog in
+
+ Arg.parse argspec anon_fun usage_msg;
+
+ let args = List.rev !args in
+
+ (* Was a goal named on the command line? *)
+ (match args with
+ | name :: args ->
+ (match get_goal name with
+ | 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;
+ exit 1
+ )
+ | [] ->
+ (* If periodic jobs exist, fall through. *)
+ if !periodic_jobs = [] then (
+ (* Does a published 'all' goal exist? *)
+ match get_goal "all" with
+ | Some fn ->
+ exit (if guard fn [] then 0 else 1)
+ | None ->
+ (* No published 'all' goal. *)
+ eprintf "error: no goal called 'all' was found.\n";
+ exit 1
+ )
+ );
+
+ assert (!periodic_jobs <> []);
+
+ (* Run the periodic jobs. Note these run forever, or until killed. *)
+ while true do
+ (* Find the next job to run. *)
+ let now = time () in
+ let jobs = List.map (
+ fun (period, (_, _ as name_f)) ->
+ next_time now period, name_f
+ ) !periodic_jobs in
+ 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;
+
+ 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 =
+ if s < 60 then sprintf "%d seconds" s
+ else if s < 6000 then sprintf "%d minutes, %d seconds" (s/60) (s mod 60)
+ else if s < 86400 then sprintf "%d hours, %d minutes" (s/3600) (s/60)
+ else sprintf "about %d days" (s/86400)