X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=cache.ml;fp=cache.ml;h=7a802f5db819df00dd27ea372957739ee1f6dd4c;hb=5845b6fe45d4dbe13c1bb2565231e2ab897b182d;hp=0000000000000000000000000000000000000000;hpb=4903a0051f2f647dd058f5196eddf2f795a28ca4;p=virt-similarity.git

diff --git a/cache.ml b/cache.ml
new file mode 100644
index 0000000..7a802f5
--- /dev/null
+++ b/cache.ml
@@ -0,0 +1,61 @@
+(* virt-similarity
+ * Copyright (C) 2013 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 Unix
+open Filename
+
+type filename = string
+type hashes = string array
+type cache = (string * hashes) list
+
+let (//) = Filename.concat
+
+let version = "1"
+
+let cache_file =
+  try Some (Sys.getenv "HOME" // ".similarity-cache.v" ^ version)
+  with Not_found -> None
+
+let read_cache_file () : cache =
+  match cache_file with
+  | None -> []
+  | Some cache_file ->
+    try
+      let chan = open_in cache_file in
+      let v = input_value chan in
+      close_in chan;
+      v
+    with
+      _ -> []
+
+let write_cache_file (cache : cache) =
+  match cache_file with
+  | None -> ()
+  | Some cache_file ->
+    let tmp_name = cache_file ^ ".tmp" in
+    let chan = open_out tmp_name in
+    output_value chan cache;
+    close_out chan;
+    rename tmp_name cache_file
+
+let get_hash cache filename =
+  try Some (List.assoc filename cache) with Not_found -> None
+
+let update_hash cache filename hashes =
+  let cache = List.remove_assoc filename cache in
+  (filename, hashes) :: cache