Mercurial > hg > xemacs-beta

comparison src/database.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 78478c60bfcd
children 54f7aa390f4f
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
24 /* Substantially rewritten by Martin Buchholz */ 24 /* Substantially rewritten by Martin Buchholz */
25 /* db 2.x support added by Andreas Jaeger */ 25 /* db 2.x support added by Andreas Jaeger */
26 26
27 #include <config.h> 27 #include <config.h>
28 #include "lisp.h" 28 #include "lisp.h"
29 #include "sysfile.h"
29 #include <errno.h> 30 #include <errno.h>
30 31
31 #ifndef HAVE_DATABASE 32 #ifndef HAVE_DATABASE
32 #error database.c being compiled, but HAVE_DATABASE not defined! 33 #error HAVE_DATABASE not defined!!
33 #endif /* HAVE_DATABASE */ 34 #endif
34 35
35 #include "database.h" /* Our include file */ 36 #include "database.h" /* Our include file */
36 37
37 #ifdef HAVE_BERKELEY_DB 38 #ifdef HAVE_BERKELEY_DB
38 /* Work around Berkeley DB's use of int types which are defined 39 /* Work around Berkeley DB's use of int types which are defined
54 #include DB_H_PATH /* Berkeley db's header file */ 55 #include DB_H_PATH /* Berkeley db's header file */
55 #ifndef DB_VERSION_MAJOR 56 #ifndef DB_VERSION_MAJOR
56 # define DB_VERSION_MAJOR 1 57 # define DB_VERSION_MAJOR 1
57 #endif /* DB_VERSION_MAJOR */ 58 #endif /* DB_VERSION_MAJOR */
58 Lisp_Object Qberkeley_db; 59 Lisp_Object Qberkeley_db;
59 Lisp_Object Qhash; 60 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
60 Lisp_Object Qbtree;
61 Lisp_Object Qrecno;
62 #endif /* HAVE_BERKELEY_DB */ 61 #endif /* HAVE_BERKELEY_DB */
63 62
64 #ifdef HAVE_DBM 63 #ifdef HAVE_DBM
65 #include <ndbm.h> 64 #include <ndbm.h>
66 Lisp_Object Qdbm; 65 Lisp_Object Qdbm;
68 67
69 Lisp_Object Qdatabasep; 68 Lisp_Object Qdatabasep;
70 69
71 typedef enum { DB_DBM, DB_BERKELEY, DB_IS_UNKNOWN } XEMACS_DB_TYPE; 70 typedef enum { DB_DBM, DB_BERKELEY, DB_IS_UNKNOWN } XEMACS_DB_TYPE;
72 71
73 struct database; 72 struct Lisp_Database;
74 typedef struct database database;
75 73
76 typedef struct 74 typedef struct
77 { 75 {
78 CONST char * (*get_subtype) (struct database *); 76 Lisp_Object (*get_subtype) (struct Lisp_Database *);
79 CONST char * (*get_type) (struct database *); 77 Lisp_Object (*get_type) (struct Lisp_Database *);
80 Lisp_Object (*get) (struct database *, Lisp_Object); 78 Lisp_Object (*get) (struct Lisp_Database *, Lisp_Object);
81 int (*put) (struct database *, Lisp_Object, Lisp_Object, Lisp_Object); 79 int (*put) (struct Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object);
82 int (*rem) (struct database *, Lisp_Object); 80 int (*rem) (struct Lisp_Database *, Lisp_Object);
83 void (*map) (struct database *, Lisp_Object); 81 void (*map) (struct Lisp_Database *, Lisp_Object);
84 Lisp_Object (*get_lisp_type) (struct database *); 82 void (*close) (struct Lisp_Database *);
85 void (*close) (struct database *); 83 Lisp_Object (*last_error) (struct Lisp_Database *);
86 Lisp_Object (*last_error) (struct database *);
87 } DB_FUNCS; 84 } DB_FUNCS;
88 85
89 struct database 86 struct Lisp_Database
90 { 87 {
91 struct lcrecord_header header; 88 struct lcrecord_header header;
92 Lisp_Object fname; 89 Lisp_Object fname;
93 XEMACS_DB_TYPE type; 90 XEMACS_DB_TYPE type;
94 int mode; 91 int mode;
105 #ifdef MULE 102 #ifdef MULE
106 Lisp_Object coding_system; 103 Lisp_Object coding_system;
107 #endif 104 #endif
108 }; 105 };
109 106
110 #define XDATABASE(x) XRECORD (x, database, struct database) 107 #define XDATABASE(x) XRECORD (x, database, struct Lisp_Database)
111 #define XSETDATABASE(x, p) XSETRECORD (x, p, database) 108 #define XSETDATABASE(x, p) XSETRECORD (x, p, database)
112 #define DATABASEP(x) RECORDP (x, database) 109 #define DATABASEP(x) RECORDP (x, database)
113 #define GC_DATABASEP(x) GC_RECORDP (x, database) 110 #define GC_DATABASEP(x) GC_RECORDP (x, database)
114 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) 111 #define CHECK_DATABASE(x) CHECK_RECORD (x, database)
115 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) 112 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database)
116 #define DATABASE_LIVE_P(x) (x->live_p) 113 #define DATABASE_LIVE_P(x) (x->live_p)
117 static Lisp_Object mark_database (Lisp_Object, void (*) (Lisp_Object)); 114
118 static void print_database (Lisp_Object, Lisp_Object, int); 115 #define CHECK_LIVE_DATABASE(db) do { \
119 static void finalize_database (void *, int); 116 CHECK_DATABASE (db); \
117 if (!DATABASE_LIVE_P (XDATABASE(db))) \
118 signal_simple_error ("Attempting to access closed database", db); \
119 } while (0)
120
121
122 static struct Lisp_Database *
123 allocate_database (void)
124 {
125 struct Lisp_Database *db =
126 alloc_lcrecord_type (struct Lisp_Database, lrecord_database);
127
128 db->fname = Qnil;
129 db->live_p = 0;
130 #ifdef HAVE_BERKELEY_DB
131 db->db_handle = NULL;
132 #endif
133 #ifdef HAVE_DBM
134 db->dbm_handle = NULL;
135 #endif
136 db->access_ = 0;
137 db->mode = 0;
138 db->dberrno = 0;
139 db->type = DB_IS_UNKNOWN;
140 #ifdef MULE
141 db->coding_system = Fget_coding_system (Qbinary);
142 #endif
143 return db;
144 }
145
146 static Lisp_Object
147 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object))
148 {
149 struct Lisp_Database *db = XDATABASE (obj);
150
151 ((markobj) (db->fname));
152 return Qnil;
153 }
154
155 static void
156 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
157 {
158 char buf[64];
159 struct Lisp_Database *db = XDATABASE (obj);
160
161 if (print_readably)
162 error ("printing unreadable object #<database 0x%x>", db->header.uid);
163
164 write_c_string ("#<database \"", printcharfun);
165 print_internal (db->fname, printcharfun, 0);
166 sprintf (buf, "\" (%s/%s/%s) 0x%x>",
167 (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name),
168 (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name),
169 (!DATABASE_LIVE_P (db) ? "closed" :
170 (db->access_ & O_WRONLY) ? "writeonly" :
171 (db->access_ & O_RDWR) ? "readwrite" : "readonly"),
172 db->header.uid);
173 write_c_string (buf, printcharfun);
174 }
175
176 static void
177 finalize_database (void *header, int for_disksave)
178 {
179 struct Lisp_Database *db = (struct Lisp_Database *) header;
180
181 if (for_disksave)
182 {
183 Lisp_Object obj;
184 XSETOBJ (obj, Lisp_Type_Record, (void *) db);
185
186 signal_simple_error
187 ("Can't dump an emacs containing database objects", obj);
188 }
189 db->funcs->close (db);
190 }
191
120 DEFINE_LRECORD_IMPLEMENTATION ("database", database, 192 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
121 mark_database, print_database, 193 mark_database, print_database,
122 finalize_database, 0, 0, 194 finalize_database, 0, 0,
123 struct database); 195 struct Lisp_Database);
124 196
125 #define CHECK_LIVE_DATABASE(db) do { \ 197 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
126 CHECK_DATABASE(db); \ 198 Close database DATABASE.
127 if (!DATABASE_LIVE_P (XDATABASE(db))) \ 199 */
128 signal_simple_error ("Attempting to access closed database", db); \ 200 (database))
129 } while (0) 201 {
130 202 struct Lisp_Database *db;
131 203 CHECK_LIVE_DATABASE (database);
132 static struct database * 204 db = XDATABASE (database);
133 allocate_database (void) 205 db->funcs->close (db);
134 { 206 db->live_p = 0;
135 struct database *dbase =
136 alloc_lcrecord_type (struct database, lrecord_database);
137
138 dbase->fname = Qnil;
139 dbase->live_p = 0;
140 #ifdef HAVE_BERKELEY_DB
141 dbase->db_handle = NULL;
142 #endif
143 #ifdef HAVE_DBM
144 dbase->dbm_handle = NULL;
145 #endif
146 dbase->access_ = 0;
147 dbase->mode = 0;
148 dbase->dberrno = 0;
149 dbase->type = DB_IS_UNKNOWN;
150 #ifdef MULE
151 dbase->coding_system = Fget_coding_system (Qbinary);
152 #endif
153 return dbase;
154 }
155
156 static Lisp_Object
157 mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object))
158 {
159 struct database *dbase = XDATABASE (obj);
160
161 ((markobj) (dbase->fname));
162 return Qnil; 207 return Qnil;
163 } 208 }
164 209
165 static void 210 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
166 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 211 Return the type of database DATABASE.
167 { 212 */
168 char buf[64]; 213 (database))
169 struct database *dbase = XDATABASE (obj); 214 {
170 215 CHECK_DATABASE (database);
171 if (print_readably) 216
172 error ("printing unreadable object #<database 0x%x>", dbase->header.uid); 217 return XDATABASE (database)->funcs->get_type (XDATABASE (database));
173 218 }
174 write_c_string ("#<database \"", printcharfun); 219
175 print_internal (dbase->fname, printcharfun, 0); 220 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
176 sprintf (buf, "\" (%s/%s/%s) 0x%x>", 221 Return the subtype of database DATABASE, if any.
177 dbase->funcs->get_type (dbase), 222 */
178 dbase->funcs->get_subtype (dbase), 223 (database))
179 (!DATABASE_LIVE_P (dbase) ? "closed" : 224 {
180 (dbase->access_ & O_WRONLY) ? "writeonly" : 225 CHECK_DATABASE (database);
181 (dbase->access_ & O_RDWR) ? "readwrite" : "readonly"), 226
182 dbase->header.uid); 227 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
183 write_c_string (buf, printcharfun); 228 }
184 } 229
185 230 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
186 static void 231 Return t if OBJ is an active database.
187 finalize_database (void *header, int for_disksave)
188 {
189 struct database *db = (struct database *) header;
190
191 if (for_disksave)
192 {
193 Lisp_Object obj;
194 XSETOBJ (obj, Lisp_Type_Record, (void *) db);
195
196 signal_simple_error
197 ("Can't dump an emacs containing window system objects", obj);
198 }
199 db->funcs->close (db);
200 }
201
202 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
203 Close database OBJ.
204 */ 232 */
205 (obj)) 233 (obj))
206 { 234 {
207 CHECK_LIVE_DATABASE (obj); 235 return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
208 XDATABASE (obj)->funcs->close (XDATABASE (obj));
209 XDATABASE (obj)->live_p = 0;
210 return Qnil;
211 }
212
213 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
214 Return the type of database OBJ.
215 */
216 (obj))
217 {
218 CHECK_DATABASE (obj);
219
220 return XDATABASE (obj)->funcs->get_lisp_type (XDATABASE (obj));
221 }
222
223 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
224 Return the subtype of database OBJ, if any.
225 */
226 (obj))
227 {
228 CHECK_DATABASE (obj);
229
230 return intern (XDATABASE (obj)->funcs->get_subtype (XDATABASE (obj)));
231 }
232
233 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
234 Return t iff OBJ is an active database, else nil.
235 */
236 (obj))
237 {
238 CHECK_DATABASE (obj);
239
240 return DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil;
241 } 236 }
242 237
243 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* 238 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
244 Return the filename associated with the database OBJ. 239 Return the filename associated with the database DATABASE.
245 */ 240 */
246 (obj)) 241 (database))
247 { 242 {
248 CHECK_DATABASE (obj); 243 CHECK_DATABASE (database);
249 244
250 return XDATABASE (obj)->fname; 245 return XDATABASE (database)->fname;
251 } 246 }
252 247
253 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* 248 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
254 Return t iff OBJ is a database, else nil. 249 Return t if OBJ is a database.
255 */ 250 */
256 (obj)) 251 (obj))
257 { 252 {
258 return DATABASEP (obj) ? Qt : Qnil; 253 return DATABASEP (obj) ? Qt : Qnil;
259 } 254 }
260 255
261 #ifdef HAVE_DBM 256 #ifdef HAVE_DBM
262 static void 257 static void
263 dbm_map (struct database *db, Lisp_Object func) 258 dbm_map (struct Lisp_Database *db, Lisp_Object func)
264 { 259 {
265 datum keydatum, valdatum; 260 datum keydatum, valdatum;
266 Lisp_Object key, val; 261 Lisp_Object key, val;
267 262
268 for (keydatum = dbm_firstkey (db->dbm_handle); 263 for (keydatum = dbm_firstkey (db->dbm_handle);
275 call2 (func, key, val); 270 call2 (func, key, val);
276 } 271 }
277 } 272 }
278 273
279 static Lisp_Object 274 static Lisp_Object
280 dbm_get (struct database *db, Lisp_Object key) 275 dbm_get (struct Lisp_Database *db, Lisp_Object key)
281 { 276 {
282 datum keydatum, valdatum; 277 datum keydatum, valdatum;
283 278
284 keydatum.dptr = (char *) XSTRING_DATA (key); 279 keydatum.dptr = (char *) XSTRING_DATA (key);
285 keydatum.dsize = XSTRING_LENGTH (key); 280 keydatum.dsize = XSTRING_LENGTH (key);
289 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) 284 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize)
290 : Qnil); 285 : Qnil);
291 } 286 }
292 287
293 static int 288 static int
294 dbm_put (struct database *db, 289 dbm_put (struct Lisp_Database *db,
295 Lisp_Object key, Lisp_Object val, Lisp_Object replace) 290 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
296 { 291 {
297 datum keydatum, valdatum; 292 datum keydatum, valdatum;
298 293
299 valdatum.dptr = (char *) XSTRING_DATA (val); 294 valdatum.dptr = (char *) XSTRING_DATA (val);
304 return !dbm_store (db->dbm_handle, keydatum, valdatum, 299 return !dbm_store (db->dbm_handle, keydatum, valdatum,
305 NILP (replace) ? DBM_INSERT : DBM_REPLACE); 300 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
306 } 301 }
307 302
308 static int 303 static int
309 dbm_remove (struct database *db, Lisp_Object key) 304 dbm_remove (struct Lisp_Database *db, Lisp_Object key)
310 { 305 {
311 datum keydatum; 306 datum keydatum;
312 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 310
316 return dbm_delete (db->dbm_handle, keydatum); 311 return dbm_delete (db->dbm_handle, keydatum);
317 } 312 }
318 313
319 static Lisp_Object 314 static Lisp_Object
320 dbm_lisp_type (struct database *db) 315 dbm_type (struct Lisp_Database *db)
321 { 316 {
322 return Qdbm; 317 return Qdbm;
323 } 318 }
324 319
325 static CONST char * 320 static Lisp_Object
326 dbm_type (struct database *db) 321 dbm_subtype (struct Lisp_Database *db)
327 { 322 {
328 return "dbm"; 323 return Qnil;
329 } 324 }
330 325
331 static CONST char * 326 static Lisp_Object
332 dbm_subtype (struct database *db) 327 dbm_lasterr (struct Lisp_Database *db)
333 { 328 {
334 return "nil"; 329 return lisp_strerror (db->dberrno);
335 }
336
337 static Lisp_Object
338 dbm_lasterr (struct database *dbp)
339 {
340 return lisp_strerror (dbp->dberrno);
341 } 330 }
342 331
343 static void 332 static void
344 dbm_closeit (struct database *db) 333 dbm_closeit (struct Lisp_Database *db)
345 { 334 {
346 if (db->dbm_handle) 335 if (db->dbm_handle)
347 { 336 {
348 dbm_close (db->dbm_handle); 337 dbm_close (db->dbm_handle);
349 db->dbm_handle = NULL; 338 db->dbm_handle = NULL;
356 dbm_type, 345 dbm_type,
357 dbm_get, 346 dbm_get,
358 dbm_put, 347 dbm_put,
359 dbm_remove, 348 dbm_remove,
360 dbm_map, 349 dbm_map,
361 dbm_lisp_type,
362 dbm_closeit, 350 dbm_closeit,
363 dbm_lasterr 351 dbm_lasterr
364 }; 352 };
365 #endif /* HAVE_DBM */ 353 #endif /* HAVE_DBM */
366 354
367 #ifdef HAVE_BERKELEY_DB 355 #ifdef HAVE_BERKELEY_DB
368 static Lisp_Object 356 static Lisp_Object
369 berkdb_lisp_type (struct database *db) 357 berkdb_type (struct Lisp_Database *db)
370 { 358 {
371 return Qberkeley_db; 359 return Qberkeley_db;
372 } 360 }
373 361
374 static CONST char * 362 static Lisp_Object
375 berkdb_type (struct database *db) 363 berkdb_subtype (struct Lisp_Database *db)
376 {
377 return "berkeley";
378 }
379
380 static CONST char *
381 berkdb_subtype (struct database *db)
382 { 364 {
383 if (!db->db_handle) 365 if (!db->db_handle)
384 return "nil"; 366 return Qnil;
385 367
386 switch (db->db_handle->type) 368 switch (db->db_handle->type)
387 { 369 {
388 case DB_BTREE: return "btree"; 370 case DB_BTREE: return Qbtree;
389 case DB_HASH: return "hash"; 371 case DB_HASH: return Qhash;
390 case DB_RECNO: return "recno"; 372 case DB_RECNO: return Qrecno;
391 default: return "unknown"; 373 default: return Qunknown;
392 } 374 }
393 } 375 }
394 376
395 static Lisp_Object 377 static Lisp_Object
396 berkdb_lasterr (struct database *dbp) 378 berkdb_lasterr (struct Lisp_Database *db)
397 { 379 {
398 return lisp_strerror (dbp->dberrno); 380 return lisp_strerror (db->dberrno);
399 } 381 }
400 382
401 static Lisp_Object 383 static Lisp_Object
402 berkdb_get (struct database *db, Lisp_Object key) 384 berkdb_get (struct Lisp_Database *db, Lisp_Object key)
403 { 385 {
404 /* #### Needs mule-izing */ 386 /* #### Needs mule-izing */
405 DBT keydatum, valdatum; 387 DBT keydatum, valdatum;
406 int status = 0; 388 int status = 0;
407 389
408 #if DB_VERSION_MAJOR == 2 390 #if DB_VERSION_MAJOR == 2
409 /* Always initialize keydatum, valdatum. */ 391 /* Always initialize keydatum, valdatum. */
410 memset(&keydatum, 0, sizeof(keydatum)); 392 xzero (keydatum);
411 memset(&valdatum, 0, sizeof(valdatum)); 393 xzero (valdatum);
412 #endif /* DV_VERSION_MAJOR = 2 */ 394 #endif /* DV_VERSION_MAJOR = 2 */
413 395
414 keydatum.data = XSTRING_DATA (key); 396 keydatum.data = XSTRING_DATA (key);
415 keydatum.size = XSTRING_LENGTH (key); 397 keydatum.size = XSTRING_LENGTH (key);
416 398
431 413
432 return Qnil; 414 return Qnil;
433 } 415 }
434 416
435 static int 417 static int
436 berkdb_put (struct database *db, 418 berkdb_put (struct Lisp_Database *db,
437 Lisp_Object key, 419 Lisp_Object key,
438 Lisp_Object val, 420 Lisp_Object val,
439 Lisp_Object replace) 421 Lisp_Object replace)
440 { 422 {
441 DBT keydatum, valdatum; 423 DBT keydatum, valdatum;
442 int status = 0; 424 int status = 0;
443 425
444 #if DB_VERSION_MAJOR == 2 426 #if DB_VERSION_MAJOR == 2
445 /* Always initalize keydatum, valdatum. */ 427 /* Always initalize keydatum, valdatum. */
446 memset(&keydatum, 0, sizeof(keydatum)); 428 xzero (keydatum);
447 memset(&valdatum, 0, sizeof(valdatum)); 429 xzero (valdatum);
448 #endif /* DV_VERSION_MAJOR = 2 */ 430 #endif /* DV_VERSION_MAJOR = 2 */
449 431
450 keydatum.data = XSTRING_DATA (key); 432 keydatum.data = XSTRING_DATA (key);
451 keydatum.size = XSTRING_LENGTH (key); 433 keydatum.size = XSTRING_LENGTH (key);
452 valdatum.data = XSTRING_DATA (val); 434 valdatum.data = XSTRING_DATA (val);
463 445
464 return status; 446 return status;
465 } 447 }
466 448
467 static int 449 static int
468 berkdb_remove (struct database *db, Lisp_Object key) 450 berkdb_remove (struct Lisp_Database *db, Lisp_Object key)
469 { 451 {
470 DBT keydatum; 452 DBT keydatum;
471 int status; 453 int status;
472 454
473 #if DB_VERSION_MAJOR == 2 455 #if DB_VERSION_MAJOR == 2
474 /* Always initialize keydatum. */ 456 /* Always initialize keydatum. */
475 memset(&keydatum, 0, sizeof(keydatum)); 457 xzero (keydatum);
476 #endif /* DV_VERSION_MAJOR = 2 */ 458 #endif /* DV_VERSION_MAJOR = 2 */
477 459
478 keydatum.data = XSTRING_DATA (key); 460 keydatum.data = XSTRING_DATA (key);
479 keydatum.size = XSTRING_LENGTH (key); 461 keydatum.size = XSTRING_LENGTH (key);
480 462
495 477
496 return 1; 478 return 1;
497 } 479 }
498 480
499 static void 481 static void
500 berkdb_map (struct database *db, Lisp_Object func) 482 berkdb_map (struct Lisp_Database *db, Lisp_Object func)
501 { 483 {
502 DBT keydatum, valdatum; 484 DBT keydatum, valdatum;
503 Lisp_Object key, val; 485 Lisp_Object key, val;
504 DB *dbp = db->db_handle; 486 DB *dbp = db->db_handle;
505 int status; 487 int status;
515 call2 (func, key, val); 497 call2 (func, key, val);
516 } 498 }
517 #else 499 #else
518 DBC *dbcp; 500 DBC *dbcp;
519 /* Initialize the key/data pair so the flags aren't set. */ 501 /* Initialize the key/data pair so the flags aren't set. */
520 memset(&keydatum, 0, sizeof(keydatum)); 502 xzero (keydatum);
521 memset(&valdatum, 0, sizeof(valdatum)); 503 xzero (valdatum);
522 504
523 status = dbp->cursor (dbp, NULL, &dbcp); 505 status = dbp->cursor (dbp, NULL, &dbcp);
524 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); 506 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
525 status == 0; 507 status == 0;
526 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) 508 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
533 dbcp->c_close (dbcp); 515 dbcp->c_close (dbcp);
534 #endif /* DB_VERSION_MAJOR */ 516 #endif /* DB_VERSION_MAJOR */
535 } 517 }
536 518
537 static void 519 static void
538 berkdb_close (struct database *db) 520 berkdb_close (struct Lisp_Database *db)
539 { 521 {
540 if (db->db_handle) 522 if (db->db_handle)
541 { 523 {
542 #if DB_VERSION_MAJOR == 1 524 #if DB_VERSION_MAJOR == 1
543 db->db_handle->sync (db->db_handle, 0); 525 db->db_handle->sync (db->db_handle, 0);
556 berkdb_type, 538 berkdb_type,
557 berkdb_get, 539 berkdb_get,
558 berkdb_put, 540 berkdb_put,
559 berkdb_remove, 541 berkdb_remove,
560 berkdb_map, 542 berkdb_map,
561 berkdb_lisp_type,
562 berkdb_close, 543 berkdb_close,
563 berkdb_lasterr 544 berkdb_lasterr
564 }; 545 };
565 #endif /* HAVE_BERKELEY_DB */ 546 #endif /* HAVE_BERKELEY_DB */
566 547
567 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /* 548 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
568 Return the last error associated with database OBJ. 549 Return the last error associated with DATABASE.
569 */ 550 */
570 (obj)) 551 (database))
571 { 552 {
572 if (NILP (obj)) 553 if (NILP (database))
573 return lisp_strerror (errno); 554 return lisp_strerror (errno);
574 555
575 CHECK_DATABASE (obj); 556 CHECK_DATABASE (database);
576 557
577 return XDATABASE (obj)->funcs->last_error (XDATABASE (obj)); 558 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
578 } 559 }
579 560
580 DEFUN ("open-database", Fopen_database, 1, 5, 0, /* 561 DEFUN ("open-database", Fopen_database, 1, 5, 0, /*
581 Open database FILE, using database method TYPE and SUBTYPE, with 562 Return a new database object opened on FILE.
582 access rights ACCESS and permissions MODE. ACCESS can be any 563 Optional arguments TYPE and SUBTYPE specify the database type.
564 Optional argument ACCESS specifies the access rights, which may be any
583 combination of 'r' 'w' and '+', for read, write, and creation flags. 565 combination of 'r' 'w' and '+', for read, write, and creation flags.
566 Optional argument MODE gives the permissions to use when opening FILE,
567 and defaults to 0755.
584 */ 568 */
585 (file, type, subtype, access_, mode)) 569 (file, type, subtype, access_, mode))
586 { 570 {
587 /* This function can GC */ 571 /* This function can GC */
588 Lisp_Object retval = Qnil;
589 int modemask; 572 int modemask;
590 int accessmask = 0; 573 int accessmask = 0;
591 struct database *dbase = NULL; 574 struct Lisp_Database *db = NULL;
592 char *filename; 575 char *filename;
593 struct gcpro gcpro1, gcpro2; 576 struct gcpro gcpro1, gcpro2;
594 577
595 CHECK_STRING (file); 578 CHECK_STRING (file);
596 GCPRO2 (file, access_); 579 GCPRO2 (file, access_);
609 acc = (char *) XSTRING_DATA (access_); 592 acc = (char *) XSTRING_DATA (access_);
610 593
611 if (strchr (acc, '+')) 594 if (strchr (acc, '+'))
612 accessmask |= O_CREAT; 595 accessmask |= O_CREAT;
613 596
614 if (strchr (acc, 'r') && strchr (acc, 'w')) 597 {
615 accessmask |= O_RDWR; 598 char *rp = strchr (acc, 'r');
616 else if (strchr (acc, 'w')) 599 char *wp = strchr (acc, 'w');
617 accessmask |= O_WRONLY; 600 if (rp && wp) accessmask |= O_RDWR;
618 else 601 else if (wp) accessmask |= O_WRONLY;
619 accessmask |= O_RDONLY; 602 else accessmask |= O_RDONLY;
603 }
620 } 604 }
621 605
622 if (NILP (mode)) 606 if (NILP (mode))
623 { 607 {
624 modemask = 0755; /* rwxr-xr-x */ 608 modemask = 0755; /* rwxr-xr-x */
630 } 614 }
631 615
632 #ifdef HAVE_DBM 616 #ifdef HAVE_DBM
633 if (NILP (type) || EQ (type, Qdbm)) 617 if (NILP (type) || EQ (type, Qdbm))
634 { 618 {
635 DBM *dbm = dbm_open (filename, accessmask, modemask); 619 DBM *dbase = dbm_open (filename, accessmask, modemask);
636 if (!dbm) 620 if (!dbase)
637 return Qnil; 621 return Qnil;
638 622
639 dbase = allocate_database (); 623 db = allocate_database ();
640 dbase->dbm_handle = dbm; 624 db->dbm_handle = dbase;
641 dbase->type = DB_DBM; 625 db->type = DB_DBM;
642 dbase->funcs = &ndbm_func_block; 626 db->funcs = &ndbm_func_block;
643 goto db_done; 627 goto db_done;
644 } 628 }
645 #endif /* HAVE_DBM */ 629 #endif /* HAVE_DBM */
646 630
647 #ifdef HAVE_BERKELEY_DB 631 #ifdef HAVE_BERKELEY_DB
648 if (NILP (type) || EQ (type, Qberkeley_db)) 632 if (NILP (type) || EQ (type, Qberkeley_db))
649 { 633 {
650 DBTYPE real_subtype; 634 DBTYPE real_subtype;
651 DB *db; 635 DB *dbase;
652 #if DB_VERSION_MAJOR != 1 636 #if DB_VERSION_MAJOR != 1
653 int status; 637 int status;
654 #endif 638 #endif
655 639
656 if (EQ (subtype, Qhash) || NILP (subtype)) 640 if (EQ (subtype, Qhash) || NILP (subtype))
661 real_subtype = DB_RECNO; 645 real_subtype = DB_RECNO;
662 else 646 else
663 signal_simple_error ("Unsupported subtype", subtype); 647 signal_simple_error ("Unsupported subtype", subtype);
664 648
665 #if DB_VERSION_MAJOR == 1 649 #if DB_VERSION_MAJOR == 1
666 db = dbopen (filename, accessmask, modemask, real_subtype, NULL); 650 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
667 if (!db) 651 if (!dbase)
668 return Qnil; 652 return Qnil;
669 #else 653 #else
670 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY, 654 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY,
671 other flags shouldn't be set */ 655 other flags shouldn't be set */
672 if (NILP (access_)) 656 if (NILP (access_))
673 { 657 accessmask = DB_CREATE;
674 accessmask = DB_CREATE;
675 }
676 else 658 else
677 { 659 {
678 char *acc; 660 char *acc;
679 CHECK_STRING (access_); 661 CHECK_STRING (access_);
680 acc = (char *) XSTRING_DATA (access_); 662 acc = (char *) XSTRING_DATA (access_);
681 accessmask = 0; 663 accessmask = 0;
682 664
683 if (strchr (acc, '+')) 665 if (strchr (acc, '+'))
684 accessmask |= DB_CREATE; 666 accessmask |= DB_CREATE;
685 667
686 if (strchr (acc, 'r') && !strchr (acc, 'w')) 668 if (strchr (acc, 'r') && !strchr (acc, 'w'))
687 accessmask |= DB_RDONLY; 669 accessmask |= DB_RDONLY;
688 } 670 }
689 status = db_open (filename, real_subtype, accessmask, modemask, NULL , NULL, &db); 671 status = db_open (filename, real_subtype, accessmask,
672 modemask, NULL , NULL, &dbase);
690 if (status) 673 if (status)
691 return Qnil; 674 return Qnil;
692 #endif /* DB_VERSION_MAJOR */ 675 #endif /* DB_VERSION_MAJOR */
693 676
694 dbase = allocate_database (); 677 db = allocate_database ();
695 dbase->db_handle = db; 678 db->db_handle = dbase;
696 dbase->type = DB_BERKELEY; 679 db->type = DB_BERKELEY;
697 dbase->funcs = &berk_func_block; 680 db->funcs = &berk_func_block;
698 goto db_done; 681 goto db_done;
699 } 682 }
700 #endif /* HAVE_BERKELEY_DB */ 683 #endif /* HAVE_BERKELEY_DB */
701 684
702 signal_simple_error ("Unsupported database type", type); 685 signal_simple_error ("Unsupported database type", type);
703 return Qnil; 686 return Qnil;
704 687
705 db_done: 688 db_done:
706 dbase->live_p = 1; 689 db->live_p = 1;
707 dbase->fname = file; 690 db->fname = file;
708 dbase->mode = modemask; 691 db->mode = modemask;
709 dbase->access_ = accessmask; 692 db->access_ = accessmask;
710 XSETDATABASE (retval, dbase); 693
711 694 {
712 return retval; 695 Lisp_Object retval;
696 XSETDATABASE (retval, db);
697 return retval;
698 }
713 } 699 }
714 700
715 DEFUN ("put-database", Fput_database, 3, 4, 0, /* 701 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
716 Store KEY and VAL in DATABASE. If optional fourth arg REPLACE is 702 Store KEY and VALUE in DATABASE.
717 non-nil, replace any existing entry in the database. 703 If optional fourth arg REPLACE is non-nil,
718 */ 704 replace any existing entry in the database.
719 (key, val, dbase, replace)) 705 */
720 { 706 (key, value, database, replace))
721 CHECK_LIVE_DATABASE (dbase); 707 {
708 CHECK_LIVE_DATABASE (database);
722 CHECK_STRING (key); 709 CHECK_STRING (key);
723 CHECK_STRING (val); 710 CHECK_STRING (value);
724
725 { 711 {
726 int status = 712 struct Lisp_Database *db = XDATABASE (database);
727 XDATABASE (dbase)->funcs->put (XDATABASE (dbase), key, val, replace); 713 int status = db->funcs->put (db, key, value, replace);
728 return status ? Qt : Qnil; 714 return status ? Qt : Qnil;
729 } 715 }
730 } 716 }
731 717
732 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /* 718 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
733 Remove KEY from DATABASE. 719 Remove KEY from DATABASE.
734 */ 720 */
735 (key, dbase)) 721 (key, database))
736 { 722 {
737 CHECK_LIVE_DATABASE (dbase); 723 CHECK_LIVE_DATABASE (database);
738 CHECK_STRING (key); 724 CHECK_STRING (key);
739 725 {
740 return XDATABASE (dbase)->funcs->rem (XDATABASE (dbase), key) ? Qt : Qnil; 726 struct Lisp_Database *db = XDATABASE (database);
727 int status = db->funcs->rem (db, key);
728 return status ? Qt : Qnil;
729 }
741 } 730 }
742 731
743 DEFUN ("get-database", Fget_database, 2, 3, 0, /* 732 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
744 Find value for KEY in DATABASE. 733 Return value for KEY in DATABASE.
745 If there is no corresponding value, return DEFAULT (defaults to nil). 734 If there is no corresponding value, return DEFAULT (defaults to nil).
746 */ 735 */
747 (key, dbase, default_)) 736 (key, database, default_))
748 { 737 {
749 738 CHECK_LIVE_DATABASE (database);
750 CHECK_LIVE_DATABASE (dbase);
751 CHECK_STRING (key); 739 CHECK_STRING (key);
752
753 { 740 {
754 Lisp_Object retval = 741 struct Lisp_Database *db = XDATABASE (database);
755 XDATABASE (dbase)->funcs->get (XDATABASE (dbase), key); 742 Lisp_Object retval = db->funcs->get (db, key);
756 return NILP (retval) ? default_ : retval; 743 return NILP (retval) ? default_ : retval;
757 } 744 }
758 } 745 }
759 746
760 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* 747 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
761 Map FUNCTION over entries in DATABASE, calling it with two args, 748 Map FUNCTION over entries in DATABASE, calling it with two args,
762 each key and value in the database. 749 each key and value in the database.
763 */ 750 */
764 (function, dbase)) 751 (function, database))
765 { 752 {
766 CHECK_LIVE_DATABASE (dbase); 753 CHECK_LIVE_DATABASE (database);
767 754
768 XDATABASE (dbase)->funcs->map (XDATABASE (dbase), function); 755 XDATABASE (database)->funcs->map (XDATABASE (database), function);
769 756
770 return Qnil; 757 return Qnil;
771 } 758 }
772 759
773 void 760 void
774 syms_of_dbm (void) 761 syms_of_database (void)
775 { 762 {
776 defsymbol (&Qdatabasep, "databasep"); 763 defsymbol (&Qdatabasep, "databasep");
777 #ifdef HAVE_DBM 764 #ifdef HAVE_DBM
778 defsymbol (&Qdbm, "dbm"); 765 defsymbol (&Qdbm, "dbm");
779 #endif 766 #endif
780 #ifdef HAVE_BERKELEY_DB 767 #ifdef HAVE_BERKELEY_DB
781 defsymbol (&Qberkeley_db, "berkeley-db"); 768 defsymbol (&Qberkeley_db, "berkeley-db");
782 defsymbol (&Qhash, "hash"); 769 defsymbol (&Qhash, "hash");
783 defsymbol (&Qbtree, "btree"); 770 defsymbol (&Qbtree, "btree");
784 defsymbol (&Qrecno, "recno"); 771 defsymbol (&Qrecno, "recno");
772 defsymbol (&Qunknown, "unknown");
785 #endif 773 #endif
786 774
787 DEFSUBR (Fopen_database); 775 DEFSUBR (Fopen_database);
788 DEFSUBR (Fdatabasep); 776 DEFSUBR (Fdatabasep);
789 DEFSUBR (Fmapdatabase); 777 DEFSUBR (Fmapdatabase);
797 DEFSUBR (Fdatabase_file_name); 785 DEFSUBR (Fdatabase_file_name);
798 DEFSUBR (Fclose_database); 786 DEFSUBR (Fclose_database);
799 } 787 }
800 788
801 void 789 void
802 vars_of_dbm (void) 790 vars_of_database (void)
803 { 791 {
804 #ifdef HAVE_DBM 792 #ifdef HAVE_DBM
805 Fprovide (Qdbm); 793 Fprovide (Qdbm);
806 #endif 794 #endif
807 #ifdef HAVE_BERKELEY_DB 795 #ifdef HAVE_BERKELEY_DB