The reloaded() function is true only when we have just loaded a new
file.
This lets you initialize variables, with some caveats.
dependencies := map in
(* Re-evaluate all when jobs. *)
dependencies := map in
(* Re-evaluate all when jobs. *)
- reevaluate_whenjobs (StringMap.keys !jobs);
+ reevaluate_whenjobs ~onload:true (StringMap.keys !jobs);
(* Schedule the next every job to run. *)
schedule_next_everyjob ()
(* Schedule the next every job to run. *)
schedule_next_everyjob ()
* a fixpoint. Run those that need to be run. every-statement jobs
* are ignored here.
*)
* a fixpoint. Run those that need to be run. every-statement jobs
* are ignored here.
*)
-and reevaluate_whenjobs jobnames =
+and reevaluate_whenjobs ?(onload=false) jobnames =
let rec loop set jobnames =
let set' =
List.fold_left (
let rec loop set jobnames =
let set' =
List.fold_left (
assert (jobname = job.job_name);
let r, job' =
assert (jobname = job.job_name);
let r, job' =
- try job_evaluate job !variables
+ try job_evaluate job !variables onload
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;
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;
- BOOL_T = 0,
- STRING_T = 1,
- INT_T = 2,
- FLOAT_T = 3
+ UNIT_T = 0,
+ BOOL_T = 1,
+ STRING_T = 2,
+ INT_T = 3,
+ FLOAT_T = 4
};
union variable switch (variable_type t) {
};
union variable switch (variable_type t) {
case BOOL_T:
bool b;
case STRING_T:
case BOOL_T:
bool b;
case STRING_T:
| None -> filter_map f xs
type whenexpr =
| None -> filter_map f xs
type whenexpr =
| Expr_bool of bool
| Expr_str of string
| Expr_int of Big_int.big_int
| Expr_bool of bool
| Expr_str of string
| Expr_int of Big_int.big_int
| Expr_increases of string
| Expr_decreases of string
| Expr_prev of string
| Expr_increases of string
| Expr_decreases of string
| Expr_prev of string
(* This internal type is used during conversion of the OCaml AST
* to the whenexpr type.
*)
type whenexpr_int =
(* This internal type is used during conversion of the OCaml AST
* to the whenexpr type.
*)
type whenexpr_int =
| IExpr_bool of bool
| IExpr_str of string
| IExpr_int of Big_int.big_int
| IExpr_bool of bool
| IExpr_str of string
| IExpr_int of Big_int.big_int
| T_bool of bool
| T_string of string
| T_int of big_int
| T_float of float
let variable_of_rpc = function
| T_bool of bool
| T_string of string
| T_int of big_int
| T_float of float
let variable_of_rpc = function
| `bool_t b -> T_bool b
| `string_t s -> T_string s
| `int_t i -> T_int (big_int_of_string i)
| `float_t f -> T_float f
let rpc_of_variable = function
| `bool_t b -> T_bool b
| `string_t s -> T_string s
| `int_t i -> T_int (big_int_of_string i)
| `float_t f -> T_float f
let rpc_of_variable = function
| T_bool b -> `bool_t b
| T_string s -> `string_t s
| T_int i -> `int_t (string_of_big_int i)
| T_bool b -> `bool_t b
| T_string s -> `string_t s
| T_int i -> `int_t (string_of_big_int i)
expr_of_iexpr _loc (iexpr_of_ast _loc ast)
and iexpr_of_ast _loc = function
expr_of_iexpr _loc (iexpr_of_ast _loc ast)
and iexpr_of_ast _loc = function
+ | ExId (_, IdUid (_, "()")) -> IExpr_unit
| ExId (_, IdUid (_, "True")) -> IExpr_bool true
| ExId (_, IdUid (_, "False")) -> IExpr_bool false
| ExStr (_, str) -> IExpr_str str
| ExId (_, IdUid (_, "True")) -> IExpr_bool true
| ExId (_, IdUid (_, "False")) -> IExpr_bool false
| ExStr (_, str) -> IExpr_str str
invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc))
and expr_of_iexpr _loc = function
invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc))
and expr_of_iexpr _loc = function
+ | IExpr_unit -> Expr_unit
| IExpr_bool b -> Expr_bool b
| IExpr_str s -> Expr_str s
| IExpr_int i -> Expr_int i
| IExpr_bool b -> Expr_bool b
| IExpr_str s -> Expr_str s
| IExpr_int i -> Expr_int i
invalid_arg (sprintf "%s: '%s' operator must be followed by a variable name"
(Loc.to_string _loc) op)
invalid_arg (sprintf "%s: '%s' operator must be followed by a variable name"
(Loc.to_string _loc) op)
+ | IExpr_app ("reloaded", [IExpr_unit]) ->
+ Expr_reloaded
+
+ | IExpr_app ("reloaded", _) ->
+ invalid_arg (sprintf "%s: you must use 'reloaded ()'" (Loc.to_string _loc))
+
| IExpr_app (op, _) ->
invalid_arg (sprintf "%s: unknown operator in expression: %s"
(Loc.to_string _loc) op)
| IExpr_app (op, _) ->
invalid_arg (sprintf "%s: unknown operator in expression: %s"
(Loc.to_string _loc) op)
op (Loc.to_string _loc))
let rec string_of_whenexpr = function
op (Loc.to_string _loc))
let rec string_of_whenexpr = function
| Expr_bool b -> sprintf "%b" b
| Expr_str s -> sprintf "%S" s
| Expr_int i -> sprintf "%s" (string_of_big_int i)
| Expr_bool b -> sprintf "%b" b
| Expr_str s -> sprintf "%S" s
| Expr_int i -> sprintf "%s" (string_of_big_int i)
| Expr_increases v -> sprintf "increases %s" v
| Expr_decreases v -> sprintf "decreases %s" v
| Expr_prev v -> sprintf "prev %s" v
| Expr_increases v -> sprintf "increases %s" v
| Expr_decreases v -> sprintf "decreases %s" v
| Expr_prev v -> sprintf "prev %s" v
+ | Expr_reloaded -> "reloaded ()"
let string_of_periodexpr = function
| Every_seconds 1 -> "1 second"
let string_of_periodexpr = function
| Every_seconds 1 -> "1 second"
| Every_years i -> sprintf "%d years" i
let rec dependencies_of_whenexpr = function
| Every_years i -> sprintf "%d years" i
let rec dependencies_of_whenexpr = function
| Expr_bool _ -> []
| Expr_str _ -> []
| Expr_int _ -> []
| Expr_bool _ -> []
| Expr_str _ -> []
| Expr_int _ -> []
| Expr_increases v
| Expr_decreases v
| Expr_prev v -> [v]
| Expr_increases v
| Expr_decreases v
| Expr_prev v -> [v]
let dependencies_of_job = function
| { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr
| { job_cond = Every_job _ } -> []
let dependencies_of_job = function
| { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr
| { job_cond = Every_job _ } -> []
-let rec eval_whenexpr job variables = function
+let rec eval_whenexpr job variables onload = function
+ | Expr_unit -> T_unit
| Expr_bool b -> T_bool b
| Expr_str s -> T_string s
| Expr_int i -> T_int i
| Expr_bool b -> T_bool b
| Expr_str s -> T_string s
| Expr_int i -> T_int i
(try StringMap.find v variables with Not_found -> T_string "")
| Expr_and (e1, e2) ->
(try StringMap.find v variables with Not_found -> T_string "")
| Expr_and (e1, e2) ->
- if eval_whenexpr_as_bool job variables e1 &&
- eval_whenexpr_as_bool job variables e2 then
+ if eval_whenexpr_as_bool job variables onload e1 &&
+ eval_whenexpr_as_bool job variables onload e2 then
T_bool true
else
T_bool false
| Expr_or (e1, e2) ->
T_bool true
else
T_bool false
| Expr_or (e1, e2) ->
- if eval_whenexpr_as_bool job variables e1 ||
- eval_whenexpr_as_bool job variables e2 then
+ if eval_whenexpr_as_bool job variables onload e1 ||
+ eval_whenexpr_as_bool job variables onload e2 then
T_bool true
else
T_bool false
| Expr_lt (e1, e2) ->
T_bool true
else
T_bool false
| Expr_lt (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
if compare_values e1 e2 < 0 then
T_bool true
else
T_bool false
| Expr_le (e1, e2) ->
if compare_values e1 e2 < 0 then
T_bool true
else
T_bool false
| Expr_le (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
if compare_values e1 e2 <= 0 then
T_bool true
else
T_bool false
| Expr_eq (e1, e2) ->
if compare_values e1 e2 <= 0 then
T_bool true
else
T_bool false
| Expr_eq (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
if compare_values e1 e2 = 0 then
T_bool true
else
T_bool false
| Expr_ge (e1, e2) ->
if compare_values e1 e2 = 0 then
T_bool true
else
T_bool false
| Expr_ge (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
if compare_values e1 e2 >= 0 then
T_bool true
else
T_bool false
| Expr_gt (e1, e2) ->
if compare_values e1 e2 >= 0 then
T_bool true
else
T_bool false
| Expr_gt (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
if compare_values e1 e2 > 0 then
T_bool true
else
T_bool false
| Expr_not e ->
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 e) then
+ if not (eval_whenexpr_as_bool job variables onload e) then
T_bool true
else
T_bool false
| Expr_add (e1, e2) ->
T_bool true
else
T_bool false
| Expr_add (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
add_values e1 e2
| Expr_sub (e1, e2) ->
add_values e1 e2
| Expr_sub (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
sub_values e1 e2
| Expr_mul (e1, e2) ->
sub_values e1 e2
| Expr_mul (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
mul_values e1 e2
| Expr_div (e1, e2) ->
mul_values e1 e2
| Expr_div (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
div_values e1 e2
| Expr_mod (e1, e2) ->
div_values e1 e2
| Expr_mod (e1, e2) ->
- let e1 = eval_whenexpr job variables e1
- and e2 = eval_whenexpr job variables e2 in
+ let e1 = eval_whenexpr job variables onload e1
+ and e2 = eval_whenexpr job variables onload e2 in
mod_values e1 e2
| Expr_changes v ->
mod_values e1 e2
| Expr_changes v ->
T_bool false
| Expr_prev v ->
T_bool false
| Expr_prev v ->
- try StringMap.find v job.job_private.job_prev_variables
- with Not_found -> T_string ""
+ (try StringMap.find v job.job_private.job_prev_variables
+ with Not_found -> T_string "")
+
+ | Expr_reloaded ->
+ T_bool onload
and get_prev_curr_value job variables v =
let prev_value =
and get_prev_curr_value job variables v =
let prev_value =
prev_value, curr_value
(* Call {!eval_whenexpr} and cast the result to a boolean. *)
prev_value, curr_value
(* Call {!eval_whenexpr} and cast the result to a boolean. *)
-and eval_whenexpr_as_bool job variables expr =
- match eval_whenexpr job variables expr with
+and eval_whenexpr_as_bool job variables onload expr =
+ match eval_whenexpr job variables onload expr with
+ | T_unit -> false
| T_bool r -> r
| T_string s -> s <> ""
| T_int i -> sign_big_int i <> 0
| T_bool r -> r
| T_string s -> s <> ""
| T_int i -> sign_big_int i <> 0
(printable_string_of_variable value2))
and string_of_variable = function
(printable_string_of_variable value2))
and string_of_variable = function
+ | T_unit -> "" (* for string_of_variable, we don't want () here *)
| T_bool b -> string_of_bool b
| T_string s -> s
| T_int i -> string_of_big_int i
| T_float f -> string_of_float f
and printable_string_of_variable = function
| T_bool b -> string_of_bool b
| T_string s -> s
| T_int i -> string_of_big_int i
| T_float f -> string_of_float f
and printable_string_of_variable = function
| T_bool b -> string_of_bool b
| T_string s -> sprintf "%S" s
| T_int i -> string_of_big_int i
| T_float f -> string_of_float f
| T_bool b -> string_of_bool b
| T_string s -> sprintf "%S" s
| T_int i -> string_of_big_int i
| T_float f -> string_of_float f
-let job_evaluate job variables =
+let job_evaluate job variables onload =
match job with
| { job_cond = Every_job _ } -> false, job
| { job_cond = When_job whenexpr } ->
match job with
| { job_cond = Every_job _ } -> false, job
| { job_cond = When_job whenexpr } ->
- let state = eval_whenexpr_as_bool job variables whenexpr in
+ 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.
(* Because jobs are edge-triggered, we're only interested in the
* case where the evaluation state changes from false -> true.
(** Filter + map. *)
type whenexpr =
(** Filter + map. *)
type whenexpr =
+ | Expr_unit (** Unit constant. *)
| Expr_bool of bool (** A boolean constant. *)
| Expr_str of string (** A string constant. *)
| Expr_int of Big_int.big_int (** An integer constant. *)
| Expr_bool of bool (** A boolean constant. *)
| Expr_str of string (** A string constant. *)
| Expr_int of Big_int.big_int (** An integer constant. *)
| Expr_increases of string (** increases var *)
| Expr_decreases of string (** decreases var *)
| Expr_prev of string (** prev var *)
| Expr_increases of string (** increases var *)
| Expr_decreases of string (** decreases var *)
| Expr_prev of string (** prev var *)
+ | Expr_reloaded (** reloaded () *)
(** Internal type used to represent 'when' expressions. *)
type periodexpr =
(** Internal type used to represent 'when' expressions. *)
type periodexpr =
(** A shell script. *)
type variable =
(** A shell script. *)
type variable =
| T_bool of bool
| T_string of string
| T_int of Big_int.big_int
| T_bool of bool
| T_string of string
| T_int of Big_int.big_int
val dependencies_of_job : job -> string list
(** Which variables does this job depend on? *)
val dependencies_of_job : job -> string list
(** Which variables does this job depend on? *)
-val job_evaluate : job -> variables -> bool * job
-(** Evaluate [job]'s condition in the context of the [variables], and
- return [true] iff it should be run now. Note that this returns a
- possibly-updated [job] structure.
+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.
+
+ Note that this returns a possibly-updated [job] structure.
This is a no-op for 'every' jobs. *)
This is a no-op for 'every' jobs. *)
(* Test count to 3, then fire a whenjob. *)
(* Test count to 3, then fire a whenjob. *)
+when reloaded () :
+<<
+ echo $JOBSERIAL $JOBNAME >\> $HOME/test_output
+ whenjobs --set counter 0 --type int
+>>
+
every 2 seconds :
<<
echo $JOBSERIAL $JOBNAME $counter >\> $HOME/test_output
every 2 seconds :
<<
echo $JOBSERIAL $JOBNAME $counter >\> $HOME/test_output
-2 job$1 1
-3 job$1 2
-4 job$2 3
+2 job$2 0
+3 job$2 1
+4 job$2 2
+5 job$3 3
* start running twice per period.
*)
* start running twice per period.
*)
+when reloaded () :
+<<
+ echo $JOBSERIAL $JOBNAME >\> $HOME/test_output
+ whenjobs --set counter 0 --type int
+>>
+
every second :
<<
echo $JOBSERIAL $JOBNAME >\> $HOME/test_output
every second :
<<
echo $JOBSERIAL $JOBNAME >\> $HOME/test_output
-3 job$1
-4 job$2
-5 job$1
+3 job$2
+4 job$4
+5 job$2
-7 job$1
-8 job$2
-9 job$1
-10 job$4
+7 job$2
+8 job$4
+9 job$2
+10 job$3
+11 job$2
+12 job$5
+when reloaded () :
+<<
+ # nothing
+>>
+
when changes foo :
<<
# nothing
when changes foo :
<<
# nothing
"--list", Arg.Unit (set_mode `List), " List the script";
"--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
"--set", Arg.Unit (set_mode `Set), " Set the variable";
"--list", Arg.Unit (set_mode `List), " List the script";
"--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
"--set", Arg.Unit (set_mode `Set), " Set the variable";
- "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type";
+ "--type", Arg.Set_string typ, "bool|int|float|string|unit Set the variable type";
"--upload", Arg.Unit (set_mode `Upload), " Upload the script";
"--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
"-V", Arg.Unit display_version, " Display version number and exit";
"--upload", Arg.Unit (set_mode `Upload), " Upload the script";
"--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
"-V", Arg.Unit display_version, " Display version number and exit";
| "string" -> `String
| "int" -> `Int
| "float"|"double" -> `Float
| "string" -> `String
| "int" -> `Int
| "float"|"double" -> `Float
| t ->
eprintf "whenjobs: --type: unknown type (%s)\n" t;
exit 1 in
| t ->
eprintf "whenjobs: --type: unknown type (%s)\n" t;
exit 1 in
with Failure _ ->
eprintf "whenjobs: variable is not a floating point number\n";
exit 1
with Failure _ ->
eprintf "whenjobs: variable is not a floating point number\n";
exit 1
+ )
+ | `Unit ->
+ if value <> "" then (
+ eprintf "whenjobs: unit variables must be empty strings\n";
+ exit 1
+ );
+ `unit_t in
let client = start_client () in
(match Whenproto_clnt.When.V1.set_variable client (name, value) with
let client = start_client () in
(match Whenproto_clnt.When.V1.set_variable client (name, value) with
Rpc_client.shut_down client
and string_of_variable = function
Rpc_client.shut_down client
and string_of_variable = function
| `bool_t b -> string_of_bool b
| `string_t s -> s
| `int_t i -> i (* passed on the wire as a string *)
| `bool_t b -> string_of_bool b
| `string_t s -> s
| `int_t i -> i (* passed on the wire as a string *)