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
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(char *s)
27 {
28     croak("GDBM_File::%s not implemented on this architecture", s);
29     return -1;
30 }
31
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
42 static double
43 constant(char *name, int arg)
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
157 not_there:
158     errno = ENOENT;
159     return 0;
160 }
161
162 MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_
163
164 double
165 constant(name,arg)
166         char *          name
167         int             arg
168
169
170 GDBM_File
171 gdbm_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
178 void
179 gdbm_close(db)
180         GDBM_File       db
181         CLEANUP:
182
183 void
184 gdbm_DESTROY(db)
185         GDBM_File       db
186         CODE:
187         gdbm_close(db);
188
189 gdatum
190 gdbm_FETCH(db, key)
191         GDBM_File       db
192         datum           key
193
194 int
195 gdbm_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");
204             croak("gdbm store returned %d, errno %d, key \"%.*s\"",
205                         RETVAL,errno,key.dsize,key.dptr);
206             /* gdbm_clearerr(db); */
207         }
208
209 int
210 gdbm_DELETE(db, key)
211         GDBM_File       db
212         datum           key
213
214 gdatum
215 gdbm_FIRSTKEY(db)
216         GDBM_File       db
217
218 gdatum
219 gdbm_NEXTKEY(db, key)
220         GDBM_File       db
221         datum           key
222
223 int
224 gdbm_reorganize(db)
225         GDBM_File       db
226
227
228 void
229 gdbm_sync(db)
230         GDBM_File       db
231
232 int
233 gdbm_EXISTS(db, key)
234         GDBM_File       db
235         datum           key
236
237 int
238 gdbm_setopt (db, optflag, optval, optlen)
239         GDBM_File       db
240         int             optflag
241         int             &optval
242         int             optlen
243