commons/ocollection/oassocbdb_string.ml

   1 open Common
   2
   3 (* specialisation of oassocbdb that avoids some marshaling cost *)
   4
   5 open Bdb
   6
   7 open Oassoc
   8
   9 (* !!take care!!: this class does side effect, not a pure oassoc
  10  *)
  11 class ['b] oassoc_btree_string db namedb transact =
  12 let namedb = if namedb = "" then "" else "(" ^ namedb ^ ")" in
  13 object(o)
  14   inherit [string,'b] oassoc
  15
  16   val data = db
  17
  18   method empty =
  19     raise Todo
  20
  21   method private addbis (k,v) =
  22     let k' = k in
  23     let v' =
  24       try Common.marshal__to_string v []
  25       with Out_of_memory ->
  26         pr2 ("PBBBBBBB Out_of_memory in: " ^ namedb);
  27         raise Out_of_memory
  28
  29     in (* still clos? *)
  30     Db.put data (transact()) k' v' [];
  31     o
  32   method add x =
  33     Common.profile_code ("Btree.add" ^ namedb) (fun () -> o#addbis x)
  34
  35   (* bugfix: if not tail call (because of a try for instance),
  36    * then strange behaviour in native mode
  37    *)
  38   method private iter2 f =
  39     let dbc = Cursor.db_cursor db (transact()) [] in
  40     (* minsky wrapper? Cursor.create ~writecursor:false ~txn:(transact()) db *)
  41     let rec aux dbc =
  42       if
  43         (try
  44             let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
  45             (* minsky ? Cursor.get dbc Cursor.NEXT [] *)
  46             let key  = (fst a) in
  47             let valu = (Common.marshal__from_string (snd a) 0) in
  48             f (key, valu);
  49             true
  50          with Failure "ending" -> false
  51         )
  52       then aux dbc
  53       else ()
  54
  55     in
  56     aux dbc;
  57     Cursor.dbc_close dbc (* minsky Cursor.close dbc *)
  58
  59   method iter x =
  60     Common.profile_code ("Btree.iter" ^ namedb) (fun () -> o#iter2 x)
  61
  62   method view =
  63     raise Todo
  64
  65
  66
  67   method private length2 =
  68     let dbc = Cursor.db_cursor db (transact()) [] in
  69
  70     let count = ref 0 in
  71     let rec aux dbc =
  72       if (
  73         try
  74           let _a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
  75           incr count;
  76           true
  77         with Failure "ending" -> false
  78       )
  79       then aux dbc
  80       else ()
  81
  82     in
  83     aux dbc;
  84     Cursor.dbc_close dbc;
  85     !count
  86
  87   method length =
  88     Common.profile_code ("Btree.length" ^ namedb) (fun () -> o#length2)
  89
  90
  91   method del (k,v) = raise Todo
  92   method mem e = raise Todo
  93   method null = raise Todo
  94
  95   method private assoc2 k =
  96     try
  97       let k' = k in
  98       let vget = Db.get data (transact()) k' [] in
  99       (* minsky ? Db.get data ~txn:(transact() *)
 100       (Common.marshal__from_string vget  0)
 101     with Not_found ->
 102       log3 ("pb assoc with k = " ^ (k));
 103       raise Not_found
 104   method assoc x =
 105     Common.profile_code ("Btree.assoc" ^ namedb) (fun () -> o#assoc2 x)
 106
 107   method private delkey2 k =
 108     let k' = k in
 109     Db.del data (transact()) k'  [];
 110     o
 111   method delkey x =
 112     Common.profile_code ("Btree.delkey" ^ namedb) (fun () -> o#delkey2 x)
 113
 114
 115   method keys =
 116     let res = ref [] in
 117     let dbc = Cursor.db_cursor db (transact()) [] in
 118     let rec aux dbc =
 119       if
 120         (try
 121             let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
 122             (* minsky ? Cursor.get dbc Cursor.NEXT [] *)
 123             let key  = (fst a) in
 124             (*
 125                let valu = unv (Common.marshal__from_string (snd a) 0) in
 126                f (key, valu);
 127             *)
 128             Common.push2 key res;
 129             true
 130          with Failure "ending" -> false
 131         )
 132       then aux dbc
 133       else ()
 134
 135     in
 136     aux dbc;
 137     Cursor.dbc_close dbc (* minsky Cursor.close dbc *);
 138     !res
 139
 140
 141   method clear =
 142     let dbc = Cursor.db_cursor db (transact()) [] in
 143     let rec aux dbc =
 144       if
 145         (try
 146             let a = Cursor.dbc_get dbc [Cursor.DB_NEXT] in
 147             Db.del data (transact()) (fst a)  [];
 148             true
 149          with Failure "ending" -> false
 150         )
 151       then aux dbc
 152       else ()
 153
 154     in
 155     aux dbc;
 156     Cursor.dbc_close dbc (* minsky Cursor.close dbc *);
 157     ()
 158
 159 end
 160
 161
 162 let create_bdb metapath dbname env  transact size_buffer_oassoc_buffer =
 163   let db = Bdb.Db.create env [] in
 164   Bdb.Db.db_open db (transact())
 165     (spf "%s/%s.db4" metapath dbname)
 166     (spf "/%s.db4" dbname)
 167     Bdb.Db.DB_BTREE [Bdb.Db.DB_CREATE] 0;
 168   db,
 169   new Oassoc_buffer.oassoc_buffer size_buffer_oassoc_buffer
 170     (new oassoc_btree_string db dbname transact)
 171