l4/pkg/ocaml/ocaml/contrib/otherlibs/dbm/cldbm.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Francois Rouaix, projet Cristal, INRIA Rocquencourt      */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: cldbm.c 5670 2003-07-08 13:50:31Z xleroy $ */
  15
  16 #include <string.h>
  17 #include <fcntl.h>
  18 #include <mlvalues.h>
  19 #include <alloc.h>
  20 #include <memory.h>
  21 #include <fail.h>
  22 #include <callback.h>
  23
  24 #ifdef DBM_USES_GDBM_NDBM
  25 #include <gdbm-ndbm.h>
  26 #else
  27 #include <ndbm.h>
  28 #endif
  29
  30 /* Quite close to sys_open_flags, but we need RDWR */
  31 static int dbm_open_flags[] = {
  32   O_RDONLY, O_WRONLY, O_RDWR, O_CREAT
  33 };
  34
  35 static void raise_dbm (char *errmsg) Noreturn;
  36
  37 static void raise_dbm(char *errmsg)
  38 {
  39   static value * dbm_exn = NULL;
  40   if (dbm_exn == NULL)
  41     dbm_exn = caml_named_value("dbmerror");
  42   raise_with_string(*dbm_exn, errmsg);
  43 }
  44
  45 #define DBM_val(v) *((DBM **) &Field(v, 0))
  46
  47 static value alloc_dbm(DBM * db)
  48 {
  49   value res = alloc_small(1, Abstract_tag);
  50   DBM_val(res) = db;
  51   return res;
  52 }
  53
  54 static DBM * extract_dbm(value vdb)
  55 {
  56   if (DBM_val(vdb) == NULL) raise_dbm("DBM has been closed");
  57   return DBM_val(vdb);
  58 }
  59
  60 /* Dbm.open : string -> Sys.open_flag list -> int -> t */
  61 value caml_dbm_open(value vfile, value vflags, value vmode) /* ML */
  62 {
  63   char *file = String_val(vfile);
  64   int flags = convert_flag_list(vflags, dbm_open_flags);
  65   int mode = Int_val(vmode);
  66   DBM *db = dbm_open(file,flags,mode);
  67
  68   if (db == NULL)
  69     raise_dbm("Can't open file");
  70   else
  71     return (alloc_dbm(db));
  72 }
  73
  74 /* Dbm.close: t -> unit */
  75 value caml_dbm_close(value vdb)       /* ML */
  76 {
  77   dbm_close(extract_dbm(vdb));
  78   DBM_val(vdb) = NULL;
  79   return Val_unit;
  80 }
  81
  82 /* Dbm.fetch: t -> string -> string */
  83 value caml_dbm_fetch(value vdb, value vkey)  /* ML */
  84 {
  85   datum key,answer;
  86   key.dptr = String_val(vkey);
  87   key.dsize = string_length(vkey);
  88   answer = dbm_fetch(extract_dbm(vdb), key);
  89   if (answer.dptr) {
  90     value res = alloc_string(answer.dsize);
  91     memmove (String_val (res), answer.dptr, answer.dsize);
  92     return res;
  93   }
  94   else raise_not_found();
  95 }
  96
  97 value caml_dbm_insert(value vdb, value vkey, value vcontent) /* ML */
  98 {
  99   datum key, content;
 100
 101   key.dptr = String_val(vkey);
 102   key.dsize = string_length(vkey);
 103   content.dptr = String_val(vcontent);
 104   content.dsize = string_length(vcontent);
 105
 106   switch(dbm_store(extract_dbm(vdb), key, content, DBM_INSERT)) {
 107   case 0:
 108     return Val_unit;
 109   case 1:                       /* DBM_INSERT and already existing */
 110     raise_dbm("Entry already exists");
 111   default:
 112     raise_dbm("dbm_store failed");
 113   }
 114 }
 115
 116 value caml_dbm_replace(value vdb, value vkey, value vcontent) /* ML */
 117 {
 118   datum key, content;
 119
 120   key.dptr = String_val(vkey);
 121   key.dsize = string_length(vkey);
 122   content.dptr = String_val(vcontent);
 123   content.dsize = string_length(vcontent);
 124
 125   switch(dbm_store(extract_dbm(vdb), key, content, DBM_REPLACE)) {
 126   case 0:
 127     return Val_unit;
 128   default:
 129     raise_dbm("dbm_store failed");
 130   }
 131 }
 132
 133 value caml_dbm_delete(value vdb, value vkey)         /* ML */
 134 {
 135   datum key;
 136   key.dptr = String_val(vkey);
 137   key.dsize = string_length(vkey);
 138
 139   if (dbm_delete(extract_dbm(vdb), key) < 0)
 140     raise_dbm("dbm_delete");
 141   else return Val_unit;
 142 }
 143
 144 value caml_dbm_firstkey(value vdb)            /* ML */
 145 {
 146   datum key = dbm_firstkey(extract_dbm(vdb));
 147
 148   if (key.dptr) {
 149     value res = alloc_string(key.dsize);
 150     memmove (String_val (res), key.dptr, key.dsize);
 151     return res;
 152   }
 153   else raise_not_found();
 154 }
 155
 156 value caml_dbm_nextkey(value vdb)             /* ML */
 157 {
 158   datum key = dbm_nextkey(extract_dbm(vdb));
 159
 160   if (key.dptr) {
 161     value res = alloc_string(key.dsize);
 162     memmove (String_val (res), key.dptr, key.dsize);
 163     return res;
 164   }
 165   else raise_not_found();
 166 }