* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+open CalendarLib
+
open Unix
open Printf
let target_exists vs = target (List.fold_left (||) false vs)
let require () = ()
+type period_t = Seconds | Days | Months | Years
+let seconds = (1, Seconds)
+let sec = seconds and secs = seconds and second = seconds
+let minutes = (60, Seconds)
+let min = minutes and mins = minutes and minute = minutes
+let hours = (3600, Seconds)
+let hour = hours
+let days = (1, Days)
+let day = days
+let weeks = (7, Days)
+let week = weeks
+let months = (1, Months)
+let month = months
+let years = (1, Years)
+let year = years
+
+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
+
+(* [next_time t period] returns the earliest event of [period]
+ strictly after time [t].
+
+ Visualising periods as repeated events on a timeline, this
+ returns [t']:
+
+ {v
+ events: ---+---------+---------+---------+---------+---------+-----
+ times: t t'
+ }
+
+ Note that [period_t] events are not necessarily regular.
+ eg. The start of a month is not a fixed number of seconds
+ after the start of the previous month. 'Epoch' refers
+ to the Unix Epoch (ie. 1970-01-01 00:00:00 UTC).
+
+ If [period = i, Seconds i] then events are when
+ [t' mod i == 0] when t' is the number of seconds since
+ the Epoch. This returns the next t' > t.
+
+ If [period = i, Days] then events happen at
+ midnight UTC every [i] days since the Epoch.
+ This returns the next midnight > t.
+
+ If [period = i, Months] then events happen at
+ midnight UTC on the 1st day of the month every [i] months
+ since the Epoch. This returns midnight on the
+ 1st day of the next month > t.
+
+ If [period = i, Years] then events happen at
+ midnight UTC on the 1st day of the year when
+ [(y - 1970) mod i == 0]. This returns midnight on the
+ 1st day of the next year > t. *)
+
+let next_time =
+ (* Round up 'a' to the next multiple of 'i'. *)
+ let round_up_float a i =
+ let r = mod_float a i in
+ if r = 0. then a +. i else a +. (i -. r)
+ and round_up a i =
+ let r = a mod i in
+ if r = 0 then a + i else a + (i - r)
+ in
+
+ fun t -> function
+ | (i, Seconds) ->
+ let i = float_of_int i in
+ round_up_float t i
+
+ | (i, Years) ->
+ let tm = gmtime t in
+
+ (* Round 'tm' up to the first day of the next year. *)
+ let year = round_up tm.tm_year i in
+ let tm = { tm with tm_sec = 0; tm_min = 0; tm_hour = 0;
+ tm_mday = 1; tm_mon = 0; tm_year = year } in
+ fst (mktime tm)
+
+ | (i, Days) ->
+ let t = Date.from_unixfloat t in
+ let t0 = Date.make 1970 1 1 in
+
+ (* Number of whole days since Unix Epoch. *)
+ let nb_days = Date.Period.safe_nb_days (Date.sub t t0) in
+
+ let nb_days = round_up nb_days i in
+ let t' = Date.add t0 (Date.Period.day nb_days) in
+ Date.to_unixfloat t'
+
+ | (i, Months) ->
+ (* Calculate number of whole months since Unix Epoch. *)
+ let tm = gmtime t in
+ let months = 12 * (tm.tm_year - 70) + tm.tm_mon in
+
+ let months = round_up months i in
+ let t0 = Date.make 1970 1 1 in
+ let t' = Date.add t0 (Date.Period.month months) in
+ Date.to_unixfloat t'
+
let file_exists = Sys.file_exists
+let directory_exists path =
+ let s =
+ try Some (stat path)
+ with
+ | Unix_error (ENOENT, _, _) -> None
+ | Unix_error (err, _, _) ->
+ let msg = sprintf "directory_exists: %s: %s" path (error_message err) in
+ goal_failed msg in
+ match s with
+ | Some s -> s.st_kind = S_DIR
+ | None -> false
+
let file_newer_than f1 f2 =
let stat f =
try Some (stat 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
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 =
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 []
exit 1
)
| [] ->
- (* Does a published 'all' goal exist? *)
- match get_goal "all" with
- | Some fn -> fn []
- | None ->
- (* No published 'all' goal. This is only a warning, because
- * other top-level code may exist in the script.
- *)
- eprintf "warning: no 'all' goal found.\n"
+ (* 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 next = List.map (
+ fun (period, 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);
+ sleep seconds;
+ ignore (guard f ())
+ 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)
git.annexia.org / goaljobs.git / blobdiff