annotate src/database.c @ 3063:d30cd499e445

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