1 /* repgdbm.c -- rep wrapper to libgdbm
2 $Id$ */
3
4 #define _GNU_SOURCE
5
6 #ifdef HAVE_CONFIG_H
7 # include <config.h>
8 #endif
9
10 #include "rep.h"
11 #include <gdbm.h>
12 #include <fcntl.h>
13
14 static int dbm_type;
15
16 #define rep_DBM(v) ((rep_dbm *) rep_PTR(v))
17 #define rep_DBMP(v) (rep_CELL16_TYPEP(v, dbm_type) && rep_DBM(v)->dbm != 0)
18
19 typedef struct rep_dbm_struct {
20 repv car;
21 struct rep_dbm_struct *next;
22 GDBM_FILE dbm;
23 repv path;
24 repv access;
25 repv mode;
26 } rep_dbm;
27
28 static rep_dbm *dbm_chain;
29
30 DEFSYM(insert, "insert");
31 DEFSYM(replace, "replace");
32 DEFSYM(no_lock, "no-lock");
33
34 DEFUN("gdbm-open", Fgdbm_open, Sgdbm_open,
35 (repv file, repv type, repv mode, repv flags), rep_Subr4) /*
36 ::doc:rep.io.db.gdbm#gdbm-open::
37 gdbm-open PATH ACCESS-TYPE [MODE] [FLAGS]
38 ::end:: */
39 {
40 int uflags = 0, umode;
41 rep_dbm *dbm;
42 rep_GC_root gc_type, gc_mode;
43
44 /* only flag currently is `no-lock' */
45 #ifdef GDBM_NOLOCK
46 if (rep_CONSP (flags) && rep_CAR (flags) == Qno_lock)
47 uflags |= GDBM_NOLOCK;
48 #endif
49
50 rep_PUSHGC(gc_type, type);
51 rep_PUSHGC(gc_mode, mode);
52 file = Flocal_file_name (file);
53 rep_POPGC; rep_POPGC;
54
55 if (!file)
56 return file;
57 rep_DECLARE1(file, rep_STRINGP);
58 rep_DECLARE2(type, rep_SYMBOLP);
59
60 uflags |= (type == Qwrite ? GDBM_NEWDB
61 : type == Qappend ? GDBM_WRCREAT : GDBM_READER);
62 umode = rep_INTP(mode) ? rep_INT(mode) : 0666;
63 dbm = rep_ALLOC_CELL (sizeof (rep_dbm));
64 if (dbm == 0)
65 return rep_mem_error();
66 rep_data_after_gc += sizeof (rep_dbm);
67 dbm->car = dbm_type;
68 dbm->path = file;
69 dbm->access = type;
70 dbm->mode = rep_MAKE_INT(umode);
71 dbm->dbm = gdbm_open (rep_STR(file), 0, uflags, umode, 0);
72 if (dbm->dbm != 0)
73 {
74 dbm->next = dbm_chain;
75 dbm_chain = dbm;
76 return rep_VAL(dbm);
77 }
78 else
79 {
80 rep_FREE_CELL (dbm);
81 return rep_signal_file_error (file);
82 }
83 }
84
85 DEFUN("gdbm-close", Fgdbm_close, Sgdbm_close, (repv dbm), rep_Subr1) /*
86 ::doc:rep.io.db.gdbm#gdbm-close::
87 gdbm-close DBM
88 ::end:: */
89 {
90 rep_DECLARE1 (dbm, rep_DBMP);
91 gdbm_close (rep_DBM(dbm)->dbm);
92 rep_DBM(dbm)->dbm = 0;
93 rep_DBM(dbm)->path = Qnil;
94 rep_DBM(dbm)->access = Qnil;
95 rep_DBM(dbm)->mode = Qnil;
96 return Qt;
97 }
98
99 DEFUN("gdbm-fetch", Fgdbm_fetch, Sgdbm_fetch, (repv dbm, repv key), rep_Subr2) /*
100 ::doc:rep.io.db.gdbm#gdbm-fetch::
101 gdbm-fetch DBM KEY
102 ::end:: */
103 {
104 datum dkey, dvalue;
105 rep_DECLARE1 (dbm, rep_DBMP);
106 rep_DECLARE2 (key, rep_STRINGP);
107 dkey.dptr = rep_STR (key);
108 dkey.dsize = rep_STRING_LEN (key);
109 dvalue = gdbm_fetch (rep_DBM(dbm)->dbm, dkey);
110 if (dvalue.dptr == 0)
111 return Qnil;
112 else
113 {
114 /* The string isn't always zero-terminated, so need to copy it.. */
115 repv out = rep_string_dupn (dvalue.dptr, dvalue.dsize);
116 free (dvalue.dptr);
117 return out;
118 }
119 }
120
121 DEFUN("gdbm-store", Fgdbm_store, Sgdbm_store, (repv dbm, repv key, repv val, repv flags), rep_Subr4) /*
122 ::doc:rep.io.db.gdbm#gdbm-store::
123 gdbm-store DBM KEY VALUE [FLAGS]
124 ::end:: */
125 {
126 int dflags;
127 datum dkey, dvalue;
128 rep_DECLARE1 (dbm, rep_DBMP);
129 rep_DECLARE2 (key, rep_STRINGP);
130 rep_DECLARE3 (val, rep_STRINGP);
131 dkey.dptr = rep_STR (key);
132 dkey.dsize = rep_STRING_LEN (key);
133 dvalue.dptr = rep_STR (val);
134 dvalue.dsize = rep_STRING_LEN (val);
135 dflags = (flags == Qinsert ? GDBM_INSERT : GDBM_REPLACE);
136 return (gdbm_store (rep_DBM(dbm)->dbm, dkey, dvalue, dflags) == 0
137 ? Qt : Qnil);
138 }
139
140 DEFUN("gdbm-delete", Fgdbm_delete, Sgdbm_delete, (repv dbm, repv key), rep_Subr2) /*
141 ::doc:rep.io.db.gdbm#gdbm-delete::
142 gdbm-delete DBM KEY
143 ::end:: */
144 {
145 datum dkey;
146 rep_DECLARE1 (dbm, rep_DBMP);
147 rep_DECLARE2 (key, rep_STRINGP);
148 dkey.dptr = rep_STR (key);
149 dkey.dsize = rep_STRING_LEN (key);
150 return gdbm_delete (rep_DBM(dbm)->dbm, dkey) == 0 ? Qt : Qnil;
151 }
152
153 DEFUN("gdbm-walk", Fgdbm_walk, Sgdbm_walk, (repv fun, repv dbm), rep_Subr2) /*
154 ::doc:rep.io.db.gdbm#gdbm-walk::
155 gdbm-walk FUN DBM
156 ::end:: */
157 {
158 rep_GC_root gc_dbm, gc_fun;
159 repv ret = Qnil;
160 datum dkey;
161 rep_DECLARE1 (dbm, rep_DBMP);
162 rep_PUSHGC (gc_dbm, dbm);
163 rep_PUSHGC (gc_fun, fun);
164 dkey = gdbm_firstkey (rep_DBM(dbm)->dbm);
165 while (dkey.dptr)
166 {
167 if (!rep_call_lisp1 (fun, rep_string_dupn (dkey.dptr, dkey.dsize)))
168 {
169 ret = rep_NULL;
170 free (dkey.dptr);
171 break;
172 }
173 dkey = gdbm_nextkey (rep_DBM(dbm)->dbm, dkey);
174 }
175 rep_POPGC; rep_POPGC;
176 return ret;
177 }
178
179 DEFUN("gdbmp", Fgdbmp, Sgdbmp, (repv arg), rep_Subr1) /*
180 ::doc:rep.io.db.gdbm#gdbmp::
181 gdbmp ARG
182
183 Returns t if ARG is an gdbm object (created by `gdbm-open').
184 ::end:: */
185 {
186 return rep_DBMP(arg) ? Qt : Qnil;
187 }
188
189
190
191 static void
dbm_mark(repv val)192 dbm_mark (repv val)
193 {
194 rep_MARKVAL (rep_DBM(val)->path);
195 rep_MARKVAL (rep_DBM(val)->access);
196 rep_MARKVAL (rep_DBM(val)->mode);
197 }
198
199 static void
dbm_sweep(void)200 dbm_sweep (void)
201 {
202 rep_dbm *x = dbm_chain;
203 dbm_chain = 0;
204 while (x != 0)
205 {
206 rep_dbm *next = x->next;
207 if (!rep_GC_CELL_MARKEDP (rep_VAL(x)))
208 {
209 if (x->dbm != 0)
210 gdbm_close (x->dbm);
211 rep_FREE_CELL (x);
212 }
213 else
214 {
215 rep_GC_CLR_CELL (rep_VAL(x));
216 x->next = dbm_chain;
217 dbm_chain = x;
218 }
219 x = next;
220 }
221 }
222
223 static void
dbm_print(repv stream,repv dbm)224 dbm_print (repv stream, repv dbm)
225 {
226 rep_stream_puts (stream, "#<dbm ", -1, rep_FALSE);
227 if (rep_STRINGP(rep_DBM(dbm)->path))
228 rep_stream_puts (stream, rep_PTR(rep_DBM(dbm)->path), -1, rep_TRUE);
229 else
230 rep_stream_puts (stream, "nil", -1, rep_FALSE);
231 rep_stream_putc (stream, '>');
232 }
233
234 static int
dbm_compare(repv v1,repv v2)235 dbm_compare (repv v1, repv v2)
236 {
237 return (v1 == v2) ? 0 : 1;
238 }
239
240 repv
rep_dl_init(void)241 rep_dl_init (void)
242 {
243 repv tem;
244 dbm_type = rep_register_new_type ("gdbm", dbm_compare,
245 dbm_print, dbm_print,
246 dbm_sweep, dbm_mark,
247 0, 0, 0, 0, 0, 0, 0);
248 rep_INTERN (insert);
249 rep_INTERN (replace);
250 rep_INTERN (no_lock);
251
252 tem = rep_push_structure ("rep.io.db.gdbm");
253 /* ::alias:gdbm rep.io.db.gdbm:: */
254 rep_alias_structure ("gdbm");
255 rep_ADD_SUBR(Sgdbm_open);
256 rep_ADD_SUBR(Sgdbm_close);
257 rep_ADD_SUBR(Sgdbm_fetch);
258 rep_ADD_SUBR(Sgdbm_store);
259 rep_ADD_SUBR(Sgdbm_delete);
260 rep_ADD_SUBR(Sgdbm_walk);
261 rep_ADD_SUBR(Sgdbmp);
262 return rep_pop_structure (tem);
263 }
264
265 void
rep_dl_kill(void)266 rep_dl_kill (void)
267 {
268 rep_dbm *db;
269 for (db = dbm_chain; db != 0; db = db->next)
270 {
271 if (db->dbm != 0)
272 Fgdbm_close (rep_VAL (db));
273 }
274 }
275