annotate src/database.c @ 1645:080d479edd32

[xemacs-hg @ 2003-08-26 14:03:57 by james] Nickolay Pakoulin's patch to make g++ compile database.c without error.
author james
date Tue, 26 Aug 2003 14:04:00 +0000
parents df0effd42264
children 04bc9d2f42c7
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
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 2001, 2002 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>
1453
908cd1ff6104 [xemacs-hg @ 2003-05-04 00:02:45 by youngs]
youngs
parents: 1377
diff changeset
50 #ifndef __FreeBSD__
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 struct lcrecord_header header;
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, &lrecord_database);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 Lisp_Database *db = XDATABASE (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
169 printing_unreadable_object ("#<database 0x%x>", db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
171 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
172 3, db->fname, db->funcs->get_type (db),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
173 db->funcs->get_subtype (db));
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
174
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
175 write_fmt_string (printcharfun, "%s) 0x%x>",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
176 (!DATABASE_LIVE_P (db) ? "closed" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
177 (db->access_ & O_WRONLY) ? "writeonly" :
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
178 (db->access_ & O_RDWR) ? "readwrite" : "readonly"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
179 db->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 finalize_database (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Lisp_Database *db = (Lisp_Database *) header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 if (for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
189 invalid_operation
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
190 ("Can't dump an emacs containing database objects",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
191 wrap_database (db));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
196 DEFINE_LRECORD_IMPLEMENTATION ("database", database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
197 0, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
198 mark_database, print_database,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
199 finalize_database, 0, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
200 database_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 793
diff changeset
201 Lisp_Database);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 DEFUN ("close-database", Fclose_database, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 Close database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Lisp_Database *db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 db->funcs->close (db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 db->live_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 }
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 DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Return the type of database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return XDATABASE (database)->funcs->get_type (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
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 DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Return the subtype of database DATABASE, if any.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 return XDATABASE (database)->funcs->get_subtype (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 }
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 DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
237 Return t if OBJECT is an active database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
239 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
241 return DATABASEP (object) && DATABASE_LIVE_P (XDATABASE (object)) ?
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
242 Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
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 DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 Return the filename associated with the database DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 return XDATABASE (database)->fname;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 }
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 DEFUN ("databasep", Fdatabasep, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
256 Return t if OBJECT is a database.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
258 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
260 return DATABASEP (object) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
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 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 dbm_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 for (keydatum = dbm_firstkey (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 keydatum.dptr != NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 keydatum = dbm_nextkey (db->dbm_handle))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 valdatum = dbm_fetch (db->dbm_handle, keydatum);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
275 key = make_ext_string (keydatum.dptr, keydatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
276 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
277 val = make_ext_string (valdatum.dptr, valdatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
278 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 dbm_get (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
288 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
289 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
290 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 valdatum = dbm_fetch (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 return (valdatum.dptr
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
294 ? make_ext_string (valdatum.dptr, valdatum.dsize,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
295 db->coding_system)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 dbm_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 Lisp_Object key, Lisp_Object val, Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 datum keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
305 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
306 ALLOCA, (valdatum.dptr, valdatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
307 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
308 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
309 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
310 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 return !dbm_store (db->dbm_handle, keydatum, valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 NILP (replace) ? DBM_INSERT : DBM_REPLACE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 dbm_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 datum keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
321 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
322 ALLOCA, (keydatum.dptr, keydatum.dsize),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
323 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 return dbm_delete (db->dbm_handle, keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 dbm_type (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 return Qdbm;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 dbm_subtype (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 dbm_lasterr (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 dbm_closeit (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 if (db->dbm_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 dbm_close (db->dbm_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 db->dbm_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
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 static DB_FUNCS ndbm_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 dbm_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 dbm_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 dbm_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 dbm_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 dbm_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 dbm_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 dbm_closeit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 dbm_lasterr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 berkdb_type (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 return Qberkeley_db;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 berkdb_subtype (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 if (!db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 switch (db->db_handle->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 case DB_BTREE: return Qbtree;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 case DB_HASH: return Qhash;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 case DB_RECNO: return Qrecno;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
387 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
388 case DB_QUEUE: return Qqueue;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
389 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 default: return Qunknown;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 berkdb_lasterr (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 return lisp_strerror (db->dberrno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 berkdb_get (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
410 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
411 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
412 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 if (!status)
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
421 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
422 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 berkdb_put (Lisp_Database *db,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 Lisp_Object key,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 Lisp_Object val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 Lisp_Object replace)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 int status = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
446 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
447 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
448 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
449 TO_EXTERNAL_FORMAT (LISP_STRING, val,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
450 ALLOCA, (valdatum.data, valdatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
451 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 status = db->db_handle->put (db->db_handle, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 NILP (replace) ? R_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 NILP (replace) ? DB_NOOVERWRITE : 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 #endif/* DV_VERSION_MAJOR = 2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 return status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 berkdb_remove (Lisp_Database *db, Lisp_Object key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 DBT keydatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 /* DB Version 2 requires DBT's to be zeroed before use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
474 TO_EXTERNAL_FORMAT (LISP_STRING, key,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
475 ALLOCA, (keydatum.data, keydatum.size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
476 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 status = db->db_handle->del (db->db_handle, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 if (!status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 db->dberrno = (status == 1) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 db->dberrno = (status < 0) ? -1 : errno;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 berkdb_map (Lisp_Database *db, Lisp_Object func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 DBT keydatum, valdatum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 Lisp_Object key, val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 DB *dbp = db->db_handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 xzero (keydatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 xzero (valdatum);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
512 key = make_ext_string (keydatum.data, keydatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
513 db->coding_system);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
514 val = make_ext_string (valdatum.data, valdatum.size,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
515 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 DBC *dbcp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 #if DB_VERSION_MAJOR > 2 || DB_VERSION_MINOR >=6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 status = dbp->cursor (dbp, NULL, &dbcp, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 status = dbp->cursor (dbp, NULL, &dbcp);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
526 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 status == 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 {
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
531 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
532 db->coding_system);
1645
080d479edd32 [xemacs-hg @ 2003-08-26 14:03:57 by james]
james
parents: 1460
diff changeset
533 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
534 db->coding_system);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 call2 (func, key, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 dbcp->c_close (dbcp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 berkdb_close (Lisp_Database *db)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 if (db->db_handle)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 db->db_handle->close (db->db_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 db->db_handle->sync (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 db->db_handle->close (db->db_handle, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 db->db_handle = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 }
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 static DB_FUNCS berk_func_block =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 berkdb_subtype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 berkdb_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 berkdb_get,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 berkdb_put,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 berkdb_remove,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 berkdb_map,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 berkdb_close,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 berkdb_lasterr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 Return the last error associated with DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 if (NILP (database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 return lisp_strerror (errno);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 CHECK_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 return XDATABASE (database)->funcs->last_error (XDATABASE (database));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
584 DEFUN ("open-database", Fopen_database, 1, 6, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 Return a new database object opened on FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 Optional arguments TYPE and SUBTYPE specify the database type.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 Optional argument ACCESS specifies the access rights, which may be any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 combination of 'r' 'w' and '+', for read, write, and creation flags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 Optional argument MODE gives the permissions to use when opening FILE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 and defaults to 0755.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
591 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
592 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
593 variable `database-coding-system'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
595 (file, type, subtype, access_, mode, codesys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 int modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 int accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 Lisp_Database *db = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 char *filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 CHECK_STRING (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 GCPRO2 (file, access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 file = Fexpand_file_name (file, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
609 TO_EXTERNAL_FORMAT (LISP_STRING, file,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
610 C_STRING_ALLOCA, filename,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
611 Qfile_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 accessmask = O_RDWR | O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 acc = (char *) XSTRING_DATA (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 accessmask |= O_CREAT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
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 char *rp = strchr (acc, 'r');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 char *wp = strchr (acc, 'w');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 if (rp && wp) accessmask |= O_RDWR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 else if (wp) accessmask |= O_WRONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 else accessmask |= O_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 }
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 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 modemask = 0755; /* rwxr-xr-x */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 CHECK_INT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 modemask = XINT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
645 if (NILP (codesys))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
646 codesys = Vdatabase_coding_system;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
647
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
648 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
649
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 if (NILP (type) || EQ (type, Qdbm))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 DBM *dbase = dbm_open (filename, accessmask, modemask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 db->dbm_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 db->funcs = &ndbm_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
660 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 #endif /* HAVE_DBM */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 if (NILP (type) || EQ (type, Qberkeley_db))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 DBTYPE real_subtype;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 DB *dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 #if DB_VERSION_MAJOR != 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 int status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 if (EQ (subtype, Qhash) || NILP (subtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 real_subtype = DB_HASH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 else if (EQ (subtype, Qbtree))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 real_subtype = DB_BTREE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 else if (EQ (subtype, Qrecno))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 real_subtype = DB_RECNO;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
680 #if DB_VERSION_MAJOR > 2
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
681 else if (EQ (subtype, Qqueue))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
682 real_subtype = DB_QUEUE;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
683 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
685 invalid_constant ("Unsupported subtype", subtype);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 #if DB_VERSION_MAJOR == 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 if (!dbase)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 /* 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
693 other flags shouldn't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 if (NILP (access_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 accessmask = DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 char *acc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 CHECK_STRING (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 acc = (char *) XSTRING_DATA (access_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 accessmask = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 if (strchr (acc, '+'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 accessmask |= DB_CREATE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (strchr (acc, 'r') && !strchr (acc, 'w'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 accessmask |= DB_RDONLY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
709 #if DB_VERSION_MAJOR == 2
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 status = db_open (filename, real_subtype, accessmask,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 modemask, NULL , NULL, &dbase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 if (status)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 return Qnil;
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
714 #else
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
715 status = db_create (&dbase, NULL, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
716 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
717 return Qnil;
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
718 #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
719 status = dbase->open (dbase, filename, NULL,
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
720 real_subtype, accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
721 #else /* DB_VERSION >= 4.1 */
1377
19738a2a5138 [xemacs-hg @ 2003-03-24 15:01:47 by stephent]
stephent
parents: 1204
diff changeset
722 /* 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
723 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
724 accessmask, modemask);
1141
0dade3314f4f [xemacs-hg @ 2002-12-04 13:54:31 by stephent]
stephent
parents: 934
diff changeset
725 #endif /* DB_VERSION < 4.1 */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
726 if (status)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
727 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
728 dbase->close (dbase, 0);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
729 return Qnil;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
730 }
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
731 #endif /* DB_VERSION_MAJOR > 2 */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
732 /* Normalize into system specific file modes. Only for printing */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
733 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 #endif /* DB_VERSION_MAJOR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 db = allocate_database ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 db->db_handle = dbase;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 db->funcs = &berk_func_block;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
739 db->coding_system = codesys;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 goto db_done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 #endif /* HAVE_BERKELEY_DB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
744 invalid_constant ("Unsupported database type", type);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 db_done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 db->live_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 db->fname = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 db->mode = modemask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 db->access_ = accessmask;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
753 return wrap_database (db);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 }
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 DEFUN ("put-database", Fput_database, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 Store KEY and VALUE in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 If optional fourth arg REPLACE is non-nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 replace any existing entry in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (key, value, database, replace))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 CHECK_STRING (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 int status = db->funcs->put (db, key, value, replace);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 }
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 DEFUN ("remove-database", Fremove_database, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 Remove KEY from DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (key, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 int status = db->funcs->rem (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 return status ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 }
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 DEFUN ("get-database", Fget_database, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 Return value for KEY in DATABASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 If there is no corresponding value, return DEFAULT (defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (key, database, default_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 CHECK_STRING (key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Lisp_Database *db = XDATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 Lisp_Object retval = db->funcs->get (db, key);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 return NILP (retval) ? default_ : retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 }
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 DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 Map FUNCTION over entries in DATABASE, calling it with two args,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 each key and value in the database.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (function, database))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 CHECK_LIVE_DATABASE (database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 XDATABASE (database)->funcs->map (XDATABASE (database), function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 syms_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
818 INIT_LRECORD_IMPLEMENTATION (database);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
819
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
820 DEFSYMBOL (Qdatabasep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 #ifdef HAVE_DBM
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
822 DEFSYMBOL (Qdbm);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 #ifdef HAVE_BERKELEY_DB
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
825 DEFSYMBOL (Qberkeley_db);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
826 DEFSYMBOL (Qhash);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
827 DEFSYMBOL (Qbtree);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
828 DEFSYMBOL (Qrecno);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
829 #if DB_VERSION_MAJOR > 2
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
830 DEFSYMBOL (Qqueue);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
831 #endif
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
832 DEFSYMBOL (Qunknown);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 DEFSUBR (Fopen_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 DEFSUBR (Fdatabasep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 DEFSUBR (Fmapdatabase);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 DEFSUBR (Fput_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 DEFSUBR (Fget_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 DEFSUBR (Fremove_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 DEFSUBR (Fdatabase_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 DEFSUBR (Fdatabase_subtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 DEFSUBR (Fdatabase_last_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 DEFSUBR (Fdatabase_live_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 DEFSUBR (Fdatabase_file_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 DEFSUBR (Fclose_database);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 vars_of_database (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 #ifdef HAVE_DBM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 Fprovide (Qdbm);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 #ifdef HAVE_BERKELEY_DB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 Fprovide (Qberkeley_db);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 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
860 Default coding system used to convert data in database files.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 */ );
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
862 Vdatabase_coding_system = Qnative;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 }