diff options
Diffstat (limited to 'otherlibs/dbm/cldbm.c')
| -rw-r--r-- | otherlibs/dbm/cldbm.c | 166 |
1 files changed, 0 insertions, 166 deletions
diff --git a/otherlibs/dbm/cldbm.c b/otherlibs/dbm/cldbm.c deleted file mode 100644 index 6c9954a34..000000000 --- a/otherlibs/dbm/cldbm.c +++ /dev/null @@ -1,166 +0,0 @@ -/***********************************************************************/ -/* */ -/* OCaml */ -/* */ -/* Francois Rouaix, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <string.h> -#include <fcntl.h> -#include <mlvalues.h> -#include <alloc.h> -#include <memory.h> -#include <fail.h> -#include <callback.h> - -#ifdef DBM_USES_GDBM_NDBM -#include <gdbm-ndbm.h> -#else -#include <ndbm.h> -#endif - -/* Quite close to sys_open_flags, but we need RDWR */ -static int dbm_open_flags[] = { - O_RDONLY, O_WRONLY, O_RDWR, O_CREAT -}; - -static void raise_dbm (char *errmsg) Noreturn; - -static void raise_dbm(char *errmsg) -{ - static value * dbm_exn = NULL; - if (dbm_exn == NULL) - dbm_exn = caml_named_value("dbmerror"); - raise_with_string(*dbm_exn, errmsg); -} - -#define DBM_val(v) *((DBM **) &Field(v, 0)) - -static value alloc_dbm(DBM * db) -{ - value res = alloc_small(1, Abstract_tag); - DBM_val(res) = db; - return res; -} - -static DBM * extract_dbm(value vdb) -{ - if (DBM_val(vdb) == NULL) raise_dbm("DBM has been closed"); - return DBM_val(vdb); -} - -/* Dbm.open : string -> Sys.open_flag list -> int -> t */ -value caml_dbm_open(value vfile, value vflags, value vmode) /* ML */ -{ - 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 (alloc_dbm(db)); -} - -/* Dbm.close: t -> unit */ -value caml_dbm_close(value vdb) /* ML */ -{ - dbm_close(extract_dbm(vdb)); - DBM_val(vdb) = NULL; - return Val_unit; -} - -/* Dbm.fetch: t -> string -> string */ -value caml_dbm_fetch(value vdb, value vkey) /* ML */ -{ - datum key,answer; - key.dptr = String_val(vkey); - key.dsize = string_length(vkey); - answer = dbm_fetch(extract_dbm(vdb), key); - if (answer.dptr) { - value res = alloc_string(answer.dsize); - memmove (String_val (res), answer.dptr, answer.dsize); - return res; - } - else raise_not_found(); -} - -value caml_dbm_insert(value vdb, value vkey, value vcontent) /* ML */ -{ - 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(extract_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(value vdb, value vkey, value vcontent) /* ML */ -{ - 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(extract_dbm(vdb), key, content, DBM_REPLACE)) { - case 0: - return Val_unit; - default: - raise_dbm("dbm_store failed"); - } -} - -value caml_dbm_delete(value vdb, value vkey) /* ML */ -{ - datum key; - key.dptr = String_val(vkey); - key.dsize = string_length(vkey); - - if (dbm_delete(extract_dbm(vdb), key) < 0) - raise_dbm("dbm_delete"); - else return Val_unit; -} - -value caml_dbm_firstkey(value vdb) /* ML */ -{ - datum key = dbm_firstkey(extract_dbm(vdb)); - - if (key.dptr) { - value res = alloc_string(key.dsize); - memmove (String_val (res), key.dptr, key.dsize); - return res; - } - else raise_not_found(); -} - -value caml_dbm_nextkey(value vdb) /* ML */ -{ - datum key = dbm_nextkey(extract_dbm(vdb)); - - if (key.dptr) { - value res = alloc_string(key.dsize); - memmove (String_val (res), key.dptr, key.dsize); - return res; - } - else raise_not_found(); -} |