Mercurial > hg > xemacs-beta

comparison src/database.c @ 428:3ecd8885ac67 r21-2-22

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