Mercurial > hg > xemacs-beta
annotate src/database.c @ 4407:4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
2007-12-26 Aidan Kehoe <kehoea@parhasard.net>
* casetab.c:
Extend and correct some case table documentation.
* search.c (search_buffer):
Correct a bug where only the first entry for a character in the
case equivalence table was examined in determining if the
Boyer-Moore search algorithm is appropriate.
If there are case mappings outside of the charset and row of the
characters specified in the search string, those case mappings can
be safely ignored (and Boyer-Moore search can be used) if we know
from the buffer statistics that the corresponding characters cannot
occur.
* search.c (boyer_moore):
Assert that we haven't been passed a string with varying
characters sets or rows within character sets. That's what
simple_search is for.
In the very rare event that a character in the search string has a
canonical case mapping that is not in the same character set and
row, don't try to search for the canonical character, search for
some other character that is in the the desired character set and
row. Assert that the case table isn't corrupt.
Do not search for any character case mappings that cannot possibly
occur in the buffer, given the buffer metadata about its
contents.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Wed, 26 Dec 2007 17:30:16 +0100 |
parents | bc3b9f61018e |
children | 0e1461b592ce |
rev | line source |
---|---|
428 | 1 /* Database access routines |
2 Copyright (C) 1996, William M. Perry | |
3025 | 3 Copyright (C) 2001, 2002, 2005 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: Not in FSF. */ | |
23 | |
24 /* Written by Bill Perry */ | |
25 /* Substantially rewritten by Martin Buchholz */ | |
26 /* db 2.x support added by Andreas Jaeger */ | |
771 | 27 /* Mule-ized 6-22-00 Ben Wing */ |
428 | 28 |
29 #include <config.h> | |
30 #include "lisp.h" | |
771 | 31 |
428 | 32 #include "sysfile.h" |
33 #include "buffer.h" | |
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
34 #include "file-coding.h" |
428 | 35 |
36 #ifndef HAVE_DATABASE | |
37 #error HAVE_DATABASE not defined!! | |
38 #endif | |
39 | |
40 #include "database.h" /* Our include file */ | |
41 | |
42 #ifdef HAVE_BERKELEY_DB | |
43 /* Work around Berkeley DB's use of int types which are defined | |
44 slightly differently in the not quite yet standard <inttypes.h>. | |
45 See db.h for details of why we're resorting to this... */ | |
46 /* glibc 2.1 doesn't have this problem with DB 2.x */ | |
47 #if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) | |
48 #ifdef HAVE_INTTYPES_H | |
3739 | 49 #ifndef __BIT_TYPES_DEFINED__ |
428 | 50 #define __BIT_TYPES_DEFINED__ |
3739 | 51 #endif |
428 | 52 #include <inttypes.h> |
3739 | 53 #if !HAVE_U_INT8_T |
428 | 54 typedef uint8_t u_int8_t; |
3739 | 55 #endif |
56 #if !HAVE_U_INT16_T | |
428 | 57 typedef uint16_t u_int16_t; |
3739 | 58 #endif |
59 #if !HAVE_U_INT32_T | |
428 | 60 typedef uint32_t u_int32_t; |
3739 | 61 #endif |
428 | 62 #ifdef WE_DONT_NEED_QUADS |
3739 | 63 #if !HAVE_U_INT64_T |
428 | 64 typedef uint64_t u_int64_t; |
3739 | 65 #endif |
428 | 66 #endif /* WE_DONT_NEED_QUADS */ |
67 #endif /* HAVE_INTTYPES_H */ | |
68 #endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */ | |
1460 | 69 /* Berkeley DB wants __STDC__ to be defined; else if does `#define const' */ |
70 #if ! defined (__STDC__) && ! defined(__cplusplus) | |
71 #define __STDC__ 0 | |
72 #endif | |
442 | 73 #include DB_H_FILE /* Berkeley db's header file */ |
428 | 74 #ifndef DB_VERSION_MAJOR |
75 # define DB_VERSION_MAJOR 1 | |
76 #endif /* DB_VERSION_MAJOR */ | |
1141 | 77 #ifndef DB_VERSION_MINOR |
78 # define DB_VERSION_MINOR 0 | |
79 #endif /* DB_VERSION_MINOR */ | |
428 | 80 Lisp_Object Qberkeley_db; |
81 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown; | |
448 | 82 #if DB_VERSION_MAJOR > 2 |
83 Lisp_Object Qqueue; | |
84 #endif | |
428 | 85 #endif /* HAVE_BERKELEY_DB */ |
86 | |
87 #ifdef HAVE_DBM | |
88 #include <ndbm.h> | |
89 Lisp_Object Qdbm; | |
90 #endif /* HAVE_DBM */ | |
91 | |
92 Lisp_Object Vdatabase_coding_system; | |
93 | |
94 Lisp_Object Qdatabasep; | |
95 | |
96 typedef struct | |
97 { | |
98 Lisp_Object (*get_subtype) (Lisp_Database *); | |
99 Lisp_Object (*get_type) (Lisp_Database *); | |
100 Lisp_Object (*get) (Lisp_Database *, Lisp_Object); | |
101 int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); | |
102 int (*rem) (Lisp_Database *, Lisp_Object); | |
103 void (*map) (Lisp_Database *, Lisp_Object); | |
104 void (*close) (Lisp_Database *); | |
105 Lisp_Object (*last_error) (Lisp_Database *); | |
106 } DB_FUNCS; | |
107 | |
108 struct Lisp_Database | |
109 { | |
3017 | 110 struct LCRECORD_HEADER header; |
428 | 111 Lisp_Object fname; |
112 int mode; | |
113 int access_; | |
114 int dberrno; | |
115 int live_p; | |
116 #ifdef HAVE_DBM | |
117 DBM *dbm_handle; | |
118 #endif | |
119 #ifdef HAVE_BERKELEY_DB | |
120 DB *db_handle; | |
121 #endif | |
122 DB_FUNCS *funcs; | |
123 Lisp_Object coding_system; | |
124 }; | |
125 | |
126 #define XDATABASE(x) XRECORD (x, database, Lisp_Database) | |
617 | 127 #define wrap_database(p) wrap_record (p, database) |
428 | 128 #define DATABASEP(x) RECORDP (x, database) |
129 #define CHECK_DATABASE(x) CHECK_RECORD (x, database) | |
130 #define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) | |
131 #define DATABASE_LIVE_P(x) (x->live_p) | |
132 | |
133 #define CHECK_LIVE_DATABASE(db) do { \ | |
134 CHECK_DATABASE (db); \ | |
135 if (!DATABASE_LIVE_P (XDATABASE(db))) \ | |
563 | 136 invalid_operation ("Attempting to access closed database", db); \ |
428 | 137 } while (0) |
138 | |
139 | |
140 static Lisp_Database * | |
141 allocate_database (void) | |
142 { | |
3017 | 143 Lisp_Database *db = ALLOC_LCRECORD_TYPE (Lisp_Database, &lrecord_database); |
428 | 144 |
145 db->fname = Qnil; | |
146 db->live_p = 0; | |
147 #ifdef HAVE_BERKELEY_DB | |
148 db->db_handle = NULL; | |
149 #endif | |
150 #ifdef HAVE_DBM | |
151 db->dbm_handle = NULL; | |
152 #endif | |
153 db->access_ = 0; | |
154 db->mode = 0; | |
155 db->dberrno = 0; | |
771 | 156 db->coding_system = Qnil; |
428 | 157 return db; |
158 } | |
159 | |
1204 | 160 static const struct memory_description database_description[] = { |
934 | 161 { XD_LISP_OBJECT, offsetof (struct Lisp_Database, fname) }, |
162 { XD_END} | |
163 }; | |
164 | |
428 | 165 static Lisp_Object |
444 | 166 mark_database (Lisp_Object object) |
428 | 167 { |
444 | 168 Lisp_Database *db = XDATABASE (object); |
428 | 169 return db->fname; |
170 } | |
171 | |
172 static void | |
2286 | 173 print_database (Lisp_Object obj, Lisp_Object printcharfun, |
174 int UNUSED (escapeflag)) | |
428 | 175 { |
176 Lisp_Database *db = XDATABASE (obj); | |
177 | |
178 if (print_readably) | |
563 | 179 printing_unreadable_object ("#<database 0x%x>", db->header.uid); |
428 | 180 |
793 | 181 write_fmt_string_lisp (printcharfun, "#<database \"%s\" (%s/%s/", |
182 3, db->fname, db->funcs->get_type (db), | |
183 db->funcs->get_subtype (db)); | |
184 | |
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
185 write_fmt_string (printcharfun, "%s) ", |
793 | 186 (!DATABASE_LIVE_P (db) ? "closed" : |
187 (db->access_ & O_WRONLY) ? "writeonly" : | |
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
188 (db->access_ & O_RDWR) ? "readwrite" : "readonly")); |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
189 |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
190 write_fmt_string_lisp (printcharfun, "coding: %s ", 1, |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
191 XSYMBOL_NAME (XCODING_SYSTEM_NAME |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
192 (db->coding_system))); |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
193 |
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
194 write_fmt_string (printcharfun, "0x%x>", db->header.uid); |
428 | 195 } |
196 | |
197 static void | |
198 finalize_database (void *header, int for_disksave) | |
199 { | |
200 Lisp_Database *db = (Lisp_Database *) header; | |
201 | |
202 if (for_disksave) | |
203 { | |
563 | 204 invalid_operation |
793 | 205 ("Can't dump an emacs containing database objects", |
206 wrap_database (db)); | |
428 | 207 } |
208 db->funcs->close (db); | |
209 } | |
210 | |
934 | 211 DEFINE_LRECORD_IMPLEMENTATION ("database", database, |
212 0, /*dumpable-flag*/ | |
213 mark_database, print_database, | |
214 finalize_database, 0, 0, | |
215 database_description, | |
216 Lisp_Database); | |
428 | 217 |
218 DEFUN ("close-database", Fclose_database, 1, 1, 0, /* | |
219 Close database DATABASE. | |
220 */ | |
221 (database)) | |
222 { | |
223 Lisp_Database *db; | |
224 CHECK_LIVE_DATABASE (database); | |
225 db = XDATABASE (database); | |
226 db->funcs->close (db); | |
227 db->live_p = 0; | |
228 return Qnil; | |
229 } | |
230 | |
231 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* | |
232 Return the type of database DATABASE. | |
233 */ | |
234 (database)) | |
235 { | |
236 CHECK_DATABASE (database); | |
237 | |
238 return XDATABASE (database)->funcs->get_type (XDATABASE (database)); | |
239 } | |
240 | |
241 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* | |
242 Return the subtype of database DATABASE, if any. | |
243 */ | |
244 (database)) | |
245 { | |
246 CHECK_DATABASE (database); | |
247 | |
248 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database)); | |
249 } | |
250 | |
251 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* | |
444 | 252 Return t if OBJECT is an active database. |
428 | 253 */ |
444 | 254 (object)) |
428 | 255 { |
444 | 256 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ? |
257 Qt : Qnil; | |
428 | 258 } |
259 | |
260 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* | |
261 Return the filename associated with the database DATABASE. | |
262 */ | |
263 (database)) | |
264 { | |
265 CHECK_DATABASE (database); | |
266 | |
267 return XDATABASE (database)->fname; | |
268 } | |
269 | |
270 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* | |
444 | 271 Return t if OBJECT is a database. |
428 | 272 */ |
444 | 273 (object)) |
428 | 274 { |
444 | 275 return DATABASEP (object) ? Qt : Qnil; |
428 | 276 } |
277 | |
278 #ifdef HAVE_DBM | |
279 static void | |
280 dbm_map (Lisp_Database *db, Lisp_Object func) | |
281 { | |
282 datum keydatum, valdatum; | |
283 Lisp_Object key, val; | |
284 | |
285 for (keydatum = dbm_firstkey (db->dbm_handle); | |
286 keydatum.dptr != NULL; | |
287 keydatum = dbm_nextkey (db->dbm_handle)) | |
288 { | |
289 valdatum = dbm_fetch (db->dbm_handle, keydatum); | |
4124 | 290 key = make_ext_string ((Extbyte *) keydatum.dptr, keydatum.dsize, |
771 | 291 db->coding_system); |
4124 | 292 val = make_ext_string ((Extbyte *) valdatum.dptr, valdatum.dsize, |
771 | 293 db->coding_system); |
428 | 294 call2 (func, key, val); |
295 } | |
296 } | |
297 | |
298 static Lisp_Object | |
299 dbm_get (Lisp_Database *db, Lisp_Object key) | |
300 { | |
301 datum keydatum, valdatum; | |
302 | |
771 | 303 TO_EXTERNAL_FORMAT (LISP_STRING, key, |
304 ALLOCA, (keydatum.dptr, keydatum.dsize), | |
305 db->coding_system); | |
428 | 306 valdatum = dbm_fetch (db->dbm_handle, keydatum); |
307 | |
308 return (valdatum.dptr | |
4124 | 309 ? make_ext_string ((Extbyte *) valdatum.dptr, valdatum.dsize, |
771 | 310 db->coding_system) |
428 | 311 : Qnil); |
312 } | |
313 | |
314 static int | |
315 dbm_put (Lisp_Database *db, | |
316 Lisp_Object key, Lisp_Object val, Lisp_Object replace) | |
317 { | |
318 datum keydatum, valdatum; | |
319 | |
771 | 320 TO_EXTERNAL_FORMAT (LISP_STRING, val, |
321 ALLOCA, (valdatum.dptr, valdatum.dsize), | |
322 db->coding_system); | |
323 TO_EXTERNAL_FORMAT (LISP_STRING, key, | |
324 ALLOCA, (keydatum.dptr, keydatum.dsize), | |
325 db->coding_system); | |
428 | 326 |
327 return !dbm_store (db->dbm_handle, keydatum, valdatum, | |
328 NILP (replace) ? DBM_INSERT : DBM_REPLACE); | |
329 } | |
330 | |
331 static int | |
332 dbm_remove (Lisp_Database *db, Lisp_Object key) | |
333 { | |
334 datum keydatum; | |
335 | |
771 | 336 TO_EXTERNAL_FORMAT (LISP_STRING, key, |
337 ALLOCA, (keydatum.dptr, keydatum.dsize), | |
338 db->coding_system); | |
428 | 339 |
340 return dbm_delete (db->dbm_handle, keydatum); | |
341 } | |
342 | |
343 static Lisp_Object | |
2494 | 344 dbm_type (Lisp_Database *UNUSED (db)) |
428 | 345 { |
346 return Qdbm; | |
347 } | |
348 | |
349 static Lisp_Object | |
2494 | 350 dbm_subtype (Lisp_Database *UNUSED (db)) |
428 | 351 { |
352 return Qnil; | |
353 } | |
354 | |
355 static Lisp_Object | |
356 dbm_lasterr (Lisp_Database *db) | |
357 { | |
358 return lisp_strerror (db->dberrno); | |
359 } | |
360 | |
361 static void | |
362 dbm_closeit (Lisp_Database *db) | |
363 { | |
364 if (db->dbm_handle) | |
365 { | |
366 dbm_close (db->dbm_handle); | |
367 db->dbm_handle = NULL; | |
368 } | |
369 } | |
370 | |
371 static DB_FUNCS ndbm_func_block = | |
372 { | |
373 dbm_subtype, | |
374 dbm_type, | |
375 dbm_get, | |
376 dbm_put, | |
377 dbm_remove, | |
378 dbm_map, | |
379 dbm_closeit, | |
380 dbm_lasterr | |
381 }; | |
382 #endif /* HAVE_DBM */ | |
383 | |
384 #ifdef HAVE_BERKELEY_DB | |
385 static Lisp_Object | |
2286 | 386 berkdb_type (Lisp_Database *UNUSED (db)) |
428 | 387 { |
388 return Qberkeley_db; | |
389 } | |
390 | |
391 static Lisp_Object | |
392 berkdb_subtype (Lisp_Database *db) | |
393 { | |
394 if (!db->db_handle) | |
395 return Qnil; | |
396 | |
397 switch (db->db_handle->type) | |
398 { | |
399 case DB_BTREE: return Qbtree; | |
400 case DB_HASH: return Qhash; | |
401 case DB_RECNO: return Qrecno; | |
448 | 402 #if DB_VERSION_MAJOR > 2 |
403 case DB_QUEUE: return Qqueue; | |
404 #endif | |
428 | 405 default: return Qunknown; |
406 } | |
407 } | |
408 | |
409 static Lisp_Object | |
410 berkdb_lasterr (Lisp_Database *db) | |
411 { | |
412 return lisp_strerror (db->dberrno); | |
413 } | |
414 | |
415 static Lisp_Object | |
416 berkdb_get (Lisp_Database *db, Lisp_Object key) | |
417 { | |
418 DBT keydatum, valdatum; | |
419 int status = 0; | |
420 | |
421 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
422 xzero (keydatum); | |
423 xzero (valdatum); | |
424 | |
771 | 425 TO_EXTERNAL_FORMAT (LISP_STRING, key, |
426 ALLOCA, (keydatum.data, keydatum.size), | |
427 db->coding_system); | |
428 | 428 |
429 #if DB_VERSION_MAJOR == 1 | |
430 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); | |
431 #else | |
432 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); | |
433 #endif /* DB_VERSION_MAJOR */ | |
434 | |
435 if (!status) | |
1645 | 436 return make_ext_string ((const Extbyte *) valdatum.data, valdatum.size, |
771 | 437 db->coding_system); |
428 | 438 |
439 #if DB_VERSION_MAJOR == 1 | |
440 db->dberrno = (status == 1) ? -1 : errno; | |
441 #else | |
442 db->dberrno = (status < 0) ? -1 : errno; | |
443 #endif /* DB_VERSION_MAJOR */ | |
444 | |
445 return Qnil; | |
446 } | |
447 | |
448 static int | |
449 berkdb_put (Lisp_Database *db, | |
450 Lisp_Object key, | |
451 Lisp_Object val, | |
452 Lisp_Object replace) | |
453 { | |
454 DBT keydatum, valdatum; | |
455 int status = 0; | |
456 | |
457 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
458 xzero (keydatum); | |
459 xzero (valdatum); | |
460 | |
771 | 461 TO_EXTERNAL_FORMAT (LISP_STRING, key, |
462 ALLOCA, (keydatum.data, keydatum.size), | |
463 db->coding_system); | |
464 TO_EXTERNAL_FORMAT (LISP_STRING, val, | |
465 ALLOCA, (valdatum.data, valdatum.size), | |
466 db->coding_system); | |
428 | 467 #if DB_VERSION_MAJOR == 1 |
468 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, | |
469 NILP (replace) ? R_NOOVERWRITE : 0); | |
470 db->dberrno = (status == 1) ? -1 : errno; | |
471 #else | |
472 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum, | |
473 NILP (replace) ? DB_NOOVERWRITE : 0); | |
474 db->dberrno = (status < 0) ? -1 : errno; | |
475 #endif/* DV_VERSION_MAJOR = 2 */ | |
476 | |
477 return status; | |
478 } | |
479 | |
480 static int | |
481 berkdb_remove (Lisp_Database *db, Lisp_Object key) | |
482 { | |
483 DBT keydatum; | |
484 int status; | |
485 | |
486 /* DB Version 2 requires DBT's to be zeroed before use. */ | |
487 xzero (keydatum); | |
488 | |
771 | 489 TO_EXTERNAL_FORMAT (LISP_STRING, key, |
490 ALLOCA, (keydatum.data, keydatum.size), | |
491 db->coding_system); | |
428 | 492 |
493 #if DB_VERSION_MAJOR == 1 | |
494 status = db->db_handle->del (db->db_handle, &keydatum, 0); | |
495 #else | |
496 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0); | |
497 #endif /* DB_VERSION_MAJOR */ | |
498 | |
499 if (!status) | |
500 return 0; | |
501 | |
502 #if DB_VERSION_MAJOR == 1 | |
503 db->dberrno = (status == 1) ? -1 : errno; | |
504 #else | |
505 db->dberrno = (status < 0) ? -1 : errno; | |
506 #endif /* DB_VERSION_MAJOR */ | |
507 | |
508 return 1; | |
509 } | |
510 | |
511 static void | |
512 berkdb_map (Lisp_Database *db, Lisp_Object func) | |
513 { | |
514 DBT keydatum, valdatum; | |
515 Lisp_Object key, val; | |
516 DB *dbp = db->db_handle; | |
517 int status; | |
518 | |
519 xzero (keydatum); | |
520 xzero (valdatum); | |
521 | |
522 #if DB_VERSION_MAJOR == 1 | |
523 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); | |
524 status == 0; | |
525 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) | |
526 { | |
2646 | 527 key = make_ext_string ((const Extbyte *) keydatum.data, keydatum.size, |
771 | 528 db->coding_system); |
2646 | 529 val = make_ext_string ((const Extbyte *) valdatum.data, valdatum.size, |
771 | 530 db->coding_system); |
428 | 531 call2 (func, key, val); |
532 } | |
533 #else | |
534 { | |
535 DBC *dbcp; | |
536 | |
537 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6 | |
538 status = dbp->cursor (dbp, NULL, &dbcp, 0); | |
539 #else | |
540 status = dbp->cursor (dbp, NULL, &dbcp); | |
440 | 541 #endif |
428 | 542 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); |
543 status == 0; | |
544 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) | |
545 { | |
1645 | 546 key = make_ext_string ((const Extbyte *) keydatum.data, keydatum.size, |
771 | 547 db->coding_system); |
1645 | 548 val = make_ext_string ((const Extbyte *) valdatum.data, valdatum.size, |
771 | 549 db->coding_system); |
428 | 550 call2 (func, key, val); |
551 } | |
552 dbcp->c_close (dbcp); | |
553 } | |
554 #endif /* DB_VERSION_MAJOR */ | |
555 } | |
556 | |
557 static void | |
558 berkdb_close (Lisp_Database *db) | |
559 { | |
560 if (db->db_handle) | |
561 { | |
562 #if DB_VERSION_MAJOR == 1 | |
563 db->db_handle->sync (db->db_handle, 0); | |
564 db->db_handle->close (db->db_handle); | |
565 #else | |
566 db->db_handle->sync (db->db_handle, 0); | |
567 db->db_handle->close (db->db_handle, 0); | |
568 #endif /* DB_VERSION_MAJOR */ | |
569 db->db_handle = NULL; | |
570 } | |
571 } | |
572 | |
573 static DB_FUNCS berk_func_block = | |
574 { | |
575 berkdb_subtype, | |
576 berkdb_type, | |
577 berkdb_get, | |
578 berkdb_put, | |
579 berkdb_remove, | |
580 berkdb_map, | |
581 berkdb_close, | |
582 berkdb_lasterr | |
583 }; | |
584 #endif /* HAVE_BERKELEY_DB */ | |
585 | |
586 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /* | |
587 Return the last error associated with DATABASE. | |
588 */ | |
589 (database)) | |
590 { | |
591 if (NILP (database)) | |
592 return lisp_strerror (errno); | |
593 | |
594 CHECK_DATABASE (database); | |
595 | |
596 return XDATABASE (database)->funcs->last_error (XDATABASE (database)); | |
597 } | |
598 | |
771 | 599 DEFUN ("open-database", Fopen_database, 1, 6, 0, /* |
428 | 600 Return a new database object opened on FILE. |
601 Optional arguments TYPE and SUBTYPE specify the database type. | |
602 Optional argument ACCESS specifies the access rights, which may be any | |
603 combination of 'r' 'w' and '+', for read, write, and creation flags. | |
604 Optional argument MODE gives the permissions to use when opening FILE, | |
605 and defaults to 0755. | |
771 | 606 Optional argument CODESYS specifies the coding system used to encode/decode |
607 data passed to/from the database, and defaults to the value of the | |
608 variable `database-coding-system'. | |
428 | 609 */ |
771 | 610 (file, type, subtype, access_, mode, codesys)) |
428 | 611 { |
612 /* This function can GC */ | |
613 int modemask; | |
614 int accessmask = 0; | |
615 Lisp_Database *db = NULL; | |
616 char *filename; | |
617 struct gcpro gcpro1, gcpro2; | |
618 | |
619 CHECK_STRING (file); | |
620 GCPRO2 (file, access_); | |
621 file = Fexpand_file_name (file, Qnil); | |
622 UNGCPRO; | |
623 | |
440 | 624 TO_EXTERNAL_FORMAT (LISP_STRING, file, |
625 C_STRING_ALLOCA, filename, | |
626 Qfile_name); | |
428 | 627 |
628 if (NILP (access_)) | |
629 { | |
630 accessmask = O_RDWR | O_CREAT; | |
631 } | |
632 else | |
633 { | |
634 char *acc; | |
635 CHECK_STRING (access_); | |
636 acc = (char *) XSTRING_DATA (access_); | |
637 | |
638 if (strchr (acc, '+')) | |
639 accessmask |= O_CREAT; | |
640 | |
641 { | |
642 char *rp = strchr (acc, 'r'); | |
643 char *wp = strchr (acc, 'w'); | |
644 if (rp && wp) accessmask |= O_RDWR; | |
645 else if (wp) accessmask |= O_WRONLY; | |
646 else accessmask |= O_RDONLY; | |
647 } | |
648 } | |
649 | |
650 if (NILP (mode)) | |
651 { | |
652 modemask = 0755; /* rwxr-xr-x */ | |
653 } | |
654 else | |
655 { | |
656 CHECK_INT (mode); | |
657 modemask = XINT (mode); | |
658 } | |
659 | |
771 | 660 if (NILP (codesys)) |
661 codesys = Vdatabase_coding_system; | |
662 | |
4351
bc3b9f61018e
Respect the CODESYS argument in #'open-database; don't autodetect EOL.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4124
diff
changeset
|
663 codesys = get_coding_system_for_text_file (codesys, 0); |
771 | 664 |
428 | 665 #ifdef HAVE_DBM |
666 if (NILP (type) || EQ (type, Qdbm)) | |
667 { | |
668 DBM *dbase = dbm_open (filename, accessmask, modemask); | |
669 if (!dbase) | |
670 return Qnil; | |
671 | |
672 db = allocate_database (); | |
673 db->dbm_handle = dbase; | |
674 db->funcs = &ndbm_func_block; | |
771 | 675 db->coding_system = codesys; |
428 | 676 goto db_done; |
677 } | |
678 #endif /* HAVE_DBM */ | |
679 | |
680 #ifdef HAVE_BERKELEY_DB | |
681 if (NILP (type) || EQ (type, Qberkeley_db)) | |
682 { | |
683 DBTYPE real_subtype; | |
684 DB *dbase; | |
685 #if DB_VERSION_MAJOR != 1 | |
686 int status; | |
687 #endif | |
688 | |
689 if (EQ (subtype, Qhash) || NILP (subtype)) | |
690 real_subtype = DB_HASH; | |
691 else if (EQ (subtype, Qbtree)) | |
692 real_subtype = DB_BTREE; | |
693 else if (EQ (subtype, Qrecno)) | |
694 real_subtype = DB_RECNO; | |
448 | 695 #if DB_VERSION_MAJOR > 2 |
696 else if (EQ (subtype, Qqueue)) | |
697 real_subtype = DB_QUEUE; | |
698 #endif | |
428 | 699 else |
563 | 700 invalid_constant ("Unsupported subtype", subtype); |
428 | 701 |
702 #if DB_VERSION_MAJOR == 1 | |
703 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL); | |
704 if (!dbase) | |
705 return Qnil; | |
706 #else | |
707 /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY, | |
708 other flags shouldn't be set */ | |
709 if (NILP (access_)) | |
710 accessmask = DB_CREATE; | |
711 else | |
712 { | |
713 char *acc; | |
714 CHECK_STRING (access_); | |
715 acc = (char *) XSTRING_DATA (access_); | |
716 accessmask = 0; | |
717 | |
718 if (strchr (acc, '+')) | |
719 accessmask |= DB_CREATE; | |
720 | |
721 if (strchr (acc, 'r') && !strchr (acc, 'w')) | |
722 accessmask |= DB_RDONLY; | |
723 } | |
448 | 724 #if DB_VERSION_MAJOR == 2 |
428 | 725 status = db_open (filename, real_subtype, accessmask, |
726 modemask, NULL , NULL, &dbase); | |
727 if (status) | |
728 return Qnil; | |
448 | 729 #else |
730 status = db_create (&dbase, NULL, 0); | |
731 if (status) | |
732 return Qnil; | |
1141 | 733 #if DB_VERSION_MAJOR < 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR < 1) |
448 | 734 status = dbase->open (dbase, filename, NULL, |
735 real_subtype, accessmask, modemask); | |
1141 | 736 #else /* DB_VERSION >= 4.1 */ |
1377 | 737 /* You can't use DB_AUTO_COMMIT unless you have a txn environment. */ |
1141 | 738 status = dbase->open (dbase, NULL, filename, NULL, real_subtype, |
1377 | 739 accessmask, modemask); |
1141 | 740 #endif /* DB_VERSION < 4.1 */ |
448 | 741 if (status) |
742 { | |
743 dbase->close (dbase, 0); | |
744 return Qnil; | |
745 } | |
746 #endif /* DB_VERSION_MAJOR > 2 */ | |
747 /* Normalize into system specific file modes. Only for printing */ | |
748 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR; | |
428 | 749 #endif /* DB_VERSION_MAJOR */ |
750 | |
751 db = allocate_database (); | |
752 db->db_handle = dbase; | |
753 db->funcs = &berk_func_block; | |
771 | 754 db->coding_system = codesys; |
428 | 755 goto db_done; |
756 } | |
757 #endif /* HAVE_BERKELEY_DB */ | |
758 | |
563 | 759 invalid_constant ("Unsupported database type", type); |
428 | 760 return Qnil; |
761 | |
762 db_done: | |
763 db->live_p = 1; | |
764 db->fname = file; | |
765 db->mode = modemask; | |
766 db->access_ = accessmask; | |
767 | |
793 | 768 return wrap_database (db); |
428 | 769 } |
770 | |
771 DEFUN ("put-database", Fput_database, 3, 4, 0, /* | |
772 Store KEY and VALUE in DATABASE. | |
773 If optional fourth arg REPLACE is non-nil, | |
774 replace any existing entry in the database. | |
775 */ | |
776 (key, value, database, replace)) | |
777 { | |
778 CHECK_LIVE_DATABASE (database); | |
779 CHECK_STRING (key); | |
780 CHECK_STRING (value); | |
781 { | |
782 Lisp_Database *db = XDATABASE (database); | |
783 int status = db->funcs->put (db, key, value, replace); | |
784 return status ? Qt : Qnil; | |
785 } | |
786 } | |
787 | |
788 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /* | |
789 Remove KEY from DATABASE. | |
790 */ | |
791 (key, database)) | |
792 { | |
793 CHECK_LIVE_DATABASE (database); | |
794 CHECK_STRING (key); | |
795 { | |
796 Lisp_Database *db = XDATABASE (database); | |
797 int status = db->funcs->rem (db, key); | |
798 return status ? Qt : Qnil; | |
799 } | |
800 } | |
801 | |
802 DEFUN ("get-database", Fget_database, 2, 3, 0, /* | |
803 Return value for KEY in DATABASE. | |
804 If there is no corresponding value, return DEFAULT (defaults to nil). | |
805 */ | |
806 (key, database, default_)) | |
807 { | |
808 CHECK_LIVE_DATABASE (database); | |
809 CHECK_STRING (key); | |
810 { | |
811 Lisp_Database *db = XDATABASE (database); | |
812 Lisp_Object retval = db->funcs->get (db, key); | |
813 return NILP (retval) ? default_ : retval; | |
814 } | |
815 } | |
816 | |
817 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* | |
818 Map FUNCTION over entries in DATABASE, calling it with two args, | |
819 each key and value in the database. | |
820 */ | |
821 (function, database)) | |
822 { | |
823 CHECK_LIVE_DATABASE (database); | |
824 | |
825 XDATABASE (database)->funcs->map (XDATABASE (database), function); | |
826 | |
827 return Qnil; | |
828 } | |
829 | |
830 void | |
831 syms_of_database (void) | |
832 { | |
442 | 833 INIT_LRECORD_IMPLEMENTATION (database); |
834 | |
563 | 835 DEFSYMBOL (Qdatabasep); |
428 | 836 #ifdef HAVE_DBM |
563 | 837 DEFSYMBOL (Qdbm); |
428 | 838 #endif |
839 #ifdef HAVE_BERKELEY_DB | |
563 | 840 DEFSYMBOL (Qberkeley_db); |
841 DEFSYMBOL (Qhash); | |
842 DEFSYMBOL (Qbtree); | |
843 DEFSYMBOL (Qrecno); | |
448 | 844 #if DB_VERSION_MAJOR > 2 |
563 | 845 DEFSYMBOL (Qqueue); |
448 | 846 #endif |
563 | 847 DEFSYMBOL (Qunknown); |
428 | 848 #endif |
849 | |
850 DEFSUBR (Fopen_database); | |
851 DEFSUBR (Fdatabasep); | |
852 DEFSUBR (Fmapdatabase); | |
853 DEFSUBR (Fput_database); | |
854 DEFSUBR (Fget_database); | |
855 DEFSUBR (Fremove_database); | |
856 DEFSUBR (Fdatabase_type); | |
857 DEFSUBR (Fdatabase_subtype); | |
858 DEFSUBR (Fdatabase_last_error); | |
859 DEFSUBR (Fdatabase_live_p); | |
860 DEFSUBR (Fdatabase_file_name); | |
861 DEFSUBR (Fclose_database); | |
862 } | |
863 | |
864 void | |
865 vars_of_database (void) | |
866 { | |
867 #ifdef HAVE_DBM | |
868 Fprovide (Qdbm); | |
869 #endif | |
870 #ifdef HAVE_BERKELEY_DB | |
871 Fprovide (Qberkeley_db); | |
872 #endif | |
873 | |
874 DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /* | |
771 | 875 Default coding system used to convert data in database files. |
428 | 876 */ ); |
771 | 877 Vdatabase_coding_system = Qnative; |
428 | 878 } |