+++ /dev/null
-open Printf
-
-module Hashtbl = MoreLabels.Hashtbl
-
-module Msg = Khatus_msg
-module Time = Khatus_time
-
-type t =
- { values : ((string * string * string list), string) Hashtbl.t
- ; mtimes : ((string * string * string list), Time.t) Hashtbl.t
- }
-
-let create () =
- { values = Hashtbl.create 256
- ; mtimes = Hashtbl.create 256
- }
-
-let update {values; mtimes} ~node ~modul ~key ~value:data ~time =
- let key = (node, modul, key) in
- Hashtbl.replace values ~key ~data;
- Hashtbl.replace mtimes ~key ~data:time
-
-let dump_to_channel {values; mtimes} ~node ~modul ~oc =
- Hashtbl.iter values ~f:(fun ~key ~data:value ->
- let mtime =
- match Hashtbl.find_opt mtimes key with
- | Some mtime -> mtime
- | None -> assert false (* Implies update was incorrect *)
- in
- let (node', modul', key) = key in
- let msg =
- Msg.(to_string
- { node
- ; modul
- ; content = Cache {mtime; node = node'; modul = modul'; key; value}
- }
- )
- in
- output_string oc msg;
- output_string oc "\n"
- )
-
-let (/) = Filename.concat
-
-let mkdir_p dir =
- match Sys.command("mkdir -p " ^ dir) with
- | 0 -> ()
- | n ->
- failwith
- (sprintf "Failed to create directory: %S. mkdir status: %d\n" dir n)
-
-let gzip path =
- match Sys.command("gzip " ^ path) with
- | 0 -> ()
- | n ->
- failwith
- (sprintf "Failed to gzip path: %S. gzip status: %d\n" path n)
-
-let dump_to_dir t ~time ~node ~modul ~dir =
- (* TODO: Just log the errors and keep it moving, instead of failing. *)
- mkdir_p dir;
- let dump_filename = dir / "khatus-cache-dump.psv.gz" in
- let tmp_filename = "khatus-cache-dump-" ^ (Time.to_string time) in
- let oc = open_out tmp_filename in
- dump_to_channel t ~node ~modul ~oc;
- close_out oc;
- gzip tmp_filename;
- Sys.rename (tmp_filename ^ ".gz") dump_filename