X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=src%2Focaml%2Flib%2Fkhatus_cache.ml;h=64b407d54e152862fb4dc0777e6c31832b28365e;hb=22939cbcc5e6eb9e2d840e844a3fa026b7968aec;hp=698d20b38c76dcd67a22d6b3e83f46ec82005ada;hpb=c6a7396ebc93cec32a1465d878ac9d36465dcb19;p=khatus.git

diff --git a/src/ocaml/lib/khatus_cache.ml b/src/ocaml/lib/khatus_cache.ml
index 698d20b..64b407d 100644
--- a/src/ocaml/lib/khatus_cache.ml
+++ b/src/ocaml/lib/khatus_cache.ml
@@ -1,3 +1,5 @@
+open Printf
+
 module Hashtbl = MoreLabels.Hashtbl
 
 module Msg  = Khatus_msg
@@ -18,19 +20,7 @@ let update {values; mtimes} ~node ~modul ~key ~value:data ~time =
   Hashtbl.replace values ~key ~data;
   Hashtbl.replace mtimes ~key ~data:time
 
-let update_if_data t ~msg ~time =
-  match msg with
-  | Msg.({content = Data {key; value}; node; modul}) ->
-      update t ~node ~modul ~key ~value ~time
-  | {Msg.content = Msg.Alert      _; _}
-  | {Msg.content = Msg.Cache      _; _}
-  | {Msg.content = Msg.Error      _; _}
-  | {Msg.content = Msg.Log        _; _}
-  | {Msg.content = Msg.Status_bar _; _}
-  ->
-      ()
-
-let dump {values; mtimes} ~node ~modul ~oc =
+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
@@ -46,7 +36,33 @@ let dump {values; mtimes} ~node ~modul ~oc =
           }
         )
     in
-    output_string
-      oc
-      (msg ^ "\n")
+    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