From: Richard W.M. Jones Date: Tue, 17 Sep 2013 17:13:43 +0000 (+0100) Subject: Add periodic jobs using 'every' keyword. X-Git-Tag: 0.2~29 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=f921f7b52fe82782fe6ef1bc72e58200fed77d5a;p=goaljobs.git Add periodic jobs using 'every' keyword. --- diff --git a/META.in b/META.in index 479a8c6..ff06cf9 100644 --- a/META.in +++ b/META.in @@ -1,7 +1,7 @@ name="goaljobs" version="@PACKAGE_VERSION@" description="make & cron replacement and business rules manager" -requires="unix" +requires="unix,calendar" archive(byte)="goaljobs.cma" archive(native)="goaljobs.cmxa" diff --git a/common-rules.mk b/common-rules.mk index c11bc82..812bd62 100644 --- a/common-rules.mk +++ b/common-rules.mk @@ -18,7 +18,7 @@ CLEANFILES = *~ *.cmi *.cmo *.cmx *.cma *.cmxa *.o OCAMLCFLAGS = -g -warn-error CDEFLMPSUVYZX -OCAMLCPACKAGES = -package unix -I $(top_builddir) +OCAMLCPACKAGES = -package unix,calendar -I $(top_builddir) OCAMLOPTFLAGS = $(OCAMLCFLAGS) OCAMLOPTPACKAGES = $(OCAMLCPACKAGES) diff --git a/configure.ac b/configure.ac index 81ea6b7..755c339 100644 --- a/configure.ac +++ b/configure.ac @@ -82,6 +82,12 @@ if test "x$OCAMLFIND" = "xno"; then AC_MSG_ERROR([You must install OCaml findlib (the ocamlfind command)]) fi +dnl OCaml calendar library is required. +AC_CHECK_OCAML_PKG(calendar) +if test "x$OCAML_PKG_calendar" = "xno"; then + AC_MSG_ERROR([You must install OCaml calendar library version 2]) +fi + dnl Check for curl (for URL testing, downloads). AC_CHECK_PROG(CURL,curl,curl) if test "x$CURL" = "x"; then diff --git a/goaljobs b/goaljobs index cc8d003..defb248 100755 --- a/goaljobs +++ b/goaljobs @@ -120,13 +120,19 @@ if [ "$pkgdir" = "" ]; then pkg[0]="-package" pkg[1]="goaljobs,goaljobs.syntax" else + # Get the dependencies manually. Note that calendar requires + # unix & str. pkgdir="$(cd $pkgdir; pwd)" pkg[0]="-I" pkg[1]="$pkgdir" pkg[2]="unix.$libext" - pkg[3]="goaljobs.$libext" - pkg[4]="-pp" - pkg[5]="camlp4o $pkgdir/pa_goal.cmo" + pkg[3]="str.$libext" + pkg[4]="-I" + pkg[5]="+calendar" + pkg[6]="calendarLib.$libext" + pkg[7]="goaljobs.$libext" + pkg[8]="-pp" + pkg[9]="camlp4o $pkgdir/pa_goal.cmo" fi # Compile the input file(s). diff --git a/goaljobs.ml b/goaljobs.ml index d62a3d9..48765aa 100644 --- a/goaljobs.ml +++ b/goaljobs.ml @@ -16,6 +16,8 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open CalendarLib + open Unix open Printf @@ -35,8 +37,122 @@ let target_all vs = target (List.fold_left (&&) true vs) 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) @@ -349,11 +465,43 @@ Options: 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) diff --git a/goaljobs.mli b/goaljobs.mli index bc47f6d..a265dff 100644 --- a/goaljobs.mli +++ b/goaljobs.mli @@ -112,6 +112,82 @@ val require : unit -> unit the requirements of a rule can be placed anywhere within the rule, as long as you put them before they are needed. *) +(** {2 Periodic jobs} + + If you want to have a rule that runs when some outside event + happens you have three choices: Manually run the script (this is + basically what [make] forces you to do). Have some sort of hook + that runs the script (eg. a git hook). Or use a periodic job to + poll for an event or change. + + Periodic jobs run regularly to poll for an outside event or + change. If a script has periodic jobs, then it runs continuously + (or until you kill it). + + An example of a script that checks for new git commits and when + it sees one it will ensure it passes the tests: + + {v + let repo = Sys.getenv "HOME" // "repo" + + let goal git_commit_tested commit = + let key = sprintf "repo-tested-%s" commit in + target (memory_exists key); + + sh " + git clone %s test + cd test + ./configure + make + make check + "; + + (* Record that this commit was tested successfully. *) + memory_set key "1" + + every 30 minutes (fun () -> + let commit = shout "cd %s && git rev-parse HEAD" repo in + (* Require that this commit has been tested. *) + require (git_commit_tested commit) + ) + } + + Some notes about the above example: Firstly only the current HEAD + commit is required to be tested. This is because older commits + are irrelevant and because if they failed the test before there is + not point retesting them (commits are immutable). Secondly we use + the Memory to remember that we have successfully tested a commit. + This is what stops the program from repeatedly testing the same + commit. *) + +(* This is what lets you write '30 minutes' etc: *) +type period_t = Seconds | Days | Months | Years +val seconds : int * period_t +val sec : int * period_t +val secs : int * period_t +val second : int * period_t +val minutes : int * period_t +val min : int * period_t +val mins : int * period_t +val minute : int * period_t +val hours : int * period_t +val hour : int * period_t +val days : int * period_t +val day : int * period_t +val weeks : int * period_t +val week : int * period_t +val months : int * period_t +val month : int * period_t +val years : int * period_t +val year : int * period_t + +val every : ?name:string -> int -> int * period_t -> (unit -> unit) -> unit + (** [every N (seconds|minutes|hours|days|weeks|months|years) f] + runs the function [f] periodically. + + The optional [~name] parameter can be used to name the job + (for debugging). *) + (** {2 File and URL testing} Various functions to test the existence of files, URLs.