From: Richard W.M. Jones Date: Thu, 23 Feb 2012 13:23:25 +0000 (+0000) Subject: Refactor state into a separate [Whenstate] module. X-Git-Tag: 0.0.3~10 X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=commitdiff_plain;h=108dd86b36e82df2a2029dbd12700f9c83e501c1 Refactor state into a separate [Whenstate] module. The new module contains all jobs and variables. --- diff --git a/daemon/daemon.ml b/daemon/daemon.ml index af2668f..6c3799c 100644 --- a/daemon/daemon.ml +++ b/daemon/daemon.ml @@ -26,24 +26,12 @@ open Printf (* See [exit.c]. *) external _exit : int -> 'a = "whenjobs__exit" -(* All jobs that are loaded. Maps name -> [job] structure. *) -let jobs = ref StringMap.empty - -(* Map variable names to jobs which depend on that variable. This - * gives us a quick way to tell which jobs might need to be reevaluated - * when a variable is set. - *) -let dependencies = ref StringMap.empty - -(* Current values of variables. Using the referentially transparent - * type Map is very useful here because it lets us cheaply keep - * previous values of variables. - *) -let variables : variables ref = ref StringMap.empty - (* $HOME/.whenjobs *) let jobsdir = ref "" +(* The state. *) +let state = ref Whenstate.empty + (* Jobs that are running; map of PID -> (job, other data). Note that * the job may no longer exist *OR* it may have been renamed, * eg. if the jobs file was reloaded. @@ -76,6 +64,7 @@ let rec init j d = let addr = sprintf "%s/socket" !jobsdir in (try unlink addr with Unix_error _ -> ()); + (* Create the Unix domain socket server. *) server := Some ( Whenproto_srv.When.V1.create_server ~proc_reload_file @@ -92,10 +81,8 @@ let rec init j d = (* Handle SIGCHLD to clean up jobs. *) Sys.set_signal Sys.sigchld (Sys.Signal_handle handle_sigchld); - (* Initialize the variables. XXX Eventually this will be saved - * and loaded from a persistent store. - *) - variables := StringMap.add "JOBSERIAL" (T_int zero_big_int) !variables + (* Initialize the variables. *) + state := Whenstate.set_variable !state "JOBSERIAL" (T_int zero_big_int) and proc_reload_file () = if !debug then Syslog.notice "remote call: reload_file"; @@ -126,11 +113,11 @@ and proc_set_variable (name, value) = loop 1; let value = variable_of_rpc value in - variables := StringMap.add name value !variables; + state := Whenstate.set_variable !state name value; (* Which jobs need to be re-evaluated? *) - let jobnames = try StringMap.find name !dependencies with Not_found -> [] in - reevaluate_whenjobs jobnames; + let jobs = Whenstate.get_dependencies !state name in + reevaluate_whenjobs jobs; `ok with @@ -139,17 +126,14 @@ and proc_set_variable (name, value) = and proc_get_variable name = if !debug then Syslog.notice "remote call: get_variable %s" name; - try rpc_of_variable (StringMap.find name !variables) - with (* all non-existent variables are empty strings *) - Not_found -> `string_t "" + rpc_of_variable (Whenstate.get_variable !state name) and proc_get_variable_names () = if !debug then Syslog.notice "remote call: get_variable_names"; - (* Only return variables that are non-empty. *) - let vars = StringMap.fold ( - fun name value xs -> if value <> T_string "" then name :: xs else xs - ) !variables [] in + let vars = Whenstate.get_variable_names !state in + + (* Return variable names as a sorted array. *) let vars = Array.of_list vars in Array.sort compare vars; vars @@ -168,14 +152,20 @@ and proc_exit_daemon () = (* Reload the jobs file. *) and reload_file () = let file = sprintf "%s/jobs.cmo" !jobsdir in - Whenfile.init (); - let js = + (* As we are reloading the file, we want to create a new state + * that has no jobs, but has all the variables from the previous + * state. + *) + let s = Whenstate.copy_variables !state Whenstate.empty in + Whenfile.init s; + + let s = try Dynlink.loadfile file; - let jobs = Whenfile.get_jobs () in - Syslog.notice "loaded %d job(s) from %s" (List.length jobs) file; - jobs + let s = Whenfile.get_state () in + Syslog.notice "loaded %d job(s) from %s" (Whenstate.nr_jobs s) file; + s with | Dynlink.Error err -> let err = Dynlink.error_message err in @@ -184,73 +174,49 @@ and reload_file () = | exn -> failwith (Printexc.to_string exn) in - (* Set 'jobs' and related global variables. *) - let () = - let map = List.fold_left ( - fun map j -> - let name = j.job_name in - StringMap.add name j map - ) StringMap.empty js in - jobs := map in - - let () = - let map = List.fold_left ( - fun map j -> - let deps = dependencies_of_job j in - let name = j.job_name in - List.fold_left ( - fun map d -> - let names = try StringMap.find d map with Not_found -> [] in - StringMap.add d (name :: names) map - ) map deps - ) StringMap.empty js in - dependencies := map in + state := s; (* Re-evaluate all when jobs. *) - reevaluate_whenjobs ~onload:true (StringMap.keys !jobs); + reevaluate_whenjobs ~onload:true (Whenstate.get_whenjobs !state); (* Schedule the next every job to run. *) schedule_next_everyjob () -(* Re-evaluate each named when-statement job, in a loop until we reach - * a fixpoint. Run those that need to be run. every-statement jobs - * are ignored here. +(* Re-evaluate each when-statement job, in a loop until we reach + * a fixpoint. Run those that need to be run. *) -and reevaluate_whenjobs ?(onload=false) jobnames = - let rec loop set jobnames = +and reevaluate_whenjobs ?onload jobs = + let rec loop set jobs = let set' = List.fold_left ( - fun set jobname -> - let job = - try StringMap.find jobname !jobs - with Not_found -> assert false in - assert (jobname = job.job_name); - - let r, job' = - try job_evaluate job !variables onload + fun set job -> + let r, state' = + try Whenstate.evaluate_whenjob ?onload !state job with Invalid_argument err | Failure err -> Syslog.error "error evaluating job %s (at %s): %s" - jobname (Camlp4.PreCast.Ast.Loc.to_string job.job_loc) err; - false, job in + job.job_name (Camlp4.PreCast.Ast.Loc.to_string job.job_loc) err; + false, !state in - jobs := StringMap.add jobname job' !jobs; + state := state'; if !debug then - Syslog.notice "evaluate %s -> %b\n" jobname r; + Syslog.notice "evaluate %s -> %b\n" job.job_name r; - if r then StringSet.add jobname set else set - ) set jobnames in + if r then StringSet.add job.job_name set else set + ) set jobs in if StringSet.compare set set' <> 0 then - loop set' jobnames + loop set' jobs else set' in - let set = loop StringSet.empty jobnames in + let set = loop StringSet.empty jobs in let jobnames = StringSet.elements set in + (* Ensure the jobs always run in predictable (name) order. *) let jobnames = List.sort compare_jobnames jobnames in - List.iter run_job - (List.map (fun jobname -> StringMap.find jobname !jobs) jobnames) + + (* Run the jobs. *) + List.iter run_job (List.map (Whenstate.get_job !state) jobnames) (* Schedule the next every-statement job to run, if there is one. We * look at the every jobs, work out the time that each must run at, @@ -262,11 +228,11 @@ and schedule_next_everyjob () = let t = time () in (* Get only everyjobs. *) - let jobs = StringMap.values !jobs in - let jobs = filter_map ( + let jobs = Whenstate.get_everyjobs !state in + let jobs = List.map ( function - | { job_cond = Every_job period } as job -> Some (job, period) - | { job_cond = When_job _ } -> None + | { job_cond = Every_job period } as job -> (job, period) + | { job_cond = When_job _ } -> assert false ) jobs in (* Map everyjob to next time it must run. *) @@ -345,10 +311,10 @@ and run_job job = let () = (* Increment JOBSERIAL. *) let serial = - match StringMap.find "JOBSERIAL" !variables with + match Whenstate.get_variable !state "JOBSERIAL" with | T_int serial -> let serial = succ_big_int serial in - variables := StringMap.add "JOBSERIAL" (T_int serial) !variables; + state := Whenstate.set_variable !state "JOBSERIAL" (T_int serial); serial | _ -> assert false in @@ -366,8 +332,9 @@ and run_job job = chdir dir; (* Set environment variables corresponding to each variable. *) - StringMap.iter - (fun name value -> putenv name (string_of_variable value)) !variables; + List.iter + (fun (name, value) -> putenv name (string_of_variable value)) + (Whenstate.get_variables !state); (* Set the $JOBNAME environment variable. *) putenv "JOBNAME" job.job_name; diff --git a/lib/Makefile.am b/lib/Makefile.am index 99ace91..61d0ad6 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -37,6 +37,8 @@ SOURCES = \ whenlock.mli \ whenproto_aux.ml \ whenproto_aux.mli \ + whenstate.ml \ + whenstate.mli \ whenutils.ml \ whenutils.mli @@ -47,6 +49,7 @@ CMI_FILES = \ whenfile.cmi \ whenlock.cmi \ whenproto_aux.cmi \ + whenstate.cmi \ whenutils.cmi # In dependency order. @@ -55,6 +58,7 @@ OBJECTS = \ whenproto_aux.cmo \ whenutils.cmo \ whenexpr.cmo \ + whenstate.cmo \ whenfile.cmo \ whenlock.cmo diff --git a/lib/whenexpr.ml b/lib/whenexpr.ml index 5b4bbdd..f24e9ed 100644 --- a/lib/whenexpr.ml +++ b/lib/whenexpr.ml @@ -105,23 +105,6 @@ let rpc_of_variable = function type variables = variable StringMap.t -type job_private = { - (* The result of the previous evaluation. This is used for - * implementing edge-triggering, since we only trigger the job to run - * when the state changes from false -> true. - * - * [None] means there has been no previous evaluation. - *) - job_prev_eval_state : bool option; - - (* When the job {i ran} last time, we take a copy of the variables. - * This allows us to implement the 'changes' operator. - * - * [None] means there has been no previous run. - *) - job_prev_variables : variables option; -} - type job_cond = | When_job of whenexpr | Every_job of periodexpr @@ -131,21 +114,8 @@ type job = { job_name : string; job_cond : job_cond; job_script : shell_script; - job_private : job_private; } -let make_when_job _loc name e sh = - { job_loc = _loc; job_name = name; - job_cond = When_job e; job_script = sh; - job_private = { job_prev_eval_state = None; - job_prev_variables = None } } - -let make_every_job _loc name e sh = - { job_loc = _loc; job_name = name; - job_cond = Every_job e; job_script = sh; - job_private = { job_prev_eval_state = None; - job_prev_variables = None } } - let rec expr_of_ast _loc ast = expr_of_iexpr _loc (iexpr_of_ast _loc ast) @@ -352,7 +322,7 @@ let dependencies_of_job = function | { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr | { job_cond = Every_job _ } -> [] -let rec eval_whenexpr job variables onload = function +let rec eval_whenexpr variables prev_variables onload = function | Expr_unit -> T_unit | Expr_bool b -> T_bool b | Expr_str s -> T_string s @@ -363,127 +333,127 @@ let rec eval_whenexpr job variables onload = function get_variable variables v | Expr_and (e1, e2) -> - if eval_whenexpr_as_bool job variables onload e1 && - eval_whenexpr_as_bool job variables onload e2 then + if eval_whenexpr_as_bool variables prev_variables onload e1 && + eval_whenexpr_as_bool variables prev_variables onload e2 then T_bool true else T_bool false | Expr_or (e1, e2) -> - if eval_whenexpr_as_bool job variables onload e1 || - eval_whenexpr_as_bool job variables onload e2 then + if eval_whenexpr_as_bool variables prev_variables onload e1 || + eval_whenexpr_as_bool variables prev_variables onload e2 then T_bool true else T_bool false | Expr_lt (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in if compare_values e1 e2 < 0 then T_bool true else T_bool false | Expr_le (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in if compare_values e1 e2 <= 0 then T_bool true else T_bool false | Expr_eq (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in if compare_values e1 e2 = 0 then T_bool true else T_bool false | Expr_ge (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in if compare_values e1 e2 >= 0 then T_bool true else T_bool false | Expr_gt (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in if compare_values e1 e2 > 0 then T_bool true else T_bool false | Expr_not e -> - if not (eval_whenexpr_as_bool job variables onload e) then + if not (eval_whenexpr_as_bool variables prev_variables onload e) then T_bool true else T_bool false | Expr_add (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in add_values e1 e2 | Expr_sub (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in sub_values e1 e2 | Expr_mul (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in mul_values e1 e2 | Expr_div (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in div_values e1 e2 | Expr_mod (e1, e2) -> - let e1 = eval_whenexpr job variables onload e1 - and e2 = eval_whenexpr job variables onload e2 in + let e1 = eval_whenexpr variables prev_variables onload e1 + and e2 = eval_whenexpr variables prev_variables onload e2 in mod_values e1 e2 | Expr_changes v -> - let prev_value, curr_value = get_prev_curr_value job variables v in + let prev_value, curr_value = get_prev_curr_value variables prev_variables v in if compare_values prev_value curr_value <> 0 then T_bool true else T_bool false | Expr_increases v -> - let prev_value, curr_value = get_prev_curr_value job variables v in + let prev_value, curr_value = get_prev_curr_value variables prev_variables v in if compare_values prev_value curr_value < 0 then T_bool true else T_bool false | Expr_decreases v -> - let prev_value, curr_value = get_prev_curr_value job variables v in + let prev_value, curr_value = get_prev_curr_value variables prev_variables v in if compare_values prev_value curr_value > 0 then T_bool true else T_bool false | Expr_prev v -> - get_prev_variable job v + get_prev_variable prev_variables v | Expr_reloaded -> T_bool onload -and get_prev_curr_value job variables v = - let prev_value = get_prev_variable job v in +and get_prev_curr_value variables prev_variables v = + let prev_value = get_prev_variable prev_variables v in let curr_value = get_variable variables v in prev_value, curr_value and get_variable variables v = try StringMap.find v variables with Not_found -> T_string "" -and get_prev_variable job v = - match job.job_private.job_prev_variables with +and get_prev_variable prev_variables v = + match prev_variables with | None -> (* Job has never run. XXX Should do better here. *) T_string "" @@ -491,8 +461,8 @@ and get_prev_variable job v = get_variable prev_variables v (* Call {!eval_whenexpr} and cast the result to a boolean. *) -and eval_whenexpr_as_bool job variables onload expr = - match eval_whenexpr job variables onload expr with +and eval_whenexpr_as_bool variables prev_variables onload expr = + match eval_whenexpr variables prev_variables onload expr with | T_unit -> false | T_bool r -> r | T_string s -> s <> "" @@ -591,31 +561,6 @@ and printable_string_of_variable = function | T_int i -> string_of_big_int i | T_float f -> string_of_float f -let job_evaluate job variables onload = - match job with - | { job_cond = Every_job _ } -> false, job - | { job_cond = When_job whenexpr } -> - let state = eval_whenexpr_as_bool job variables onload whenexpr in - - (* Because jobs are edge-triggered, we're only interested in the - * case where the evaluation state changes from false -> true. - *) - match job.job_private.job_prev_eval_state, state with - | None, false - | Some false, false - | Some true, true - | Some true, false -> - let jobp = { job.job_private with job_prev_eval_state = Some state } in - let job = { job with job_private = jobp } in - false, job - - | None, true - | Some false, true -> - let jobp = { job_prev_eval_state = Some true; - job_prev_variables = Some variables } in - let job = { job with job_private = jobp } in - true, job - let next_periodexpr = (* Round up 'a' to the next multiple of 'i'. *) let round_up_float a i = diff --git a/lib/whenexpr.mli b/lib/whenexpr.mli index 3c05826..c0c6fb2 100644 --- a/lib/whenexpr.mli +++ b/lib/whenexpr.mli @@ -75,9 +75,6 @@ val rpc_of_variable : variable -> Whenproto_aux.variable type variables = variable Whenutils.StringMap.t (** A set of variables. *) -type job_private -(** Private state associated with a job, used for evaluation. *) - type job_cond = | When_job of whenexpr (** when ... : << >> *) | Every_job of periodexpr (** every ... : << >> *) @@ -87,17 +84,8 @@ type job = { job_name : string; job_cond : job_cond; job_script : shell_script; - job_private : job_private; } -(** A job. Note that because of the [job_private] field, these cannot - be constructed directly. Use {!make_when_job} or {!make_every_job} - to construct one. *) - -val make_when_job : Camlp4.PreCast.Loc.t -> string -> whenexpr -> shell_script -> job -(** Make a when-statement job. *) - -val make_every_job : Camlp4.PreCast.Loc.t -> string -> periodexpr -> shell_script -> job -(** Make an every-statement job. *) +(** A job. *) val expr_of_ast : Camlp4.PreCast.Ast.Loc.t -> Camlp4.PreCast.Ast.expr -> whenexpr (** Convert OCaml AST to an expression. Since OCaml ASTs are much @@ -117,14 +105,26 @@ val dependencies_of_whenexpr : whenexpr -> string list val dependencies_of_job : job -> string list (** Which variables does this job depend on? *) -val job_evaluate : job -> variables -> bool -> bool * job -(** [job_evaluate job variables onload] evaluates [job]'s condition in - the context of the [variables], and return [true] iff it should be - run now. +val eval_whenexpr : variables -> variables option -> bool -> whenexpr -> variable +val eval_whenexpr_as_bool : variables -> variables option -> bool -> whenexpr -> bool +(** [eval_whenexpr variables prev_variables onload expr] is the + evaluation function for when expressions. It full evaluates + [expr], returning its typed value. It can also throw exceptions + (at least [Invalid_argument] and [Failure]). + + [eval_whenexpr_as_bool] is the same but it forces the returned + value to be a boolean. + + The other parameters represent the current and past state: + + [variables] is the current set of variables and their values. - Note that this returns a possibly-updated [job] structure. + [prev_variables] is the set of variables from the previous + run. It is used to implement {i prev}, {i changes} etc operators. + This can be [None], meaning there is no previous state. - This is a no-op for 'every' jobs. *) + [onload] is used to implement the {i reloaded} operator. It is + true if the file is being reloaded, and false otherwise. *) val next_periodexpr : float -> periodexpr -> float (** [next_periodexpr t period] returns the earliest event of [period] diff --git a/lib/whenfile.ml b/lib/whenfile.ml index 5f205fb..b109e66 100644 --- a/lib/whenfile.ml +++ b/lib/whenfile.ml @@ -20,19 +20,20 @@ open Whenexpr open Printf -(* The list of jobs in this file. *) -let jobs = ref [] +(* The state updated during parsing of the file. *) +let state = ref Whenstate.empty -let init () = jobs := [] +let init s = state := s let add_when_job _loc name e sh = let e = expr_of_ast _loc e in - let job = make_when_job _loc name e sh in - jobs := job :: !jobs + let job = { job_loc = _loc; job_name = name; + job_cond = When_job e; job_script = sh } in + state := Whenstate.add_job !state job let add_every_job _loc name e sh = - let job = make_every_job _loc name e sh in - jobs := job :: !jobs + let job = { job_loc = _loc; job_name = name; + job_cond = Every_job e; job_script = sh } in + state := Whenstate.add_job !state job -let get_jobs () = - List.rev !jobs +let get_state () = !state diff --git a/lib/whenfile.mli b/lib/whenfile.mli index b754cbc..54ee52d 100644 --- a/lib/whenfile.mli +++ b/lib/whenfile.mli @@ -18,12 +18,12 @@ (** This module is used when compiling whenjobs input files. *) -val init : unit -> unit -(** "Initialize" the module. Clear the list of jobs and other - internal variables so we are ready to parse a new file. *) +val init : Whenstate.t -> unit +(** "Initialize" the module. Pass in the initial state, ready for + parsing a new file. *) -val get_jobs : unit -> Whenexpr.job list -(** Get the jobs added since {!init} was called. *) +val get_state : unit -> Whenstate.t +(** Return the updated state. Call this after parsing the file. *) val add_when_job : Camlp4.PreCast.Loc.t -> string -> Camlp4.PreCast.Ast.expr -> Whenexpr.shell_script -> unit (** When a 'when' macro appears as a toplevel statement in an diff --git a/lib/whenstate.ml b/lib/whenstate.ml new file mode 100644 index 0000000..ddbc302 --- /dev/null +++ b/lib/whenstate.ml @@ -0,0 +1,152 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +open Whenutils +open Whenexpr + +type t = { + (* Variables. *) + variables : variables; + + (* Loaded jobs. *) + jobs : job list; + + (*--- below here is "internal" state ---*) + + jobmap : job StringMap.t; (* job name -> job structure *) + + (* Map variable names to jobs which depend on that variable. This + * gives us a quick way to tell which jobs might need to be reevaluated + * when a variable is set. + *) + dependencies : string list StringMap.t; (* variable -> list of job names *) + + (* For each job, if it has run, we store the previous variables + * at that time. This is used to implement {i previous}, {i changes} etc. + *) + prev_variables : variables StringMap.t; (* job name -> variables *) + + (* For each job, if it has been evaluated before (see {!job_evaluate}) + * then we store the previous result of evaluation here. This is + * used to implement edge-triggering. + *) + prev_eval_result : bool StringMap.t; (* job name -> bool *) +} + +let empty = { + variables = StringMap.empty; + jobs = []; + jobmap = StringMap.empty; + dependencies = StringMap.empty; + prev_variables = StringMap.empty; + prev_eval_result = StringMap.empty; +} + +let add_job t job = + let deps = dependencies_of_job job in + let dependencies' = List.fold_left ( + fun map d -> + let names = try StringMap.find d map with Not_found -> [] in + StringMap.add d (job.job_name :: names) map + ) t.dependencies deps in + + { t with + jobs = job :: t.jobs; + jobmap = StringMap.add job.job_name job t.jobmap; + dependencies = dependencies' + } + +let set_variable t name value = + { t with variables = StringMap.add name value t.variables } + +let copy_variables old t = + { t with variables = StringMap.fold StringMap.add old.variables t.variables } + +let get_variable t name = + try StringMap.find name t.variables with Not_found -> T_string "" + +let get_variables t = + StringMap.fold ( + fun name value xs -> + if value <> T_string "" then (name, value) :: xs else xs + ) t.variables [] + +let get_variable_names t = + StringMap.fold ( + fun name value xs -> if value <> T_string "" then name :: xs else xs + ) t.variables [] + +let nr_jobs t = List.length t.jobs + +let get_dependencies t name = + let jobnames = try StringMap.find name t.dependencies with Not_found -> [] in + List.map (fun jn -> + try + let j = StringMap.find jn t.jobmap in + (* If this asserts false, then there is a bug in {!add_job}. *) + assert (match j.job_cond with When_job _ -> true | _ -> false); + j + with Not_found -> + (* This should never happen. It would indicate some bug in the + * {!add_job} function. + *) + assert false + ) jobnames + +let get_whenjobs t = + List.filter (function { job_cond = When_job _ } -> true | _ -> false) t.jobs + +let get_everyjobs t = + List.filter (function { job_cond = Every_job _ } -> true | _ -> false) t.jobs + +let get_job t jobname = + try StringMap.find jobname t.jobmap with Not_found -> assert false + +let evaluate_whenjob ?(onload = false) t job = + match job with + | { job_cond = Every_job _ } -> assert false + | { job_cond = When_job whenexpr; job_name = jobname } -> + let prev_variables = + try Some (StringMap.find jobname t.prev_variables) + with Not_found -> None in + + let result = + eval_whenexpr_as_bool t.variables prev_variables onload whenexpr in + + let prev_eval_result = + try Some (StringMap.find jobname t.prev_eval_result) + with Not_found -> None in + + let t = { t with prev_eval_result = + StringMap.add jobname result t.prev_eval_result } in + + (* Because jobs are edge-triggered, we're only interested in the + * case where the evaluation state changes from false -> true. + *) + match prev_eval_result, result with + | None, false + | Some false, false + | Some true, true + | Some true, false -> + false, t + + | None, true + | Some false, true -> + let t = { t with prev_variables = + StringMap.add jobname t.variables t.prev_variables } in + true, t diff --git a/lib/whenstate.mli b/lib/whenstate.mli new file mode 100644 index 0000000..a8de795 --- /dev/null +++ b/lib/whenstate.mli @@ -0,0 +1,79 @@ +(* whenjobs + * Copyright (C) 2012 Red Hat Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + *) + +(** The state of jobs and variables. *) + +type t +(** This opaque, immutable type represents the state of jobs and + variables from a loaded and running jobs file. + + You can create an empty state by calling {!empty}. This state + has no jobs and no variables. + + You can then add jobs and set variables by calling + {!add_job} and {!set_variable}. You can also copy variables + from an old state to a new state (used when reloading the + jobs file). + + The rest of the functions deal with querying the state + and are mainly used by the daemon (see [Daemon] module). *) + +val empty : t +(** Return an empty state. This state has no jobs or variables. *) + +val add_job : t -> Whenexpr.job -> t +(** Add a job to the state, returning a new state. *) + +val set_variable : t -> string -> Whenexpr.variable -> t +(** Set/update the value of a variable, returning a new state. *) + +val copy_variables : t -> t -> t +(** [copy_variables old_state current_state -> new_state] copies + the variables from [old_state], adding them to [current_state], + returning a new state. Note the order of arguments. *) + +val get_variable : t -> string -> Whenexpr.variable +(** Return the value of a variable, when unknown variables defaulting + to empty string. *) + +val get_variables : t -> (string * Whenexpr.variable) list +(** Return the value of all variables. Variables that are empty + strings are not returned. *) + +val get_variable_names : t -> string list +(** Return all variable names. Variables that are empty strings are + ignored. *) + +val nr_jobs : t -> int +(** Returns the number of jobs in the state. *) + +val get_dependencies : t -> string -> Whenexpr.job list +(** Return the jobs which depend on the named variable. *) + +val get_whenjobs : t -> Whenexpr.job list +val get_everyjobs : t -> Whenexpr.job list +(** Return all of the when-jobs / every-jobs. *) + +val get_job : t -> string -> Whenexpr.job +(** Return the named job. *) + +val evaluate_whenjob : ?onload:bool -> t -> Whenexpr.job -> bool * t +(** This evaluates the whenjob and returns [true] iff the whenjob + should be run now. + + Note that this returns a possibly-updated state structure. *) diff --git a/tests/parsing/test_load.ml b/tests/parsing/test_load.ml index 6cb9f9e..9398eb4 100644 --- a/tests/parsing/test_load.ml +++ b/tests/parsing/test_load.ml @@ -29,7 +29,7 @@ let file = Sys.argv.(1) let () = - Whenfile.init (); + Whenfile.init Whenstate.empty; (try Dynlink.loadfile file @@ -39,5 +39,6 @@ let () = exit 1 ); - let jobs = Whenfile.get_jobs () in - printf "test_load: %s: %d jobs parsed from file\n" file (List.length jobs) + let state = Whenfile.get_state () in + printf "test_load: %s: %d jobs parsed from file\n" + file (Whenstate.nr_jobs state) diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml index f8a0659..3383c91 100644 --- a/tools/whenjobs.ml +++ b/tools/whenjobs.ml @@ -249,7 +249,7 @@ and upload_file () = ); (* Test-load the jobs file to ensure it makes sense. *) - Whenfile.init (); + Whenfile.init Whenstate.empty; (try Dynlink.loadfile cmo_file with