Commit | Line | Data |
---|---|---|
34e49164 C |
1 | open Common |
2 | ||
3 | open Oassoc | |
4 | ||
5 | (* !!take care!!: this class does side effect, not a pure oassoc. | |
ae4735db | 6 | * |
34e49164 C |
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. *) | |
ae4735db | 18 | class ['a,'b] oassocdbm xs db (*fkey unkey*) fv unv = |
34e49164 C |
19 | object(o) |
20 | inherit ['a,'b] oassoc | |
ae4735db | 21 | |
34e49164 | 22 | val db = db |
ae4735db | 23 | |
34e49164 | 24 | method empty = raise Todo |
ae4735db | 25 | method add (k,v) = |
34e49164 C |
26 | (* pr2 (fkey k); *) |
27 | (* pr2 (debugv v); *) | |
28 | ||
ae4735db C |
29 | (* try Db.del data None |
30 | (Marshal.to_string k []) [] | |
34e49164 C |
31 | with Not_found -> ()); |
32 | *) | |
0708f913 C |
33 | let k' = Common.marshal__to_string k [] in |
34 | let v' = (Common.marshal__to_string (fv v) [(*Common.marshal__Closures*)]) in | |
ae4735db | 35 | (try Dbm.add db k' v' |
34e49164 C |
36 | with _ -> Dbm.replace db k' v' |
37 | ); | |
38 | o | |
39 | ||
ae4735db C |
40 | method iter f = |
41 | db +> Dbm.iter (fun key data -> | |
42 | let k' = (* unkey *) Common.marshal__from_string key 0 in | |
0708f913 | 43 | let v' = unv (Common.marshal__from_string data 0) in |
34e49164 | 44 | f (k', v') |
ae4735db C |
45 | ) |
46 | ||
34e49164 | 47 | method view = raise Todo |
ae4735db | 48 | |
34e49164 C |
49 | method del (k,v) = raise Todo |
50 | method mem e = raise Todo | |
51 | method null = raise Todo | |
ae4735db C |
52 | |
53 | method assoc k = | |
0708f913 C |
54 | let k' = Common.marshal__to_string k [] in |
55 | unv (Common.marshal__from_string (Dbm.find db k') 0) | |
34e49164 | 56 | |
ae4735db | 57 | method delkey k = |
0708f913 | 58 | let k' = Common.marshal__to_string k [] in |
ae4735db | 59 | try |
34e49164 C |
60 | Dbm.remove db k'; |
61 | o | |
ae4735db | 62 | with Dbm.Dbm_error "dbm_delete" -> |
34e49164 | 63 | raise Not_found |
91eba41f | 64 | |
ae4735db C |
65 | method keys = |
66 | let res = ref [] in | |
67 | db +> Dbm.iter (fun key data -> | |
68 | let k' = (* unkey *) Common.marshal__from_string key 0 in | |
69 | (* | |
0708f913 | 70 | let v' = unv (Common.marshal__from_string data 0) in |
91eba41f C |
71 | f (k', v') |
72 | *) | |
73 | Common.push2 k' res; | |
74 | ); | |
75 | !res | |
76 | ||
34e49164 C |
77 | end |
78 | ||
79 | ||
80 | let create_dbm metapath dbname = | |
ae4735db | 81 | let x_db = Dbm.opendbm (metapath^dbname) [Dbm.Dbm_create;Dbm.Dbm_rdwr] 0o777 |
34e49164 C |
82 | in |
83 | let assoc = new oassocdbm [] x_db id id in | |
84 | x_db, assoc | |
85 |