161 lines
3.8 KiB
C
161 lines
3.8 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Francois Rouaix, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
#include <ndbm.h>
|
|
#include <mlvalues.h>
|
|
#include <alloc.h>
|
|
#include <memory.h>
|
|
#include <fail.h>
|
|
|
|
#include <fcntl.h>
|
|
|
|
/* Quite close to sys_open_flags, but we need RDWR */
|
|
static int dbm_open_flags[] = {
|
|
O_RDONLY, O_WRONLY, O_RDWR, O_CREAT
|
|
};
|
|
|
|
/* Exception bucket for DBMError */
|
|
static value dbm_exn;
|
|
value caml_dbm_install_exn(bucket) /* ML */
|
|
value bucket;
|
|
{
|
|
dbm_exn = Field(bucket,0);
|
|
register_global_root(&dbm_exn);
|
|
return Val_unit;
|
|
}
|
|
|
|
void raise_dbm(errmsg)
|
|
char *errmsg;
|
|
{
|
|
raise_with_string(dbm_exn, errmsg);
|
|
}
|
|
|
|
/* Dbm.open : string -> Sys.open_flag list -> int -> t */
|
|
value caml_dbm_open(vfile, vflags, vmode) /* ML */
|
|
value vfile;
|
|
value vflags;
|
|
value vmode;
|
|
{
|
|
char *file = String_val(vfile);
|
|
int flags = convert_flag_list(vflags, dbm_open_flags);
|
|
int mode = Int_val(vmode);
|
|
DBM *db = dbm_open(file,flags,mode);
|
|
|
|
if (db == NULL)
|
|
raise_dbm("Can't open file");
|
|
else
|
|
return ((value)db);
|
|
}
|
|
|
|
/* Dbm.close: t -> unit */
|
|
value caml_dbm_close(vdb) /* ML */
|
|
value vdb;
|
|
{
|
|
dbm_close((DBM *)vdb);
|
|
return Val_unit;
|
|
}
|
|
|
|
/* Dbm.fetch: t -> string -> string */
|
|
value caml_dbm_fetch(vdb,vkey) /* ML */
|
|
value vdb;
|
|
value vkey;
|
|
{
|
|
datum key,answer;
|
|
key.dptr = String_val(vkey);
|
|
key.dsize = string_length(vkey);
|
|
answer = dbm_fetch((DBM *)vdb, key);
|
|
if (answer.dptr) {
|
|
value res = alloc_string(answer.dsize);
|
|
bcopy(answer.dptr,String_val(res),answer.dsize);
|
|
return res;
|
|
}
|
|
else raise_not_found();
|
|
}
|
|
|
|
value caml_dbm_insert(vdb,vkey,vcontent) /* ML */
|
|
value vdb,vkey,vcontent;
|
|
{
|
|
datum key, content;
|
|
|
|
key.dptr = String_val(vkey);
|
|
key.dsize = string_length(vkey);
|
|
content.dptr = String_val(vcontent);
|
|
content.dsize = string_length(vcontent);
|
|
|
|
switch(dbm_store((DBM *)vdb, key, content, DBM_INSERT)) {
|
|
case 0:
|
|
return Val_unit;
|
|
case 1: /* DBM_INSERT and already existing */
|
|
raise_dbm("Entry already exists");
|
|
default:
|
|
raise_dbm("dbm_store failed");
|
|
}
|
|
}
|
|
|
|
|
|
value caml_dbm_replace(vdb,vkey,vcontent) /* ML */
|
|
value vdb,vkey,vcontent;
|
|
{
|
|
datum key, content;
|
|
|
|
key.dptr = String_val(vkey);
|
|
key.dsize = string_length(vkey);
|
|
content.dptr = String_val(vcontent);
|
|
content.dsize = string_length(vcontent);
|
|
|
|
switch(dbm_store((DBM *)vdb, key, content, DBM_REPLACE)) {
|
|
case 0:
|
|
return Val_unit;
|
|
default:
|
|
raise_dbm("dbm_store failed");
|
|
}
|
|
}
|
|
|
|
value caml_dbm_delete(vdb,vkey) /* ML */
|
|
value vdb, vkey;
|
|
{
|
|
datum key;
|
|
key.dptr = String_val(vkey);
|
|
key.dsize = string_length(vkey);
|
|
|
|
if (dbm_delete((DBM *)vdb, key) < 0)
|
|
raise_dbm("dbm_delete");
|
|
else return Val_unit;
|
|
}
|
|
|
|
value caml_dbm_firstkey(vdb) /* ML */
|
|
value vdb;
|
|
{
|
|
datum key = dbm_firstkey((DBM *)vdb);
|
|
|
|
if (key.dptr) {
|
|
value res = alloc_string(key.dsize);
|
|
bcopy(key.dptr,String_val(res),key.dsize);
|
|
return res;
|
|
}
|
|
else raise_not_found();
|
|
}
|
|
|
|
value caml_dbm_nextkey(vdb) /* ML */
|
|
value vdb;
|
|
{
|
|
datum key = dbm_nextkey((DBM *)vdb);
|
|
|
|
if (key.dptr) {
|
|
value res = alloc_string(key.dsize);
|
|
bcopy(key.dptr,String_val(res),key.dsize);
|
|
return res;
|
|
}
|
|
else raise_not_found();
|
|
}
|