Mercurial > hg > xemacs-beta

comparison src/database.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Database access routines 1 /* Database access routines
2 Copyright (C) 1996, William M. Perry 2 Copyright (C) 1996, William M. Perry
3 Copyright (C) 2001 Ben Wing.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 XEmacs is free software; you can redistribute it and/or modify it 7 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 under the terms of the GNU General Public License as published by the
21 /* Synched up with: Not in FSF. */ 22 /* Synched up with: Not in FSF. */
22 23
23 /* Written by Bill Perry */ 24 /* Written by Bill Perry */
24 /* Substantially rewritten by Martin Buchholz */ 25 /* Substantially rewritten by Martin Buchholz */
25 /* db 2.x support added by Andreas Jaeger */ 26 /* db 2.x support added by Andreas Jaeger */
27 /* Mule-ized 6-22-00 Ben Wing */
26 28
27 #include <config.h> 29 #include <config.h>
28 #include "lisp.h" 30 #include "lisp.h"
31
29 #include "sysfile.h" 32 #include "sysfile.h"
30 #include "buffer.h" 33 #include "buffer.h"
31 34
32 #ifndef HAVE_DATABASE 35 #ifndef HAVE_DATABASE
33 #error HAVE_DATABASE not defined!! 36 #error HAVE_DATABASE not defined!!
66 #ifdef HAVE_DBM 69 #ifdef HAVE_DBM
67 #include <ndbm.h> 70 #include <ndbm.h>
68 Lisp_Object Qdbm; 71 Lisp_Object Qdbm;
69 #endif /* HAVE_DBM */ 72 #endif /* HAVE_DBM */
70 73
71 #ifdef MULE
72 /* #### The following should be settable on a per-database level.
73 But the whole coding-system infrastructure should be rewritten someday.
74 We really need coding-system aliases. -- martin */
75 Lisp_Object Vdatabase_coding_system; 74 Lisp_Object Vdatabase_coding_system;
76 #endif
77 75
78 Lisp_Object Qdatabasep; 76 Lisp_Object Qdatabasep;
79 77
80 typedef struct 78 typedef struct
81 { 79 {
102 #endif 100 #endif
103 #ifdef HAVE_BERKELEY_DB 101 #ifdef HAVE_BERKELEY_DB
104 DB *db_handle; 102 DB *db_handle;
105 #endif 103 #endif
106 DB_FUNCS *funcs; 104 DB_FUNCS *funcs;
107 #ifdef MULE
108 Lisp_Object coding_system; 105 Lisp_Object coding_system;
109 #endif
110 }; 106 };
111 107
112 #define XDATABASE(x) XRECORD (x, database, Lisp_Database) 108 #define XDATABASE(x) XRECORD (x, database, Lisp_Database)
113 #define XSETDATABASE(x, p) XSETRECORD (x, p, database) 109 #define XSETDATABASE(x, p) XSETRECORD (x, p, database)
114 #define wrap_database(p) wrap_record (p, database) 110 #define wrap_database(p) wrap_record (p, database)
138 db->dbm_handle = NULL; 134 db->dbm_handle = NULL;
139 #endif 135 #endif
140 db->access_ = 0; 136 db->access_ = 0;
141 db->mode = 0; 137 db->mode = 0;
142 db->dberrno = 0; 138 db->dberrno = 0;
143 #ifdef MULE 139 db->coding_system = Qnil;
144 db->coding_system = Fget_coding_system (Qbinary);
145 #endif
146 return db; 140 return db;
147 } 141 }
148 142
149 static Lisp_Object 143 static Lisp_Object
150 mark_database (Lisp_Object object) 144 mark_database (Lisp_Object object)
265 for (keydatum = dbm_firstkey (db->dbm_handle); 259 for (keydatum = dbm_firstkey (db->dbm_handle);
266 keydatum.dptr != NULL; 260 keydatum.dptr != NULL;
267 keydatum = dbm_nextkey (db->dbm_handle)) 261 keydatum = dbm_nextkey (db->dbm_handle))
268 { 262 {
269 valdatum = dbm_fetch (db->dbm_handle, keydatum); 263 valdatum = dbm_fetch (db->dbm_handle, keydatum);
270 key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize); 264 key = make_ext_string (keydatum.dptr, keydatum.dsize,
271 val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize); 265 db->coding_system);
266 val = make_ext_string (valdatum.dptr, valdatum.dsize,
267 db->coding_system);
272 call2 (func, key, val); 268 call2 (func, key, val);
273 } 269 }
274 } 270 }
275 271
276 static Lisp_Object 272 static Lisp_Object
277 dbm_get (Lisp_Database *db, Lisp_Object key) 273 dbm_get (Lisp_Database *db, Lisp_Object key)
278 { 274 {
279 datum keydatum, valdatum; 275 datum keydatum, valdatum;
280 276
281 keydatum.dptr = (char *) XSTRING_DATA (key); 277 TO_EXTERNAL_FORMAT (LISP_STRING, key,
282 keydatum.dsize = XSTRING_LENGTH (key); 278 ALLOCA, (keydatum.dptr, keydatum.dsize),
279 db->coding_system);
283 valdatum = dbm_fetch (db->dbm_handle, keydatum); 280 valdatum = dbm_fetch (db->dbm_handle, keydatum);
284 281
285 return (valdatum.dptr 282 return (valdatum.dptr
286 ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) 283 ? make_ext_string (valdatum.dptr, valdatum.dsize,
284 db->coding_system)
287 : Qnil); 285 : Qnil);
288 } 286 }
289 287
290 static int 288 static int
291 dbm_put (Lisp_Database *db, 289 dbm_put (Lisp_Database *db,
292 Lisp_Object key, Lisp_Object val, Lisp_Object replace) 290 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
293 { 291 {
294 datum keydatum, valdatum; 292 datum keydatum, valdatum;
295 293
296 valdatum.dptr = (char *) XSTRING_DATA (val); 294 TO_EXTERNAL_FORMAT (LISP_STRING, val,
297 valdatum.dsize = XSTRING_LENGTH (val); 295 ALLOCA, (valdatum.dptr, valdatum.dsize),
298 keydatum.dptr = (char *) XSTRING_DATA (key); 296 db->coding_system);
299 keydatum.dsize = XSTRING_LENGTH (key); 297 TO_EXTERNAL_FORMAT (LISP_STRING, key,
298 ALLOCA, (keydatum.dptr, keydatum.dsize),
299 db->coding_system);
300 300
301 return !dbm_store (db->dbm_handle, keydatum, valdatum, 301 return !dbm_store (db->dbm_handle, keydatum, valdatum,
302 NILP (replace) ? DBM_INSERT : DBM_REPLACE); 302 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
303 } 303 }
304 304
305 static int 305 static int
306 dbm_remove (Lisp_Database *db, Lisp_Object key) 306 dbm_remove (Lisp_Database *db, Lisp_Object key)
307 { 307 {
308 datum keydatum; 308 datum keydatum;
309 309
310 keydatum.dptr = (char *) XSTRING_DATA (key); 310 TO_EXTERNAL_FORMAT (LISP_STRING, key,
311 keydatum.dsize = XSTRING_LENGTH (key); 311 ALLOCA, (keydatum.dptr, keydatum.dsize),
312 db->coding_system);
312 313
313 return dbm_delete (db->dbm_handle, keydatum); 314 return dbm_delete (db->dbm_handle, keydatum);
314 } 315 }
315 316
316 static Lisp_Object 317 static Lisp_Object
393 394
394 /* DB Version 2 requires DBT's to be zeroed before use. */ 395 /* DB Version 2 requires DBT's to be zeroed before use. */
395 xzero (keydatum); 396 xzero (keydatum);
396 xzero (valdatum); 397 xzero (valdatum);
397 398
398 keydatum.data = XSTRING_DATA (key); 399 TO_EXTERNAL_FORMAT (LISP_STRING, key,
399 keydatum.size = XSTRING_LENGTH (key); 400 ALLOCA, (keydatum.data, keydatum.size),
401 db->coding_system);
400 402
401 #if DB_VERSION_MAJOR == 1 403 #if DB_VERSION_MAJOR == 1
402 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); 404 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
403 #else 405 #else
404 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); 406 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
405 #endif /* DB_VERSION_MAJOR */ 407 #endif /* DB_VERSION_MAJOR */
406 408
407 if (!status) 409 if (!status)
408 /* #### Not mule-ized! will crash! */ 410 return make_ext_string (valdatum.data, valdatum.size,
409 return make_string ((Intbyte *) valdatum.data, valdatum.size); 411 db->coding_system);
410 412
411 #if DB_VERSION_MAJOR == 1 413 #if DB_VERSION_MAJOR == 1
412 db->dberrno = (status == 1) ? -1 : errno; 414 db->dberrno = (status == 1) ? -1 : errno;
413 #else 415 #else
414 db->dberrno = (status < 0) ? -1 : errno; 416 db->dberrno = (status < 0) ? -1 : errno;
428 430
429 /* DB Version 2 requires DBT's to be zeroed before use. */ 431 /* DB Version 2 requires DBT's to be zeroed before use. */
430 xzero (keydatum); 432 xzero (keydatum);
431 xzero (valdatum); 433 xzero (valdatum);
432 434
433 keydatum.data = XSTRING_DATA (key); 435 TO_EXTERNAL_FORMAT (LISP_STRING, key,
434 keydatum.size = XSTRING_LENGTH (key); 436 ALLOCA, (keydatum.data, keydatum.size),
435 valdatum.data = XSTRING_DATA (val); 437 db->coding_system);
436 valdatum.size = XSTRING_LENGTH (val); 438 TO_EXTERNAL_FORMAT (LISP_STRING, val,
439 ALLOCA, (valdatum.data, valdatum.size),
440 db->coding_system);
437 #if DB_VERSION_MAJOR == 1 441 #if DB_VERSION_MAJOR == 1
438 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, 442 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
439 NILP (replace) ? R_NOOVERWRITE : 0); 443 NILP (replace) ? R_NOOVERWRITE : 0);
440 db->dberrno = (status == 1) ? -1 : errno; 444 db->dberrno = (status == 1) ? -1 : errno;
441 #else 445 #else
454 int status; 458 int status;
455 459
456 /* DB Version 2 requires DBT's to be zeroed before use. */ 460 /* DB Version 2 requires DBT's to be zeroed before use. */
457 xzero (keydatum); 461 xzero (keydatum);
458 462
459 keydatum.data = XSTRING_DATA (key); 463 TO_EXTERNAL_FORMAT (LISP_STRING, key,
460 keydatum.size = XSTRING_LENGTH (key); 464 ALLOCA, (keydatum.data, keydatum.size),
465 db->coding_system);
461 466
462 #if DB_VERSION_MAJOR == 1 467 #if DB_VERSION_MAJOR == 1
463 status = db->db_handle->del (db->db_handle, &keydatum, 0); 468 status = db->db_handle->del (db->db_handle, &keydatum, 0);
464 #else 469 #else
465 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0); 470 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
491 #if DB_VERSION_MAJOR == 1 496 #if DB_VERSION_MAJOR == 1
492 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); 497 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
493 status == 0; 498 status == 0;
494 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) 499 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
495 { 500 {
496 /* #### Needs mule-izing */ 501 key = make_ext_string (keydatum.data, keydatum.size,
497 key = make_string ((Intbyte *) keydatum.data, keydatum.size); 502 db->coding_system);
498 val = make_string ((Intbyte *) valdatum.data, valdatum.size); 503 val = make_ext_string (valdatum.data, valdatum.size,
504 db->coding_system);
499 call2 (func, key, val); 505 call2 (func, key, val);
500 } 506 }
501 #else 507 #else
502 { 508 {
503 DBC *dbcp; 509 DBC *dbcp;
509 #endif 515 #endif
510 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); 516 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
511 status == 0; 517 status == 0;
512 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) 518 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
513 { 519 {
514 /* #### Needs mule-izing */ 520 key = make_ext_string (keydatum.data, keydatum.size,
515 key = make_string ((Intbyte *) keydatum.data, keydatum.size); 521 db->coding_system);
516 val = make_string ((Intbyte *) valdatum.data, valdatum.size); 522 val = make_ext_string (valdatum.data, valdatum.size,
523 db->coding_system);
517 call2 (func, key, val); 524 call2 (func, key, val);
518 } 525 }
519 dbcp->c_close (dbcp); 526 dbcp->c_close (dbcp);
520 } 527 }
521 #endif /* DB_VERSION_MAJOR */ 528 #endif /* DB_VERSION_MAJOR */
561 CHECK_DATABASE (database); 568 CHECK_DATABASE (database);
562 569
563 return XDATABASE (database)->funcs->last_error (XDATABASE (database)); 570 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
564 } 571 }
565 572
566 DEFUN ("open-database", Fopen_database, 1, 5, 0, /* 573 DEFUN ("open-database", Fopen_database, 1, 6, 0, /*
567 Return a new database object opened on FILE. 574 Return a new database object opened on FILE.
568 Optional arguments TYPE and SUBTYPE specify the database type. 575 Optional arguments TYPE and SUBTYPE specify the database type.
569 Optional argument ACCESS specifies the access rights, which may be any 576 Optional argument ACCESS specifies the access rights, which may be any
570 combination of 'r' 'w' and '+', for read, write, and creation flags. 577 combination of 'r' 'w' and '+', for read, write, and creation flags.
571 Optional argument MODE gives the permissions to use when opening FILE, 578 Optional argument MODE gives the permissions to use when opening FILE,
572 and defaults to 0755. 579 and defaults to 0755.
573 */ 580 Optional argument CODESYS specifies the coding system used to encode/decode
574 (file, type, subtype, access_, mode)) 581 data passed to/from the database, and defaults to the value of the
582 variable `database-coding-system'.
583 */
584 (file, type, subtype, access_, mode, codesys))
575 { 585 {
576 /* This function can GC */ 586 /* This function can GC */
577 int modemask; 587 int modemask;
578 int accessmask = 0; 588 int accessmask = 0;
579 Lisp_Database *db = NULL; 589 Lisp_Database *db = NULL;
619 { 629 {
620 CHECK_INT (mode); 630 CHECK_INT (mode);
621 modemask = XINT (mode); 631 modemask = XINT (mode);
622 } 632 }
623 633
634 if (NILP (codesys))
635 codesys = Vdatabase_coding_system;
636
637 codesys = get_coding_system_for_text_file (Vdatabase_coding_system, 1);
638
624 #ifdef HAVE_DBM 639 #ifdef HAVE_DBM
625 if (NILP (type) || EQ (type, Qdbm)) 640 if (NILP (type) || EQ (type, Qdbm))
626 { 641 {
627 DBM *dbase = dbm_open (filename, accessmask, modemask); 642 DBM *dbase = dbm_open (filename, accessmask, modemask);
628 if (!dbase) 643 if (!dbase)
629 return Qnil; 644 return Qnil;
630 645
631 db = allocate_database (); 646 db = allocate_database ();
632 db->dbm_handle = dbase; 647 db->dbm_handle = dbase;
633 db->funcs = &ndbm_func_block; 648 db->funcs = &ndbm_func_block;
649 db->coding_system = codesys;
634 goto db_done; 650 goto db_done;
635 } 651 }
636 #endif /* HAVE_DBM */ 652 #endif /* HAVE_DBM */
637 653
638 #ifdef HAVE_BERKELEY_DB 654 #ifdef HAVE_BERKELEY_DB
701 #endif /* DB_VERSION_MAJOR */ 717 #endif /* DB_VERSION_MAJOR */
702 718
703 db = allocate_database (); 719 db = allocate_database ();
704 db->db_handle = dbase; 720 db->db_handle = dbase;
705 db->funcs = &berk_func_block; 721 db->funcs = &berk_func_block;
722 db->coding_system = codesys;
706 goto db_done; 723 goto db_done;
707 } 724 }
708 #endif /* HAVE_BERKELEY_DB */ 725 #endif /* HAVE_BERKELEY_DB */
709 726
710 invalid_constant ("Unsupported database type", type); 727 invalid_constant ("Unsupported database type", type);
824 #endif 841 #endif
825 #ifdef HAVE_BERKELEY_DB 842 #ifdef HAVE_BERKELEY_DB
826 Fprovide (Qberkeley_db); 843 Fprovide (Qberkeley_db);
827 #endif 844 #endif
828 845
829 #if 0 /* #### implement me! */
830 #ifdef MULE
831 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /* 846 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /*
832 Coding system used to convert data in database files. 847 Default coding system used to convert data in database files.
833 */ ); 848 */ );
834 Vdatabase_coding_system = Qnil; 849 Vdatabase_coding_system = Qnative;
835 #endif 850 }
836 #endif /* 0 */
837 }