Release coccinelle-0.1.3

[bpt/coccinelle.git] / commons / ocollection / oassocdbm.ml

diff --git a/commons/ocollection/oassocdbm.ml b/commons/ocollection/oassocdbm.ml
new file mode 100644 (file)
index 0000000..ff6531e
--- /dev/null
+++ b/commons/ocollection/oassocdbm.ml
@@ -0,0 +1,85 @@
+open Common
+
+open Oassoc
+
+(* !!take care!!: this class does side effect, not a pure oassoc.
+ * 
+ * The fv/unv are here to give the opportunity to translate the value
+ * from the dbm, before marshalling. This is useful for instance if you
+ * want to store objects such as oset. Indeed we cant marshall
+ * conveniently functions/closures, and so objects (you can but you can
+ * load them back only from the same binary, which limits the
+ * practicallibity of the approach). You have to translate them to
+ * traditionnal data structures before marshalling them, and you have
+ * to rebuild the object from the traditionnal data structure when you
+ * get them from the dbm. Hence fv/unv. You can do the same for the key
+ * with fkey/unkey, but as key are usually simple data structures,
+ * there is less need for them, so I have commented them. *)
+class ['a,'b] oassocdbm   xs db (*fkey unkey*) fv unv = 
+object(o)
+  inherit ['a,'b] oassoc
+    
+  val db = db
+    
+  method empty = raise Todo
+  method add (k,v) = 
+    (* pr2 (fkey k); *)
+    (* pr2 (debugv v); *)
+
+    (* try Db.del data None 
+       (Marshal.to_string k []) [] 
+       with Not_found -> ());
+    *)
+    let k' = Marshal.to_string k [] in
+    let v' = (Marshal.to_string (fv v) [(*Marshal.Closures*)]) in
+    (try Dbm.add db k' v' 
+      with _ -> Dbm.replace db k' v'
+    );
+    o
+
+  method iter f = 
+    db +> Dbm.iter (fun key data -> 
+      let k' = (* unkey *) Marshal.from_string key 0 in 
+      let v' = unv (Marshal.from_string data 0) in
+      f (k', v')
+    ) 
+     
+  method view = raise Todo
+    
+  method del (k,v) = raise Todo
+  method mem e = raise Todo
+  method null = raise Todo
+    
+  method assoc k = 
+    let k' = Marshal.to_string k [] in
+    unv (Marshal.from_string (Dbm.find db k') 0)
+
+  method delkey k = 
+    let k' = Marshal.to_string k [] in
+    try 
+      Dbm.remove db k';
+      o
+    with Dbm.Dbm_error "dbm_delete" -> 
+      raise Not_found
+
+  method keys = 
+    let res = ref [] in 
+    db +> Dbm.iter (fun key data -> 
+      let k' = (* unkey *) Marshal.from_string key 0 in 
+      (* 
+         let v' = unv (Marshal.from_string data 0) in
+         f (k', v')
+      *)
+      Common.push2 k' res;
+    );
+    !res
+
+end
+
+
+let create_dbm metapath dbname =
+  let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 
+  in
+  let assoc = new oassocdbm [] x_db id id in
+  x_db, assoc
+