113 lines
2.7 KiB
OCaml
113 lines
2.7 KiB
OCaml
|
(***********************************************************************)
|
||
|
|
(* *)
|
||
|
|
(* Objective Caml *)
|
||
|
|
(* *)
|
||
|
|
(* Francois Rouaix, projet Cristal, INRIA Rocquencourt *)
|
||
|
|
(* *)
|
||
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
||
|
|
(* Automatique. Distributed only by permission. *)
|
||
|
|
(* *)
|
||
|
|
(***********************************************************************)
|
||
|
|
|
||
|
|
(* $Id *)
|
||
|
|
|
||
|
|
(* Module [Db]: interface to the DB databases *)
|
||
|
|
|
||
|
|
(* this collides with Unix *)
|
||
|
|
type open_flag =
|
||
|
|
O_CREAT
|
||
|
|
| O_EXCL
|
||
|
|
| O_RDONLY
|
||
|
|
| O_RDWR
|
||
|
|
| O_TRUNC
|
||
|
|
|
||
|
|
type routine_flag =
|
||
|
|
R_CURSOR
|
||
|
|
| R_FIRST
|
||
|
|
| R_LAST
|
||
|
|
| R_NEXT
|
||
|
|
| R_NOOVERWRITE
|
||
|
|
| R_PREV
|
||
|
|
| R_SETCURSOR
|
||
|
|
|
||
|
|
type file_perm = int
|
||
|
|
|
||
|
|
exception DB_error of string
|
||
|
|
(* Raised by the following functions when an error is encountered. *)
|
||
|
|
|
||
|
|
external caml_db_init : unit -> unit
|
||
|
|
= "caml_db_init"
|
||
|
|
|
||
|
|
let _ = Callback.register_exception "dberror" (DB_error "")
|
||
|
|
let _ = caml_db_init()
|
||
|
|
|
||
|
|
type key = string
|
||
|
|
type data = string
|
||
|
|
type t
|
||
|
|
|
||
|
|
(* Raw access *)
|
||
|
|
external dbopen : string -> open_flag list -> file_perm -> bool -> t
|
||
|
|
= "caml_db_open"
|
||
|
|
(* [dbopen file flags mode dupentries] *)
|
||
|
|
|
||
|
|
(* The common subset of available primitives *)
|
||
|
|
external close : t -> unit
|
||
|
|
= "caml_db_close"
|
||
|
|
|
||
|
|
external del : t -> key -> routine_flag list -> unit
|
||
|
|
= "caml_db_del"
|
||
|
|
(* raise Not_found if the key was not in the file *)
|
||
|
|
|
||
|
|
external get : t -> key -> routine_flag list -> data
|
||
|
|
= "caml_db_get"
|
||
|
|
(* raise Not_found if the key was not in the file *)
|
||
|
|
|
||
|
|
external put : t -> key -> data -> routine_flag list -> unit
|
||
|
|
= "caml_db_put"
|
||
|
|
|
||
|
|
external seq : t -> key -> routine_flag list -> (key * data)
|
||
|
|
= "caml_db_seq"
|
||
|
|
|
||
|
|
external sync : t -> unit
|
||
|
|
= "caml_db_sync"
|
||
|
|
|
||
|
|
|
||
|
|
(* Wrap-up as for other table-like types *)
|
||
|
|
let add db x v = put db x v [R_NOOVERWRITE]
|
||
|
|
let find db x = get db x []
|
||
|
|
let find_all db x =
|
||
|
|
try
|
||
|
|
match seq db x [R_CURSOR] with
|
||
|
|
k, v when k = x ->
|
||
|
|
let l = ref [v] in
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
while true do
|
||
|
|
let k, v = seq db x [R_NEXT] in
|
||
|
|
if k = x then l := v :: !l
|
||
|
|
else raise Exit
|
||
|
|
done;
|
||
|
|
!l
|
||
|
|
with
|
||
|
|
Exit | Not_found -> !l
|
||
|
|
end
|
||
|
|
| _ -> (* its greater than x *) []
|
||
|
|
with
|
||
|
|
Not_found -> []
|
||
|
|
|
||
|
|
let remove db x = del db x []
|
||
|
|
|
||
|
|
let iter f db =
|
||
|
|
let rec walk k =
|
||
|
|
let k, v = seq db k [R_NEXT] in
|
||
|
|
f k v;
|
||
|
|
walk k
|
||
|
|
in
|
||
|
|
try
|
||
|
|
let k, v = seq db "" [R_FIRST] in
|
||
|
|
f k v;
|
||
|
|
walk k
|
||
|
|
with
|
||
|
|
Not_found -> ()
|
||
|
|
|