Mercurial > hg > xemacs-beta

comparison src/database.c @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents 6075d714658b
children b405438285a2
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
19 Boston, MA 02111-1307, USA. */ 19 Boston, MA 02111-1307, USA. */
20 20
21 /* Synched up with: Not in FSF. */ 21 /* Synched up with: Not in FSF. */
22 22
23 /* Written by Bill Perry */ 23 /* Written by Bill Perry */
24 /* Hacked on by Martin Buchholz */ 24 /* Substantially rewritten by Martin Buchholz */
25 25
26 #include <config.h> 26 #include <config.h>
27 #include "lisp.h" 27 #include "lisp.h"
28 #include <errno.h> 28 #include <errno.h>
29 29
61 61
62 Lisp_Object Qdatabasep; 62 Lisp_Object Qdatabasep;
63 63
64 typedef enum { DB_DBM, DB_BERKELEY, DB_UNKNOWN } XEMACS_DB_TYPE; 64 typedef enum { DB_DBM, DB_BERKELEY, DB_UNKNOWN } XEMACS_DB_TYPE;
65 65
66 struct database_struct; 66 struct database;
67 typedef struct database_struct database_struct; 67 typedef struct database database;
68 68
69 typedef struct 69 typedef struct
70 { 70 {
71 CONST char * (*get_subtype) (struct database_struct *); 71 CONST char * (*get_subtype) (struct database *);
72 CONST char * (*get_type) (struct database_struct *); 72 CONST char * (*get_type) (struct database *);
73 void * (*open_file) (CONST char *, Lisp_Object, int, int); 73 Lisp_Object (*get) (struct database *, Lisp_Object);
74 Lisp_Object (*get) (struct database_struct *, Lisp_Object); 74 int (*put) (struct database *, Lisp_Object, Lisp_Object, Lisp_Object);
75 int (*put) (struct database_struct *, Lisp_Object, Lisp_Object, Lisp_Object); 75 int (*rem) (struct database *, Lisp_Object);
76 int (*rem) (struct database_struct *, Lisp_Object); 76 void (*map) (struct database *, Lisp_Object);
77 void (*map) (struct database_struct *, Lisp_Object); 77 Lisp_Object (*get_lisp_type) (struct database *);
78 Lisp_Object (*get_lisp_type) (struct database_struct *); 78 void (*close) (struct database *);
79 void (*close) (struct database_struct *); 79 Lisp_Object (*last_error) (struct database *);
80 Lisp_Object (*last_error) (struct database_struct *);
81 } DB_FUNCS; 80 } DB_FUNCS;
82 81
83 struct database_struct 82 struct database
84 { 83 {
85 struct lcrecord_header header; 84 struct lcrecord_header header;
86 Lisp_Object fname; 85 Lisp_Object fname;
87 XEMACS_DB_TYPE type; 86 XEMACS_DB_TYPE type;
88 int mode; 87 int mode;
89 int access_; 88 int access_;
90 int dberrno; 89 int dberrno;
91 void *db_handle; 90 int live_p;
91 #ifdef HAVE_DBM
92 DBM *dbm_handle;
93 #endif
94 #ifdef HAVE_BERKELEY_DB
95 DB *db_handle;
96 #endif
92 DB_FUNCS *funcs; 97 DB_FUNCS *funcs;
93 #ifdef MULE 98 #ifdef MULE
94 Lisp_Object coding_system; 99 Lisp_Object coding_system;
95 #endif 100 #endif
96 }; 101 };
97 102
98 #define XDATABASE(x) XRECORD (x, database, struct database_struct) 103 #define XDATABASE(x) XRECORD (x, database, struct database)
99 #define XSETDATABASE(x, p) XSETRECORD (x, p, database) 104 #define XSETDATABASE(x, p) XSETRECORD (x, p, database)
100 #define DATABASEP(x) RECORDP (x, database) 105 #define DATABASEP(x) RECORDP (x, database)
101 #define GC_DATABASEP(x) GC_RECORDP (x, database) 106 #define GC_DATABASEP(x) GC_RECORDP (x, database)
102 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) 107 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
103 #define DATABASE_LIVE_P(x) (x->db_handle) 108 #define DATABASE_LIVE_P(x) (x->live_p)
104 static Lisp_Object mark_database (Lisp_Object, void (*) (Lisp_Object)); 109 static Lisp_Object mark_database (Lisp_Object, void (*) (Lisp_Object));
105 static void print_database (Lisp_Object, Lisp_Object, int); 110 static void print_database (Lisp_Object, Lisp_Object, int);
106 static void finalize_database (void *, int); 111 static void finalize_database (void *, int);
107 DEFINE_LRECORD_IMPLEMENTATION ("database", database, 112 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
108 mark_database, print_database, 113 mark_database, print_database,
109 finalize_database, 0, 0, 114 finalize_database, 0, 0,
110 struct database_struct); 115 struct database);
111 116
112 static struct database_struct * 117 #define CHECK_LIVE_DATABASE(db) do { \
118 CHECK_DATABASE(db); \
119 if (!DATABASE_LIVE_P (XDATABASE(db))) \
120 signal_simple_error ("Attempting to access closed database", db); \
121 } while (0)
122
123
124 static struct database *
113 new_database (void) 125 new_database (void)
114 { 126 {
115 struct database_struct *dbase 127 struct database *dbase =
116 = alloc_lcrecord (sizeof (struct database_struct), lrecord_database); 128 alloc_lcrecord_type (struct database, lrecord_database);
117 129
118 dbase->fname = Qnil; 130 dbase->fname = Qnil;
131 dbase->live_p = 0;
132 #ifdef HAVE_BERKELEY_DB
119 dbase->db_handle = NULL; 133 dbase->db_handle = NULL;
134 #endif
135 #ifdef HAVE_DBM
136 dbase->dbm_handle = NULL;
137 #endif
120 dbase->access_ = 0; 138 dbase->access_ = 0;
121 dbase->mode = 0; 139 dbase->mode = 0;
122 dbase->dberrno = 0; 140 dbase->dberrno = 0;
123 dbase->type = DB_UNKNOWN; 141 dbase->type = DB_UNKNOWN;
124 #ifdef MULE 142 #ifdef MULE
128 } 146 }
129 147
130 static Lisp_Object 148 static Lisp_Object
131 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) 149 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object))
132 { 150 {
133 struct database_struct *dbase = XDATABASE (obj); 151 struct database *dbase = XDATABASE (obj);
134 152
135 ((markobj) (dbase->fname)); 153 ((markobj) (dbase->fname));
136 return Qnil; 154 return Qnil;
137 } 155 }
138 156
139 static void 157 static void
140 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 158 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
141 { 159 {
142 struct database_struct *dbase = XDATABASE (obj); 160 struct database *dbase = XDATABASE (obj);
143 char buf[200]; 161 char buf[200];
144 162
145 if (print_readably) 163 if (print_readably)
146 { 164 {
147 error ("printing unreadable object #<database 0x%x>", dbase->header.uid); 165 error ("printing unreadable object #<database 0x%x>", dbase->header.uid);
148 } 166 }
149 else 167 else
150 { 168 {
151 CONST char *type; 169 sprintf (buf, "#<database \"%s\" (%s/%s/%s) 0x%x>",
152 CONST char *subtype; 170 XSTRING_DATA (dbase->fname),
153 CONST char *perms; 171 dbase->funcs->get_type (dbase),
154 172 dbase->funcs->get_subtype (dbase),
155 perms = (!dbase->db_handle) ? "closed" : 173 (!DATABASE_LIVE_P (dbase) ? "closed" :
156 (dbase->access_ & O_WRONLY) ? "writeonly" : 174 (dbase->access_ & O_WRONLY) ? "writeonly" :
157 (dbase->access_ & O_RDWR) ? "readwrite" : "readonly"; 175 (dbase->access_ & O_RDWR) ? "readwrite" : "readonly"),
158
159 type = dbase->funcs->get_type (dbase);
160 subtype = dbase->funcs->get_subtype (dbase);
161
162 sprintf (buf, "#<database %s (%s/%s/%s) 0x%x>",
163 XSTRING_DATA (dbase->fname), type, subtype, perms,
164 dbase->header.uid); 176 dbase->header.uid);
165 write_c_string (buf, printcharfun); 177 write_c_string (buf, printcharfun);
166 } 178 }
167 } 179 }
168 180
169 static void 181 static void
170 finalize_database (void *header, int for_disksave) 182 finalize_database (void *header, int for_disksave)
171 { 183 {
172 struct database_struct *db = (struct database_struct *) header; 184 struct database *db = (struct database *) header;
173 185
174 if (for_disksave) 186 if (for_disksave)
175 { 187 {
176 Lisp_Object obj; 188 Lisp_Object obj;
177 XSETOBJ (obj, Lisp_Record, (void *) db); 189 XSETOBJ (obj, Lisp_Type_Record, (void *) db);
178 190
179 signal_simple_error 191 signal_simple_error
180 ("Can't dump an emacs containing window system objects", obj); 192 ("Can't dump an emacs containing window system objects", obj);
181 } 193 }
182 db->funcs->close (db); 194 db->funcs->close (db);
183 } 195 }
185 DEFUN ("close-database", Fdatabase_close, 1, 1, 0, /* 197 DEFUN ("close-database", Fdatabase_close, 1, 1, 0, /*
186 Close database OBJ. 198 Close database OBJ.
187 */ 199 */
188 (obj)) 200 (obj))
189 { 201 {
190 struct database_struct *db; 202 CHECK_LIVE_DATABASE (obj);
191 CHECK_DATABASE (obj); 203 XDATABASE (obj)->funcs->close (XDATABASE (obj));
192 db = XDATABASE (obj); 204 XDATABASE (obj)->live_p = 0;
193
194 if (DATABASE_LIVE_P (db))
195 db->funcs->close (db);
196 else
197 signal_simple_error ("Attempting to access closed database", obj);
198
199 return Qnil; 205 return Qnil;
200 } 206 }
201 207
202 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* 208 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
203 Return the type of database OBJ. 209 Return the type of database OBJ.
204 */ 210 */
205 (obj)) 211 (obj))
206 { 212 {
207 struct database_struct *db;
208 CHECK_DATABASE (obj); 213 CHECK_DATABASE (obj);
209 db = XDATABASE (obj); 214
210 215 return XDATABASE (obj)->funcs->get_lisp_type (XDATABASE (obj));
211 return db->funcs->get_lisp_type (db);
212 } 216 }
213 217
214 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* 218 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
215 Return the subtype of database OBJ, if any. 219 Return the subtype of database OBJ, if any.
216 */ 220 */
217 (obj)) 221 (obj))
218 { 222 {
219 struct database_struct *db;
220
221 CHECK_DATABASE (obj); 223 CHECK_DATABASE (obj);
222 db = XDATABASE (obj); 224
223 225 return intern (XDATABASE (obj)->funcs->get_subtype (XDATABASE (obj)));
224 return intern (db->funcs->get_subtype (db));
225 } 226 }
226 227
227 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* 228 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
228 Return t iff OBJ is an active database, else nil. 229 Return t iff OBJ is an active database, else nil.
229 */ 230 */
230 (obj)) 231 (obj))
231 { 232 {
232 struct database_struct *db;
233 CHECK_DATABASE (obj); 233 CHECK_DATABASE (obj);
234 db = XDATABASE (obj); 234
235 235 return DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
236 return DATABASE_LIVE_P (db) ? Qt : Qnil;
237 } 236 }
238 237
239 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* 238 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
240 Return the filename associated with the database OBJ. 239 Return the filename associated with the database OBJ.
241 */ 240 */
242 (obj)) 241 (obj))
243 { 242 {
244 struct database_struct *db;
245 CHECK_DATABASE (obj); 243 CHECK_DATABASE (obj);
246 db = XDATABASE (obj); 244
247 return db->fname; 245 return XDATABASE (obj)->fname;
248 } 246 }
249 247
250 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* 248 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
251 Return t iff OBJ is a database, else nil. 249 Return t iff OBJ is a database, else nil.
252 */ 250 */
255 return DATABASEP (obj) ? Qt : Qnil; 253 return DATABASEP (obj) ? Qt : Qnil;
256 } 254 }
257 255
258 #ifdef HAVE_DBM 256 #ifdef HAVE_DBM
259 static void 257 static void
260 dbm_map (struct database_struct *db, Lisp_Object func) 258 dbm_map (struct database *db, Lisp_Object func)
261 { 259 {
262 datum keydatum, valdatum; 260 datum keydatum, valdatum;
263 DBM *handle = (DBM *)db->db_handle;
264 Lisp_Object key, val; 261 Lisp_Object key, val;
265 262
266 for (keydatum = dbm_firstkey (handle); 263 for (keydatum = dbm_firstkey (db->dbm_handle);
267 keydatum.dptr != NULL; 264 keydatum.dptr != NULL;
268 keydatum = dbm_nextkey (handle)) 265 keydatum = dbm_nextkey (db->dbm_handle))
269 { 266 {
270 valdatum = dbm_fetch (handle, keydatum); 267 valdatum = dbm_fetch (db->dbm_handle, keydatum);
271 key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize); 268 key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize);
272 val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize); 269 val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize);
273 call2 (func, key, val); 270 call2 (func, key, val);
274 } 271 }
275 } 272 }
276 273
277 static Lisp_Object 274 static Lisp_Object
278 dbm_get (struct database_struct *db, Lisp_Object key) 275 dbm_get (struct database *db, Lisp_Object key)
279 { 276 {
280 datum keydatum, valdatum; 277 datum keydatum, valdatum;
281 DBM *handle = (DBM *)db->db_handle; 278
282 keydatum.dptr = (char *) XSTRING_DATA (key); 279 keydatum.dptr = (char *) XSTRING_DATA (key);
283 keydatum.dsize = XSTRING_LENGTH (key); 280 keydatum.dsize = XSTRING_LENGTH (key);
284 valdatum = dbm_fetch (handle, keydatum); 281 valdatum = dbm_fetch (db->dbm_handle, keydatum);
285 282
286 return (valdatum.dptr 283 return (valdatum.dptr
287 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) 284 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
288 : Qnil); 285 : Qnil);
289 } 286 }
290 287
291 static int 288 static int
292 dbm_put (struct database_struct *db, 289 dbm_put (struct database *db,
293 Lisp_Object key, 290 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
294 Lisp_Object val, 291 {
295 Lisp_Object replace)
296 {
297 DBM *handle = (DBM *)db->db_handle;
298 datum keydatum, valdatum; 292 datum keydatum, valdatum;
299 293
300 valdatum.dptr = (char *) XSTRING_DATA (val); 294 valdatum.dptr = (char *) XSTRING_DATA (val);
301 valdatum.dsize = XSTRING_LENGTH (val); 295 valdatum.dsize = XSTRING_LENGTH (val);
302 keydatum.dptr = (char *) XSTRING_DATA (key); 296 keydatum.dptr = (char *) XSTRING_DATA (key);
303 keydatum.dsize = XSTRING_LENGTH (key); 297 keydatum.dsize = XSTRING_LENGTH (key);
304 298
305 return (!dbm_store (handle, keydatum, valdatum, 299 return !dbm_store (db->dbm_handle, keydatum, valdatum,
306 (NILP (replace)) ? DBM_INSERT : DBM_REPLACE)); 300 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
307 } 301 }
308 302
309 static int 303 static int
310 dbm_remove (struct database_struct *db, Lisp_Object key) 304 dbm_remove (struct database *db, Lisp_Object key)
311 { 305 {
312 datum keydatum; 306 datum keydatum;
307
313 keydatum.dptr = (char *) XSTRING_DATA (key); 308 keydatum.dptr = (char *) XSTRING_DATA (key);
314 keydatum.dsize = XSTRING_LENGTH (key); 309 keydatum.dsize = XSTRING_LENGTH (key);
315 return dbm_delete (db->db_handle, keydatum); 310
311 return dbm_delete (db->dbm_handle, keydatum);
316 } 312 }
317 313
318 static Lisp_Object 314 static Lisp_Object
319 dbm_lisp_type (struct database_struct *db) 315 dbm_lisp_type (struct database *db)
320 { 316 {
321 return Qdbm; 317 return Qdbm;
322 } 318 }
323 319
324 static CONST char * 320 static CONST char *
325 dbm_type (struct database_struct *db) 321 dbm_type (struct database *db)
326 { 322 {
327 return "dbm"; 323 return "dbm";
328 } 324 }
329 325
330 static CONST char * 326 static CONST char *
331 dbm_subtype (struct database_struct *db) 327 dbm_subtype (struct database *db)
332 { 328 {
333 return "nil"; 329 return "nil";
334 } 330 }
335 331
336 static void *
337 new_dbm_file (CONST char *file, Lisp_Object subtype, int access_, int mode)
338 {
339 DBM *db = NULL;
340 db = dbm_open ((char *) file, access_, mode);
341 return (void *) db;
342 }
343
344 static Lisp_Object 332 static Lisp_Object
345 dbm_lasterr (struct database_struct *dbp) 333 dbm_lasterr (struct database *dbp)
346 { 334 {
347 return lisp_strerror (dbp->dberrno); 335 return lisp_strerror (dbp->dberrno);
348 } 336 }
349 337
350 static void 338 static void
351 dbm_closeit (struct database_struct *db) 339 dbm_closeit (struct database *db)
352 { 340 {
353 if (db->db_handle) 341 if (db->dbm_handle)
354 dbm_close ((DBM *)db->db_handle); 342 {
355 db->db_handle = NULL; 343 dbm_close (db->dbm_handle);
344 db->dbm_handle = NULL;
345 }
356 } 346 }
357 347
358 static DB_FUNCS ndbm_func_block = 348 static DB_FUNCS ndbm_func_block =
359 { 349 {
360 dbm_subtype, 350 dbm_subtype,
361 dbm_type, 351 dbm_type,
362 new_dbm_file,
363 dbm_get, 352 dbm_get,
364 dbm_put, 353 dbm_put,
365 dbm_remove, 354 dbm_remove,
366 dbm_map, 355 dbm_map,
367 dbm_lisp_type, 356 dbm_lisp_type,
368 dbm_closeit, 357 dbm_closeit,
369 dbm_lasterr 358 dbm_lasterr
370 }; 359 };
371 #endif 360 #endif /* HAVE_DBM */
372 361
373 #ifdef HAVE_BERKELEY_DB 362 #ifdef HAVE_BERKELEY_DB
374 static Lisp_Object 363 static Lisp_Object
375 berkdb_lisp_type (struct database_struct *db) 364 berkdb_lisp_type (struct database *db)
376 { 365 {
377 return Qberkeley_db; 366 return Qberkeley_db;
378 } 367 }
379 368
380 static CONST char * 369 static CONST char *
381 berkdb_type (struct database_struct *db) 370 berkdb_type (struct database *db)
382 { 371 {
383 return "berkeley"; 372 return "berkeley";
384 } 373 }
385 374
386 static CONST char * 375 static CONST char *
387 berkdb_subtype (struct database_struct *db) 376 berkdb_subtype (struct database *db)
388 { 377 {
389 DB *temp = (DB *)db->db_handle; 378 if (!db->db_handle)
390
391 if (!temp)
392 return "nil"; 379 return "nil";
393 380
394 switch (temp->type) 381 switch (db->db_handle->type)
395 { 382 {
396 case DB_BTREE: 383 case DB_BTREE: return "btree";
397 return "btree"; 384 case DB_HASH: return "hash";
398 case DB_HASH: 385 case DB_RECNO: return "recno";
399 return "hash"; 386 default: return "unknown";
400 case DB_RECNO: 387 }
401 return "recno";
402 }
403 return "unknown";
404 }
405
406 static void *
407 berkdb_open (CONST char *file, Lisp_Object subtype, int access_, int mode)
408 {
409 DB *db;
410 DBTYPE real_subtype;
411
412 if (EQ (subtype, Qhash) || NILP (subtype))
413 real_subtype = DB_HASH;
414 else if (EQ (subtype, Qbtree))
415 real_subtype = DB_BTREE;
416 else if (EQ (subtype, Qrecno))
417 real_subtype = DB_RECNO;
418 else
419 signal_simple_error ("Unsupported subtype", subtype);
420
421 db = dbopen (file, access_, mode, real_subtype, NULL);
422
423 return (void *) db;
424 } 388 }
425 389
426 static Lisp_Object 390 static Lisp_Object
427 berkdb_lasterr (struct database_struct *dbp) 391 berkdb_lasterr (struct database *dbp)
428 { 392 {
429 return lisp_strerror (dbp->dberrno); 393 return lisp_strerror (dbp->dberrno);
430 } 394 }
431 395
432 static Lisp_Object 396 static Lisp_Object
433 berkdb_get (struct database_struct *db, Lisp_Object key) 397 berkdb_get (struct database *db, Lisp_Object key)
434 { 398 {
399 /* #### Needs mule-izing */
435 DBT keydatum, valdatum; 400 DBT keydatum, valdatum;
436 DB *dbp = (DB *) db->db_handle;
437 int status = 0; 401 int status = 0;
438 402
439 keydatum.data = XSTRING_DATA (key); 403 keydatum.data = XSTRING_DATA (key);
440 keydatum.size = XSTRING_LENGTH (key); 404 keydatum.size = XSTRING_LENGTH (key);
441 405
442 status = dbp->get (dbp, &keydatum, &valdatum, 0); 406 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
443 407
444 if (!status) 408 if (!status)
445 return make_string (valdatum.data, valdatum.size); 409 return make_string ((Bufbyte *) valdatum.data, valdatum.size);
446 410
447 db->dberrno = (status == 1) ? -1 : errno; 411 db->dberrno = (status == 1) ? -1 : errno;
448 return Qnil; 412 return Qnil;
449 } 413 }
450 414
451 static int 415 static int
452 berkdb_put (struct database_struct *db, 416 berkdb_put (struct database *db,
453 Lisp_Object key, 417 Lisp_Object key,
454 Lisp_Object val, 418 Lisp_Object val,
455 Lisp_Object replace) 419 Lisp_Object replace)
456 { 420 {
457 DBT keydatum, valdatum; 421 DBT keydatum, valdatum;
458 DB *dbp = (DB *) db->db_handle;
459 int status = 0; 422 int status = 0;
460 423
461 keydatum.data = XSTRING_DATA (key); 424 keydatum.data = XSTRING_DATA (key);
462 keydatum.size = XSTRING_LENGTH (key); 425 keydatum.size = XSTRING_LENGTH (key);
463 valdatum.data = XSTRING_DATA (val); 426 valdatum.data = XSTRING_DATA (val);
464 valdatum.size = XSTRING_LENGTH (val); 427 valdatum.size = XSTRING_LENGTH (val);
465 status = dbp->put (dbp, &keydatum, &valdatum, NILP (replace) 428 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
466 ? R_NOOVERWRITE : 0); 429 NILP (replace) ? R_NOOVERWRITE : 0);
467 db->dberrno = (status == 1) ? -1 : errno; 430 db->dberrno = (status == 1) ? -1 : errno;
468 return status; 431 return status;
469 } 432 }
470 433
471 static int 434 static int
472 berkdb_remove (struct database_struct *db, Lisp_Object key) 435 berkdb_remove (struct database *db, Lisp_Object key)
473 { 436 {
474 DBT keydatum; 437 DBT keydatum;
475 DB *dbp = (DB *) db->db_handle;
476 int status; 438 int status;
477 439
478 keydatum.data = XSTRING_DATA (key); 440 keydatum.data = XSTRING_DATA (key);
479 keydatum.size = XSTRING_LENGTH (key); 441 keydatum.size = XSTRING_LENGTH (key);
480 442
481 status = dbp->del (dbp, &keydatum, 0); 443 status = db->db_handle->del (db->db_handle, &keydatum, 0);
482 if (!status) 444 if (!status)
483 return 0; 445 return 0;
484 446
485 db->dberrno = (status == 1) ? -1 : errno; 447 db->dberrno = (status == 1) ? -1 : errno;
486 return 1; 448 return 1;
487 } 449 }
488 450
489 static void 451 static void
490 berkdb_map (struct database_struct *db, Lisp_Object func) 452 berkdb_map (struct database *db, Lisp_Object func)
491 { 453 {
492 DBT keydatum, valdatum; 454 DBT keydatum, valdatum;
493 Lisp_Object key, val; 455 Lisp_Object key, val;
494 DB *dbp = (DB *) db->db_handle; 456 DB *dbp = db->db_handle;
495 int status; 457 int status;
496 458
497 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); 459 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
498 status == 0; 460 status == 0;
499 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) 461 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
500 { 462 {
501 key = make_string (keydatum.data, keydatum.size); 463 /* ### Needs mule-izing */
502 val = make_string (valdatum.data, valdatum.size); 464 key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
465 val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
503 call2 (func, key, val); 466 call2 (func, key, val);
504 } 467 }
505 } 468 }
506 469
507 static void 470 static void
508 berkdb_close (struct database_struct *db) 471 berkdb_close (struct database *db)
509 { 472 {
510 DB *dbp = (DB *)db->db_handle; 473 if (db->db_handle)
511 if (dbp) 474 {
512 { 475 db->db_handle->sync (db->db_handle, 0);
513 dbp->sync (dbp, 0); 476 db->db_handle->close (db->db_handle);
514 dbp->close (dbp); 477 db->db_handle = NULL;
515 } 478 }
516 db->db_handle = NULL;
517 } 479 }
518 480
519 static DB_FUNCS berk_func_block = 481 static DB_FUNCS berk_func_block =
520 { 482 {
521 berkdb_subtype, 483 berkdb_subtype,
522 berkdb_type, 484 berkdb_type,
523 berkdb_open,
524 berkdb_get, 485 berkdb_get,
525 berkdb_put, 486 berkdb_put,
526 berkdb_remove, 487 berkdb_remove,
527 berkdb_map, 488 berkdb_map,
528 berkdb_lisp_type, 489 berkdb_lisp_type,
529 berkdb_close, 490 berkdb_close,
530 berkdb_lasterr 491 berkdb_lasterr
531 }; 492 };
532 #endif 493 #endif /* HAVE_BERKELEY_DB */
533 494
534 DEFUN ("database-last-error", Fdatabase_error, 0, 1, 0, /* 495 DEFUN ("database-last-error", Fdatabase_error, 0, 1, 0, /*
535 Return the last error associated with database OBJ. 496 Return the last error associated with database OBJ.
536 */ 497 */
537 (obj)) 498 (obj))
538 { 499 {
539 struct database_struct *db;
540
541 if (NILP (obj)) 500 if (NILP (obj))
542 return lisp_strerror (errno); 501 return lisp_strerror (errno);
543 502
544 CHECK_DATABASE (obj); 503 CHECK_DATABASE (obj);
545 db = XDATABASE (obj); 504
546 return db->funcs->last_error (db); 505 return XDATABASE (obj)->funcs->last_error (XDATABASE (obj));
547 } 506 }
548 507
549 DEFUN ("open-database", Fmake_database, 1, 5, 0, /* 508 DEFUN ("open-database", Fmake_database, 1, 5, 0, /*
550 Open database FILE, using database method TYPE and SUBTYPE, with 509 Open database FILE, using database method TYPE and SUBTYPE, with
551 access rights ACCESS and permissions MODE. ACCESS can be any 510 access rights ACCESS and permissions MODE. ACCESS can be any
554 (file, type, subtype, access_, mode)) 513 (file, type, subtype, access_, mode))
555 { 514 {
556 Lisp_Object retval = Qnil; 515 Lisp_Object retval = Qnil;
557 int modemask; 516 int modemask;
558 int accessmask = 0; 517 int accessmask = 0;
559 XEMACS_DB_TYPE the_type; 518 struct database *dbase = NULL;
560 DB_FUNCS *funcblock; 519 char *filename;
561 struct database_struct *dbase = NULL;
562 void *db = NULL;
563 520
564 CHECK_STRING (file); 521 CHECK_STRING (file);
522 filename = (char *) XSTRING_DATA (file);
565 523
566 if (NILP (access_)) 524 if (NILP (access_))
567 { 525 {
568 accessmask = O_RDWR | O_CREAT; 526 accessmask = O_RDWR | O_CREAT;
569 } 527 }
570 else 528 else
571 { 529 {
572 char *acc; 530 char *acc;
573 CHECK_STRING (access_); 531 CHECK_STRING (access_);
574 acc = (char *) XSTRING_DATA (access_); 532 acc = (char *) XSTRING_DATA (access_);
575 533
576 if (strchr (acc, '+')) 534 if (strchr (acc, '+'))
577 accessmask |= O_CREAT; 535 accessmask |= O_CREAT;
578 536
579 if (strchr (acc, 'r') && strchr (acc, 'w')) 537 if (strchr (acc, 'r') && strchr (acc, 'w'))
580 {
581 accessmask |= O_RDWR; 538 accessmask |= O_RDWR;
582 }
583 else if (strchr (acc, 'w')) 539 else if (strchr (acc, 'w'))
584 {
585 accessmask |= O_WRONLY; 540 accessmask |= O_WRONLY;
586 }
587 else 541 else
588 {
589 accessmask |= O_RDONLY; 542 accessmask |= O_RDONLY;
590 }
591 } 543 }
592 544
593 if (NILP (mode)) 545 if (NILP (mode))
594 { 546 {
595 modemask = 493; /* rwxr-xr-x */ 547 modemask = 0755; /* rwxr-xr-x */
596 } 548 }
597 else 549 else
598 { 550 {
599 CHECK_INT (mode); 551 CHECK_INT (mode);
600 modemask = XINT (mode); 552 modemask = XINT (mode);
601 } 553 }
602 554
603 #ifdef HAVE_DBM 555 #ifdef HAVE_DBM
604 if (NILP (type) || EQ (type, Qdbm)) 556 if (NILP (type) || EQ (type, Qdbm))
605 { 557 {
606 the_type = DB_DBM; 558 DBM *dbm = dbm_open (filename, accessmask, modemask);
607 funcblock = &ndbm_func_block; 559 if (!dbm)
560 return Qnil;
561
562 dbase = new_database ();
563 dbase->dbm_handle = dbm;
564 dbase->type = DB_DBM;
565 dbase->funcs = &ndbm_func_block;
608 goto db_done; 566 goto db_done;
609 } 567 }
610 #endif 568 #endif /* HAVE_DBM */
611 569
612 #ifdef HAVE_BERKELEY_DB 570 #ifdef HAVE_BERKELEY_DB
613 if (NILP (type) || EQ (type, Qberkeley_db)) 571 if (NILP (type) || EQ (type, Qberkeley_db))
614 { 572 {
615 573 DBTYPE real_subtype;
616 funcblock = &berk_func_block; 574 DB *db;
617 the_type = DB_BERKELEY; 575
576 if (EQ (subtype, Qhash) || NILP (subtype))
577 real_subtype = DB_HASH;
578 else if (EQ (subtype, Qbtree))
579 real_subtype = DB_BTREE;
580 else if (EQ (subtype, Qrecno))
581 real_subtype = DB_RECNO;
582 else
583 signal_simple_error ("Unsupported subtype", subtype);
584
585 db = dbopen (filename, accessmask, modemask, real_subtype, NULL);
586 if (!db)
587 return Qnil;
588
589 dbase = new_database ();
590 dbase->db_handle = db;
591 dbase->type = DB_BERKELEY;
592 dbase->funcs = &berk_func_block;
618 goto db_done; 593 goto db_done;
619 } 594 }
620 #endif 595 #endif /* HAVE_BERKELEY_DB */
621 596
622 signal_simple_error ("Unsupported database type", type); 597 signal_simple_error ("Unsupported database type", type);
623 return Qnil; 598 return Qnil;
624 599
625 db_done: 600 db_done:
626 db = funcblock->open_file ((char *) XSTRING_DATA (file), subtype, 601 dbase->live_p = 1;
627 accessmask, modemask);
628
629 if (!db)
630 {
631 return Qnil;
632 }
633
634 dbase = new_database ();
635 dbase->fname = file; 602 dbase->fname = file;
636 dbase->type = the_type;
637 dbase->mode = modemask; 603 dbase->mode = modemask;
638 dbase->access_ = accessmask; 604 dbase->access_ = accessmask;
639 dbase->db_handle = db;
640 dbase->funcs = funcblock;
641 XSETDATABASE (retval, dbase); 605 XSETDATABASE (retval, dbase);
642 606
643 return retval; 607 return retval;
644 } 608 }
645 609
646 DEFUN ("put-database", Fputdatabase, 3, 4, 0, /* 610 DEFUN ("put-database", Fputdatabase, 3, 4, 0, /*
647 Store KEY and VAL in DATABASE. If optinal fourth arg REPLACE is 611 Store KEY and VAL in DATABASE. If optional fourth arg REPLACE is
648 non-nil, replace any existing entry in the database. 612 non-nil, replace any existing entry in the database.
649 */ 613 */
650 (key, val, dbase, replace)) 614 (key, val, dbase, replace))
651 { 615 {
652 struct database_struct *db; 616 CHECK_LIVE_DATABASE (dbase);
653 int status;
654 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
655
656 CHECK_DATABASE (dbase);
657 CHECK_STRING (key); 617 CHECK_STRING (key);
658 CHECK_STRING (val); 618 CHECK_STRING (val);
659 db = XDATABASE (dbase); 619
660 if (!DATABASE_LIVE_P (db)) 620 {
661 signal_simple_error ("Attempting to access closed database", dbase); 621 int status =
662 622 XDATABASE (dbase)->funcs->put (XDATABASE (dbase), key, val, replace);
663 GCPRO4 (key, val, dbase, replace); 623 return status ? Qt : Qnil;
664 status = db->funcs->put (db, key, val, replace); 624 }
665 UNGCPRO;
666 return status ? Qt : Qnil;
667 } 625 }
668 626
669 DEFUN ("remove-database", Fremdatabase, 2, 2, 0, /* 627 DEFUN ("remove-database", Fremdatabase, 2, 2, 0, /*
670 Remove KEY from DATABASE. 628 Remove KEY from DATABASE.
671 */ 629 */
672 (key, dbase)) 630 (key, dbase))
673 { 631 {
674 struct database_struct *db; 632 CHECK_LIVE_DATABASE (dbase);
675 CHECK_DATABASE (dbase);
676 CHECK_STRING (key); 633 CHECK_STRING (key);
677 634
678 db = XDATABASE (dbase); 635 return XDATABASE (dbase)->funcs->rem (XDATABASE (dbase), key) ? Qt : Qnil;
679 if (!DATABASE_LIVE_P (db)) 636 }
680 signal_simple_error ("Attempting to access closed database", dbase); 637
681 return db->funcs->rem (db, key) ? Qt : Qnil;
682 }
683
684 DEFUN ("get-database", Fgetdatabase, 2, 3, 0, /* 638 DEFUN ("get-database", Fgetdatabase, 2, 3, 0, /*
685 Find value for KEY in DATABASE. 639 Find value for KEY in DATABASE.
686 If there is no corresponding value, return DEFAULT (defaults to nil). 640 If there is no corresponding value, return DEFAULT (defaults to nil).
687 */ 641 */
688 (key, dbase, default_)) 642 (key, dbase, default_))
689 { 643 {
690 Lisp_Object retval; 644
691 struct database_struct *db; 645 CHECK_LIVE_DATABASE (dbase);
692
693 CHECK_DATABASE (dbase);
694 CHECK_STRING (key); 646 CHECK_STRING (key);
695 db = XDATABASE (dbase); 647
696 if (!DATABASE_LIVE_P (db)) 648 {
697 signal_simple_error ("Attempting to access closed database", dbase); 649 Lisp_Object retval =
698 650 XDATABASE (dbase)->funcs->get (XDATABASE (dbase), key);
699 retval = db->funcs->get (db, key); 651 return NILP (retval) ? default_ : retval;
700 652 }
701 return NILP (retval) ? default_ : retval;
702 } 653 }
703 654
704 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* 655 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
705 Map FUNCTION over entries in DATABASE, calling it with two args, 656 Map FUNCTION over entries in DATABASE, calling it with two args,
706 each key and value in the database. 657 each key and value in the database.
707 */ 658 */
708 (function, dbase)) 659 (function, dbase))
709 { 660 {
710 struct gcpro gcpro1, gcpro2; 661 CHECK_LIVE_DATABASE (dbase);
711 struct database_struct *db; 662
712 663 XDATABASE (dbase)->funcs->map (XDATABASE (dbase), function);
713 CHECK_DATABASE (dbase); 664
714 GCPRO2 (dbase, function);
715
716 db = XDATABASE (dbase);
717 if (!DATABASE_LIVE_P (db))
718 signal_simple_error ("Attempting to access closed database", dbase);
719 db->funcs->map (db, function);
720 UNGCPRO;
721 return Qnil; 665 return Qnil;
722 } 666 }
723 667
724 void 668 void
725 syms_of_dbm (void) 669 syms_of_dbm (void)