1 /* repsdbm.c -- rep wrapper to libsdbm
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 "sdbm.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 SDBM *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
33 DEFUN("sdbm-open", Fsdbm_open, Ssdbm_open, (repv file, repv flags, repv mode),
34 rep_Subr3) /*
35 ::doc:rep.io.db.sdbm#sdbm-open::
36 sdbm-open PATH ACCESS-TYPE [MODE]
37 ::end:: */
38 {
39 int uflags, umode;
40 rep_dbm *dbm;
41 rep_GC_root gc_flags, gc_mode;
42
43 rep_PUSHGC(gc_flags, flags);
44 rep_PUSHGC(gc_mode, mode);
45 file = Flocal_file_name (file);
46 rep_POPGC; rep_POPGC;
47
48 if (!file)
49 return file;
50 rep_DECLARE1(file, rep_STRINGP);
51 rep_DECLARE2(flags, rep_SYMBOLP);
52
53 uflags = (flags == Qwrite ? O_RDWR | O_CREAT | O_TRUNC
54 : (flags == Qappend ? O_RDWR | O_CREAT : O_RDONLY));
55 umode = rep_INTP(mode) ? rep_INT(mode) : 0666;
56 dbm = rep_ALLOC_CELL (sizeof (rep_dbm));
57 if (dbm == 0)
58 return rep_mem_error();
59 rep_data_after_gc += sizeof (rep_dbm);
60 dbm->car = dbm_type;
61 dbm->path = file;
62 dbm->access = flags;
63 dbm->mode = rep_MAKE_INT(umode);
64 dbm->dbm = sdbm_open (rep_STR(file), uflags, umode);
65 if (dbm->dbm != 0)
66 {
67 dbm->next = dbm_chain;
68 dbm_chain = dbm;
69 return rep_VAL(dbm);
70 }
71 else
72 {
73 rep_FREE_CELL (dbm);
74 return rep_signal_file_error (file);
75 }
76 }
77
78 DEFUN("sdbm-close", Fsdbm_close, Ssdbm_close, (repv dbm), rep_Subr1) /*
79 ::doc:rep.io.db.sdbm#sdbm-close::
80 sdbm-close DBM
81 ::end:: */
82 {
83 rep_DECLARE1 (dbm, rep_DBMP);
84 sdbm_close (rep_DBM(dbm)->dbm);
85 rep_DBM(dbm)->dbm = 0;
86 rep_DBM(dbm)->path = Qnil;
87 rep_DBM(dbm)->access = Qnil;
88 rep_DBM(dbm)->mode = Qnil;
89 return Qt;
90 }
91
92 DEFUN("sdbm-fetch", Fsdbm_fetch, Ssdbm_fetch, (repv dbm, repv key), rep_Subr2) /*
93 ::doc:rep.io.db.sdbm#sdbm-fetch::
94 sdbm-fetch DBM KEY
95 ::end:: */
96 {
97 datum dkey, dvalue;
98 rep_DECLARE1 (dbm, rep_DBMP);
99 rep_DECLARE2 (key, rep_STRINGP);
100 dkey.dptr = rep_STR (key);
101 dkey.dsize = rep_STRING_LEN (key);
102 dvalue = sdbm_fetch (rep_DBM(dbm)->dbm, dkey);
103 if (dvalue.dptr == 0)
104 return Qnil;
105 else
106 return rep_string_dupn (dvalue.dptr, dvalue.dsize);
107 }
108
109 DEFUN("sdbm-store", Fsdbm_store, Ssdbm_store, (repv dbm, repv key, repv val, repv flags), rep_Subr4) /*
110 ::doc:rep.io.db.sdbm#sdbm-store::
111 sdbm-store DBM KEY VALUE [FLAGS]
112 ::end:: */
113 {
114 int dflags;
115 datum dkey, dvalue;
116 rep_DECLARE1 (dbm, rep_DBMP);
117 rep_DECLARE2 (key, rep_STRINGP);
118 rep_DECLARE3 (val, rep_STRINGP);
119 dkey.dptr = rep_STR (key);
120 dkey.dsize = rep_STRING_LEN (key);
121 dvalue.dptr = rep_STR (val);
122 dvalue.dsize = rep_STRING_LEN (val);
123 dflags = (flags == Qinsert ? SDBM_INSERT : SDBM_REPLACE);
124 return (sdbm_store (rep_DBM(dbm)->dbm, dkey, dvalue, dflags) == 0
125 ? Qt : Qnil);
126 }
127
128 DEFUN("sdbm-delete", Fsdbm_delete, Ssdbm_delete, (repv dbm, repv key), rep_Subr2) /*
129 ::doc:rep.io.db.sdbm#sdbm-delete::
130 sdbm-delete DBM KEY
131 ::end:: */
132 {
133 datum dkey;
134 rep_DECLARE1 (dbm, rep_DBMP);
135 rep_DECLARE2 (key, rep_STRINGP);
136 dkey.dptr = rep_STR (key);
137 dkey.dsize = rep_STRING_LEN (key) + 1;
138 return sdbm_delete (rep_DBM(dbm)->dbm, dkey) == 0 ? Qt : Qnil;
139 }
140
141 DEFUN("sdbm-firstkey", Fsdbm_firstkey, Ssdbm_firstkey, (repv dbm), rep_Subr1) /*
142 ::doc:rep.io.db.sdbm#sdbm-firstkey::
143 sdbm-firstkey DBM
144 ::end:: */
145 {
146 datum dkey;
147 rep_DECLARE1 (dbm, rep_DBMP);
148 dkey = sdbm_firstkey (rep_DBM(dbm)->dbm);
149 if (dkey.dptr == 0)
150 return Qnil;
151 else
152 return rep_string_dupn (dkey.dptr, dkey.dsize);
153 }
154
155 DEFUN("sdbm-nextkey", Fsdbm_nextkey, Ssdbm_nextkey, (repv dbm), rep_Subr1) /*
156 ::doc:rep.io.db.sdbm#sdbm-nextkey::
157 sdbm-nextkey DBM
158 ::end:: */
159 {
160 datum dkey;
161 rep_DECLARE1 (dbm, rep_DBMP);
162 dkey = sdbm_nextkey (rep_DBM(dbm)->dbm);
163 if (dkey.dptr == 0)
164 return Qnil;
165 else
166 return rep_string_dupn (dkey.dptr, dkey.dsize);
167 }
168
169 DEFUN("sdbm-rdonly", Fsdbm_rdonly, Ssdbm_rdonly, (repv dbm), rep_Subr1) /*
170 ::doc:rep.io.db.sdbm#sdbm-rdonly::
171 sdbm-rdonly DBM
172 ::end:: */
173 {
174 rep_DECLARE1 (dbm, rep_DBMP);
175 return sdbm_rdonly (rep_DBM(dbm)->dbm) ? Qt : Qnil;
176 }
177
178 DEFUN("sdbm-error", Fsdbm_error, Ssdbm_error, (repv dbm), rep_Subr1) /*
179 ::doc:rep.io.db.sdbm#sdbm-error::
180 sdbm-error DBM
181 ::end:: */
182 {
183 rep_DECLARE1 (dbm, rep_DBMP);
184 return sdbm_error (rep_DBM(dbm)->dbm) ? Qt : Qnil;
185 }
186
187 DEFUN("sdbmp", Fsdbmp, Ssdbmp, (repv arg), rep_Subr1) /*
188 ::doc:rep.io.db.sdbm#sdbmp::
189 sdbmp ARG
190
191 Returns t if ARG is an sdbm object (created by `sdbm-open').
192 ::end:: */
193 {
194 return rep_DBMP(arg) ? Qt : Qnil;
195 }
196
197
198
199 static void
dbm_mark(repv val)200 dbm_mark (repv val)
201 {
202 rep_MARKVAL (rep_DBM(val)->path);
203 rep_MARKVAL (rep_DBM(val)->access);
204 rep_MARKVAL (rep_DBM(val)->mode);
205 }
206
207 static void
dbm_sweep(void)208 dbm_sweep (void)
209 {
210 rep_dbm *x = dbm_chain;
211 dbm_chain = 0;
212 while (x != 0)
213 {
214 rep_dbm *next = x->next;
215 if (!rep_GC_CELL_MARKEDP (rep_VAL(x)))
216 {
217 if (x->dbm != 0)
218 sdbm_close (x->dbm);
219 rep_FREE_CELL (x);
220 }
221 else
222 {
223 rep_GC_CLR_CELL (rep_VAL(x));
224 x->next = dbm_chain;
225 dbm_chain = x;
226 }
227 x = next;
228 }
229 }
230
231 static void
dbm_print(repv stream,repv dbm)232 dbm_print (repv stream, repv dbm)
233 {
234 rep_stream_puts (stream, "#<dbm ", -1, rep_FALSE);
235 if (rep_STRINGP(rep_DBM(dbm)->path))
236 rep_stream_puts (stream, rep_PTR(rep_DBM(dbm)->path), -1, rep_TRUE);
237 else
238 rep_stream_puts (stream, "nil", -1, rep_FALSE);
239 rep_stream_putc (stream, '>');
240 }
241
242 static int
dbm_compare(repv v1,repv v2)243 dbm_compare (repv v1, repv v2)
244 {
245 return (v1 == v2) ? 0 : 1;
246 }
247
248 repv
rep_dl_init(void)249 rep_dl_init (void)
250 {
251 repv tem;
252 dbm_type = rep_register_new_type ("sdbm", dbm_compare,
253 dbm_print, dbm_print,
254 dbm_sweep, dbm_mark,
255 0, 0, 0, 0, 0, 0, 0);
256 rep_INTERN (insert);
257 rep_INTERN (replace);
258
259 tem = rep_push_structure ("rep.io.db.sdbm");
260 /* ::alias:sdbm rep.io.db.sdbm:: */
261 rep_alias_structure ("sdbm");
262 rep_ADD_SUBR(Ssdbm_open);
263 rep_ADD_SUBR(Ssdbm_close);
264 rep_ADD_SUBR(Ssdbm_fetch);
265 rep_ADD_SUBR(Ssdbm_store);
266 rep_ADD_SUBR(Ssdbm_delete);
267 rep_ADD_SUBR(Ssdbm_firstkey);
268 rep_ADD_SUBR(Ssdbm_nextkey);
269 rep_ADD_SUBR(Ssdbm_rdonly);
270 rep_ADD_SUBR(Ssdbm_error);
271 rep_ADD_SUBR(Ssdbmp);
272 return rep_pop_structure (tem);
273 }
274
275 void
rep_dl_kill(void)276 rep_dl_kill (void)
277 {
278 rep_dbm *db;
279 for (db = dbm_chain; db != 0; db = db->next)
280 {
281 if (db->dbm != 0)
282 Fsdbm_close (rep_VAL (db));
283 }
284 }
285