This is patch.2b1d to perl5.002beta1.
[p5sagit/p5-mst-13.2.git] / ext / GDBM_File / GDBM_File.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include <gdbm.h>
6 #include <fcntl.h>
7
8 typedef GDBM_FILE GDBM_File;
9
10 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
11 #define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
12         gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
13
14 #define gdbm_FETCH(db,key)                      gdbm_fetch(db,key)
15 #define gdbm_STORE(db,key,value,flags)          gdbm_store(db,key,value,flags)
16 #define gdbm_DELETE(db,key)                     gdbm_delete(db,key)
17 #define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db)
18 #define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db,key)
19 #define gdbm_EXISTS(db,key)                     gdbm_exists(db,key)
20
21 typedef datum gdatum;
22
23 typedef void (*FATALFUNC)();
24
25 static int
26 not_here(s)
27 char *s;
28 {
29     croak("GDBM_File::%s not implemented on this architecture", s);
30     return -1;
31 }
32
33 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
34    gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
35    (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
36 */
37 #ifndef GDBM_FAST
38 #define gdbm_exists(db,key) not_here("gdbm_exists")
39 #define gdbm_sync(db) (void) not_here("gdbm_sync")
40 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
41 #endif
42
43 static double
44 constant(name, arg)
45 char *name;
46 int arg;
47 {
48     errno = 0;
49     switch (*name) {
50     case 'A':
51         break;
52     case 'B':
53         break;
54     case 'C':
55         break;
56     case 'D':
57         break;
58     case 'E':
59         break;
60     case 'F':
61         break;
62     case 'G':
63         if (strEQ(name, "GDBM_CACHESIZE"))
64 #ifdef GDBM_CACHESIZE
65             return GDBM_CACHESIZE;
66 #else
67             goto not_there;
68 #endif
69         if (strEQ(name, "GDBM_FAST"))
70 #ifdef GDBM_FAST
71             return GDBM_FAST;
72 #else
73             goto not_there;
74 #endif
75         if (strEQ(name, "GDBM_FASTMODE"))
76 #ifdef GDBM_FASTMODE
77             return GDBM_FASTMODE;
78 #else
79             goto not_there;
80 #endif
81         if (strEQ(name, "GDBM_INSERT"))
82 #ifdef GDBM_INSERT
83             return GDBM_INSERT;
84 #else
85             goto not_there;
86 #endif
87         if (strEQ(name, "GDBM_NEWDB"))
88 #ifdef GDBM_NEWDB
89             return GDBM_NEWDB;
90 #else
91             goto not_there;
92 #endif
93         if (strEQ(name, "GDBM_READER"))
94 #ifdef GDBM_READER
95             return GDBM_READER;
96 #else
97             goto not_there;
98 #endif
99         if (strEQ(name, "GDBM_REPLACE"))
100 #ifdef GDBM_REPLACE
101             return GDBM_REPLACE;
102 #else
103             goto not_there;
104 #endif
105         if (strEQ(name, "GDBM_WRCREAT"))
106 #ifdef GDBM_WRCREAT
107             return GDBM_WRCREAT;
108 #else
109             goto not_there;
110 #endif
111         if (strEQ(name, "GDBM_WRITER"))
112 #ifdef GDBM_WRITER
113             return GDBM_WRITER;
114 #else
115             goto not_there;
116 #endif
117         break;
118     case 'H':
119         break;
120     case 'I':
121         break;
122     case 'J':
123         break;
124     case 'K':
125         break;
126     case 'L':
127         break;
128     case 'M':
129         break;
130     case 'N':
131         break;
132     case 'O':
133         break;
134     case 'P':
135         break;
136     case 'Q':
137         break;
138     case 'R':
139         break;
140     case 'S':
141         break;
142     case 'T':
143         break;
144     case 'U':
145         break;
146     case 'V':
147         break;
148     case 'W':
149         break;
150     case 'X':
151         break;
152     case 'Y':
153         break;
154     case 'Z':
155         break;
156     }
157     errno = EINVAL;
158     return 0;
159
160 not_there:
161     errno = ENOENT;
162     return 0;
163 }
164
165 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
166
167 double
168 constant(name,arg)
169         char *          name
170         int             arg
171
172
173 GDBM_File
174 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
175         char *          dbtype
176         char *          name
177         int             read_write
178         int             mode
179         FATALFUNC       fatal_func
180
181 void
182 gdbm_close(db)
183         GDBM_File       db
184         CLEANUP:
185
186 void
187 gdbm_DESTROY(db)
188         GDBM_File       db
189         CODE:
190         gdbm_close(db);
191
192 gdatum
193 gdbm_FETCH(db, key)
194         GDBM_File       db
195         datum           key
196
197 int
198 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
199         GDBM_File       db
200         datum           key
201         datum           value
202         int             flags
203     CLEANUP:
204         if (RETVAL) {
205             if (RETVAL < 0 && errno == EPERM)
206                 croak("No write permission to gdbm file");
207             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
208                         RETVAL,errno,key.dsize,key.dptr);
209             /* gdbm_clearerr(db); */
210         }
211
212 int
213 gdbm_DELETE(db, key)
214         GDBM_File       db
215         datum           key
216
217 gdatum
218 gdbm_FIRSTKEY(db)
219         GDBM_File       db
220
221 gdatum
222 gdbm_NEXTKEY(db, key)
223         GDBM_File       db
224         datum           key
225
226 int
227 gdbm_reorganize(db)
228         GDBM_File       db
229
230
231 void
232 gdbm_sync(db)
233         GDBM_File       db
234
235 int
236 gdbm_exists(db, key)
237         GDBM_File       db
238         datum           key
239
240 int
241 gdbm_setopt (db, optflag, optval, optlen)
242         GDBM_File       db
243         int             optflag
244         int             &optval
245         int             optlen
246