commons/oassocdbm.ml

   1 open Common
   2
   3 open Oassoc
   4
   5 (* !!take care!!: this class does side effect, not a pure oassoc.
   6  *
   7  * The fv/unv are here to give the opportunity to translate the value
   8  * from the dbm, before marshalling. This is useful for instance if you
   9  * want to store objects such as oset. Indeed we cant marshall
  10  * conveniently functions/closures, and so objects (you can but you can
  11  * load them back only from the same binary, which limits the
  12  * practicallibity of the approach). You have to translate them to
  13  * traditionnal data structures before marshalling them, and you have
  14  * to rebuild the object from the traditionnal data structure when you
  15  * get them from the dbm. Hence fv/unv. You can do the same for the key
  16  * with fkey/unkey, but as key are usually simple data structures,
  17  * there is less need for them, so I have commented them. *)
  18 class ['a,'b] oassocdbm   xs db (*fkey unkey*) fv unv =
  19 object(o)
  20   inherit ['a,'b] oassoc
  21
  22   val db = db
  23
  24   method empty = raise Todo
  25   method add (k,v) =
  26     (* pr2 (fkey k); *)
  27     (* pr2 (debugv v); *)
  28
  29     (* try Db.del data None
  30        (Marshal.to_string k []) []
  31        with Not_found -> ());
  32     *)
  33     let k' = Marshal.to_string k [] in
  34     let v' = (Marshal.to_string (fv v) [(*Marshal.Closures*)]) in
  35     (try Dbm.add db k' v'
  36       with _ -> Dbm.replace db k' v'
  37     );
  38     o
  39
  40   method iter f =
  41     db +> Dbm.iter (fun key data ->
  42       let k' = (* unkey *) Marshal.from_string key 0 in
  43       let v' = unv (Marshal.from_string data 0) in
  44       f (k', v')
  45     )
  46
  47   method view = raise Todo
  48
  49   method del (k,v) = raise Todo
  50   method mem e = raise Todo
  51   method null = raise Todo
  52
  53   method assoc k =
  54     let k' = Marshal.to_string k [] in
  55     unv (Marshal.from_string (Dbm.find db k') 0)
  56
  57   method delkey k =
  58     let k' = Marshal.to_string k [] in
  59     try
  60       Dbm.remove db k';
  61       o
  62     with Dbm.Dbm_error "dbm_delete" ->
  63       raise Not_found
  64 end
  65
  66
  67 let create_dbm metapath dbname =
  68   let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777
  69   in
  70   let assoc = new oassocdbm [] x_db id id in
  71   x_db, assoc
  72