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