lib/whenstate.ml

   1 (* whenjobs
   2  * Copyright (C) 2012 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Whenutils
  20 open Whenexpr
  21
  22 type t = {
  23   (* Variables. *)
  24   variables : variables;
  25
  26   (* Loaded jobs. *)
  27   jobs : job list;
  28
  29   (*--- below here is "internal" state ---*)
  30
  31   jobmap : job StringMap.t;            (* job name -> job structure *)
  32
  33   (* Map variable names to jobs which depend on that variable.  This
  34    * gives us a quick way to tell which jobs might need to be reevaluated
  35    * when a variable is set.
  36    *)
  37   dependencies : string list StringMap.t; (* variable -> list of job names *)
  38
  39   (* For each job, if it has run, we store the previous variables
  40    * at that time.  This is used to implement {i previous}, {i changes} etc.
  41    *)
  42   prev_variables : variables StringMap.t; (* job name -> variables *)
  43
  44   (* For each job, if it has been evaluated before (see {!job_evaluate})
  45    * then we store the previous result of evaluation here.  This is
  46    * used to implement edge-triggering.
  47    *)
  48   prev_eval_result : bool StringMap.t;   (* job name -> bool *)
  49 }
  50
  51 let empty = {
  52   variables = StringMap.empty;
  53   jobs = [];
  54   jobmap = StringMap.empty;
  55   dependencies = StringMap.empty;
  56   prev_variables = StringMap.empty;
  57   prev_eval_result = StringMap.empty;
  58 }
  59
  60 let add_job t job =
  61   let deps = dependencies_of_job job in
  62   let dependencies' = List.fold_left (
  63     fun map d ->
  64       let names = try StringMap.find d map with Not_found -> [] in
  65       StringMap.add d (job.job_name :: names) map
  66   ) t.dependencies deps in
  67
  68   { t with
  69       jobs = job :: t.jobs;
  70       jobmap = StringMap.add job.job_name job t.jobmap;
  71       dependencies = dependencies'
  72   }
  73
  74 let set_variable t name value =
  75   { t with variables = StringMap.add name value t.variables }
  76
  77 let copy_variables old t =
  78   { t with variables = StringMap.fold StringMap.add old.variables t.variables }
  79
  80 let copy_prev_state old t =
  81   let is_explicit jobname =
  82     String.length jobname < 4 || String.sub jobname 0 4 <> "job$"
  83   in
  84
  85   let prev_variables = StringMap.fold (
  86     fun jobname _ map ->
  87       try
  88         if not (is_explicit jobname) then raise Not_found;
  89         (* See if we can find a job with the same name in the old state. *)
  90         let old_vars = StringMap.find jobname old.prev_variables in
  91         StringMap.add jobname old_vars map
  92       with
  93         Not_found -> map
  94   ) t.jobmap t.prev_variables in
  95
  96   let prev_eval_result = StringMap.fold (
  97     fun jobname _ map ->
  98       try
  99         if not (is_explicit jobname) then  raise Not_found;
 100         (* See if we can find a job with the same name in the old state. *)
 101         let old_result = StringMap.find jobname old.prev_eval_result in
 102         StringMap.add jobname old_result map
 103       with
 104         Not_found -> map
 105   ) t.jobmap t.prev_eval_result in
 106
 107   { t with
 108     prev_variables = prev_variables; prev_eval_result = prev_eval_result }
 109
 110 let get_variable t name =
 111   try StringMap.find name t.variables with Not_found -> T_string ""
 112
 113 let get_variables t =
 114   StringMap.fold (
 115     fun name value xs ->
 116       if value <> T_string "" then (name, value) :: xs else xs
 117   ) t.variables []
 118
 119 let get_variable_names t =
 120   StringMap.fold (
 121     fun name value xs -> if value <> T_string "" then name :: xs else xs
 122   ) t.variables []
 123
 124 let nr_jobs t = List.length t.jobs
 125
 126 let get_dependencies t names =
 127   (* Get all job names that depend on these variables. *)
 128   let jobnames =
 129     List.map (
 130       fun name ->
 131         try StringMap.find name t.dependencies with Not_found -> []
 132     ) names in
 133
 134   (* Flatten the list and remove duplicates. *)
 135   let set = List.fold_left (
 136     fun set jn -> StringSet.add jn set
 137   ) StringSet.empty (List.flatten jobnames) in
 138   let jobnames = StringSet.elements set in
 139
 140   (* Convert job names to jobs. *)
 141   List.map (fun jn ->
 142     try
 143       let j = StringMap.find jn t.jobmap in
 144       (* If this asserts false, then there is a bug in {!add_job}. *)
 145       assert (match j.job_cond with When_job _ -> true | _ -> false);
 146       j
 147     with Not_found ->
 148       (* This should never happen.  It would indicate some bug in the
 149        * {!add_job} function.
 150        *)
 151       assert false
 152   ) jobnames
 153
 154 let get_whenjobs t =
 155   List.filter (function { job_cond = When_job _ } -> true | _ -> false) t.jobs
 156
 157 let get_everyjobs t =
 158   List.filter (function { job_cond = Every_job _ } -> true | _ -> false) t.jobs
 159
 160 let get_job t jobname =
 161   StringMap.find jobname t.jobmap
 162
 163 let get_job_names t =
 164   List.map (function { job_name = name } -> name) t.jobs
 165
 166 let evaluate_whenjob ?(onload = false) t job =
 167   match job with
 168   | { job_cond = Every_job _ } -> assert false
 169   | { job_cond = When_job whenexpr; job_name = jobname } ->
 170     let prev_variables =
 171       try Some (StringMap.find jobname t.prev_variables)
 172       with Not_found -> None in
 173
 174     let result =
 175       eval_whenexpr_as_bool t.variables prev_variables onload whenexpr in
 176
 177     let prev_eval_result =
 178       try Some (StringMap.find jobname t.prev_eval_result)
 179       with Not_found -> None in
 180
 181     let t = { t with prev_eval_result =
 182                        StringMap.add jobname result t.prev_eval_result } in
 183
 184     (* Because jobs are edge-triggered, we're only interested in the
 185      * case where the evaluation state changes from false -> true.
 186      *)
 187     match prev_eval_result, result with
 188     | None, false
 189     | Some false, false
 190     | Some true, true
 191     | Some true, false ->
 192       false, t
 193
 194     | None, true
 195     | Some false, true ->
 196       let t = { t with prev_variables =
 197                          StringMap.add jobname t.variables t.prev_variables } in
 198       true, t