open Common

(* specialisation of oassocbdb that avoids some marshaling cost *)

open Bdb

open Oassoc

(* !!take care!!: this class does side effect, not a pure oassoc
 *)
class ['b] oassoc_btree_string db namedb transact =
let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in
object(o)
  inherit [string,'b] oassoc

  val data = db

  method empty =
    raise Todo

  method private addbis (k,v) =
    let k' = k in
    let v' =
      try Common.marshal__to_string v []
      with Out_of_memory ->
        pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb);
        raise Out_of_memory

    in (* still clos? *)
    Db.put data (transact()) k' v' [];
    o
  method add x =
    Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x)

  (* bugfix: if not tail call (because of a try for instance),
   * then strange behaviour in native mode
   *)
  method private iter2 f =
    let dbc = Cursor.db_cursor db (transact()) [] in
    (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *)
    let rec aux dbc =
      if
	(try
	    let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
            (* minsky ? Cursor.get dbc Cursor.NEXT [] *)
	    let key  = (fst a) in
	    let valu = (Common.marshal__from_string (snd a) 0) in
	    f (key, valu);
            true
	 with Failure "ending" -> false
        )
      then aux dbc
      else ()

    in
    aux dbc;
    Cursor.dbc_close dbc (* minsky Cursor.close dbc *)

  method iter x =
    Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x)

  method view =
    raise Todo



  method private length2 =
    let dbc = Cursor.db_cursor db (transact()) [] in

    let count = ref 0 in
    let rec aux dbc =
      if (
        try
	  let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
          incr count;
          true
	with Failure "ending" -> false
      )
      then aux dbc
      else ()

    in
    aux dbc;
    Cursor.dbc_close dbc;
    !count

  method length =
    Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2)


  method del (k,v) = raise Todo
  method mem e = raise Todo
  method null = raise Todo

  method private assoc2 k =
    try
      let k' = k in
      let vget = Db.get data (transact()) k' [] in
      (* minsky ? Db.get data ~txn:(transact() *)
      (Common.marshal__from_string vget  0)
    with Not_found ->
      log3 ("pb assoc with k = " ^ (k));
      raise Not_found
  method assoc x =
    Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x)

  method private delkey2 k =
    let k' = k in
    Db.del data (transact()) k'  [];
    o
  method delkey x =
    Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x)


  method keys =
    let res = ref [] in
    let dbc = Cursor.db_cursor db (transact()) [] in
    let rec aux dbc =
      if
	(try
	    let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
            (* minsky ? Cursor.get dbc Cursor.NEXT [] *)
	    let key  = (fst a) in
	    (*
               let valu = unv (Common.marshal__from_string (snd a) 0) in
	       f (key, valu);
            *)
            Common.push2 key res;
            true
	 with Failure "ending" -> false
        )
      then aux dbc
      else ()

    in
    aux dbc;
    Cursor.dbc_close dbc (* minsky Cursor.close dbc *);
    !res


  method clear =
    let dbc = Cursor.db_cursor db (transact()) [] in
    let rec aux dbc =
      if
	(try
	    let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
            Db.del data (transact()) (fst a)  [];
            true
	 with Failure "ending" -> false
        )
      then aux dbc
      else ()

    in
    aux dbc;
    Cursor.dbc_close dbc (* minsky Cursor.close dbc *);
    ()

end	


let create_bdb metapath dbname env  transact size_buffer_oassoc_buffer =
  let db = Bdb.Db.create env [] in
  Bdb.Db.db_open db (transact())
    (spf "%s/%s.db4" metapath dbname)
    (spf "/%s.db4" dbname)
    Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0;
  db,
  new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer
    (new oassoc_btree_string db dbname transact)

