b5d4a8884a62817e86a5c1866656e8ffb87b9e3e
[perl.git] / ext / dbm / GDBM_File.c
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include <gdbm.h>
5
6 #include <fcntl.h>
7
8 typedef GDBM_FILE GDBM_File;
9
10 #define gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func) \
11         gdbm_open(name, block_size, read_write, mode, fatal_func)
12
13 typedef datum gdatum;
14
15 typedef void (*FATALFUNC)();
16
17 static int
18 XS_GDBM_File_gdbm_new(ix, sp, items)
19 register int ix;
20 register int sp;
21 register int items;
22 {
23     if (items < 5 || items > 6) {
24         fatal("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
25     }
26     {
27         char *  dbtype = SvPV(ST(1),na);
28         char *  name = SvPV(ST(2),na);
29         int     block_size = (int)SvIV(ST(3));
30         int     read_write = (int)SvIV(ST(4));
31         int     mode = (int)SvIV(ST(5));
32         FATALFUNC       fatal_func;
33         GDBM_File       RETVAL;
34
35         if (items < 6)
36             fatal_func = (FATALFUNC)fatal;
37         else {
38             fatal_func = (FATALFUNC)SvPV(ST(6),na);
39         }
40
41         RETVAL = gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func);
42         ST(0) = sv_mortalcopy(&sv_undef);
43         sv_setptrobj(ST(0), RETVAL, "GDBM_File");
44     }
45     return sp;
46 }
47
48 static int
49 XS_GDBM_File_gdbm_open(ix, sp, items)
50 register int ix;
51 register int sp;
52 register int items;
53 {
54     if (items < 4 || items > 5) {
55         fatal("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
56     }
57     {
58         char *  name = SvPV(ST(1),na);
59         int     block_size = (int)SvIV(ST(2));
60         int     read_write = (int)SvIV(ST(3));
61         int     mode = (int)SvIV(ST(4));
62         FATALFUNC       fatal_func;
63         GDBM_File       RETVAL;
64
65         if (items < 5)
66             fatal_func = (FATALFUNC)fatal;
67         else {
68             fatal_func = (FATALFUNC)SvPV(ST(5),na);
69         }
70
71         RETVAL = gdbm_open(name, block_size, read_write, mode, fatal_func);
72         ST(0) = sv_mortalcopy(&sv_undef);
73         sv_setptrobj(ST(0), RETVAL, "GDBM_File");
74     }
75     return sp;
76 }
77
78 static int
79 XS_GDBM_File_gdbm_close(ix, sp, items)
80 register int ix;
81 register int sp;
82 register int items;
83 {
84     if (items < 1 || items > 1) {
85         fatal("Usage: GDBM_File::close(db)");
86     }
87     {
88         GDBM_File       db;
89
90         if (sv_isa(ST(1), "GDBM_File"))
91             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
92         else
93             fatal("db is not of type GDBM_File");
94
95         gdbm_close(db);
96     }
97     return sp;
98 }
99
100 static int
101 XS_GDBM_File_gdbm_DESTROY(ix, sp, items)
102 register int ix;
103 register int sp;
104 register int items;
105 {
106     if (items < 1 || items > 1) {
107         fatal("Usage: GDBM_File::DESTROY(db)");
108     }
109     {
110         GDBM_File       db;
111
112         if (sv_isa(ST(1), "GDBM_File"))
113             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
114         else
115             fatal("db is not of type GDBM_File");
116         gdbm_close(db);
117     }
118     return sp;
119 }
120
121 static int
122 XS_GDBM_File_gdbm_fetch(ix, sp, items)
123 register int ix;
124 register int sp;
125 register int items;
126 {
127     if (items < 2 || items > 2) {
128         fatal("Usage: GDBM_File::fetch(db, key)");
129     }
130     {
131         GDBM_File       db;
132         datum   key;
133         gdatum  RETVAL;
134
135         if (sv_isa(ST(1), "GDBM_File"))
136             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
137         else
138             fatal("db is not of type GDBM_File");
139
140         key.dptr = SvPV(ST(2), key.dsize);;
141
142         RETVAL = gdbm_fetch(db, key);
143         ST(0) = sv_mortalcopy(&sv_undef);
144         sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize);
145     }
146     return sp;
147 }
148
149 static int
150 XS_GDBM_File_gdbm_store(ix, sp, items)
151 register int ix;
152 register int sp;
153 register int items;
154 {
155     if (items < 3 || items > 4) {
156         fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)");
157     }
158     {
159         GDBM_File       db;
160         datum   key;
161         datum   value;
162         int     flags;
163         int     RETVAL;
164
165         if (sv_isa(ST(1), "GDBM_File"))
166             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
167         else
168             fatal("db is not of type GDBM_File");
169
170         key.dptr = SvPV(ST(2), key.dsize);;
171
172         value.dptr = SvPV(ST(3), value.dsize);;
173
174         if (items < 4)
175             flags = GDBM_REPLACE;
176         else {
177             flags = (int)SvIV(ST(4));
178         }
179
180         RETVAL = gdbm_store(db, key, value, flags);
181         ST(0) = sv_mortalcopy(&sv_undef);
182         sv_setiv(ST(0), (I32)RETVAL);
183     }
184     return sp;
185 }
186
187 static int
188 XS_GDBM_File_gdbm_delete(ix, sp, items)
189 register int ix;
190 register int sp;
191 register int items;
192 {
193     if (items < 2 || items > 2) {
194         fatal("Usage: GDBM_File::delete(db, key)");
195     }
196     {
197         GDBM_File       db;
198         datum   key;
199         int     RETVAL;
200
201         if (sv_isa(ST(1), "GDBM_File"))
202             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
203         else
204             fatal("db is not of type GDBM_File");
205
206         key.dptr = SvPV(ST(2), key.dsize);;
207
208         RETVAL = gdbm_delete(db, key);
209         ST(0) = sv_mortalcopy(&sv_undef);
210         sv_setiv(ST(0), (I32)RETVAL);
211     }
212     return sp;
213 }
214
215 static int
216 XS_GDBM_File_gdbm_firstkey(ix, sp, items)
217 register int ix;
218 register int sp;
219 register int items;
220 {
221     if (items < 1 || items > 1) {
222         fatal("Usage: GDBM_File::firstkey(db)");
223     }
224     {
225         GDBM_File       db;
226         gdatum  RETVAL;
227
228         if (sv_isa(ST(1), "GDBM_File"))
229             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
230         else
231             fatal("db is not of type GDBM_File");
232
233         RETVAL = gdbm_firstkey(db);
234         ST(0) = sv_mortalcopy(&sv_undef);
235         sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize);
236     }
237     return sp;
238 }
239
240 static int
241 XS_GDBM_File_gdbm_nextkey(ix, sp, items)
242 register int ix;
243 register int sp;
244 register int items;
245 {
246     if (items < 2 || items > 2) {
247         fatal("Usage: GDBM_File::nextkey(db, key)");
248     }
249     {
250         GDBM_File       db;
251         datum   key;
252         gdatum  RETVAL;
253
254         if (sv_isa(ST(1), "GDBM_File"))
255             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
256         else
257             fatal("db is not of type GDBM_File");
258
259         key.dptr = SvPV(ST(2), key.dsize);;
260
261         RETVAL = gdbm_nextkey(db, key);
262         ST(0) = sv_mortalcopy(&sv_undef);
263         sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize);
264     }
265     return sp;
266 }
267
268 static int
269 XS_GDBM_File_gdbm_reorganize(ix, sp, items)
270 register int ix;
271 register int sp;
272 register int items;
273 {
274     if (items < 1 || items > 1) {
275         fatal("Usage: GDBM_File::reorganize(db)");
276     }
277     {
278         GDBM_File       db;
279         int     RETVAL;
280
281         if (sv_isa(ST(1), "GDBM_File"))
282             db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
283         else
284             fatal("db is not of type GDBM_File");
285
286         RETVAL = gdbm_reorganize(db);
287         ST(0) = sv_mortalcopy(&sv_undef);
288         sv_setiv(ST(0), (I32)RETVAL);
289     }
290     return sp;
291 }
292
293 int init_GDBM_File(ix,sp,items)
294 int ix;
295 int sp;
296 int items;
297 {
298     char* file = __FILE__;
299
300     newXSUB("GDBM_File::new", 0, XS_GDBM_File_gdbm_new, file);
301     newXSUB("GDBM_File::open", 0, XS_GDBM_File_gdbm_open, file);
302     newXSUB("GDBM_File::close", 0, XS_GDBM_File_gdbm_close, file);
303     newXSUB("GDBM_File::DESTROY", 0, XS_GDBM_File_gdbm_DESTROY, file);
304     newXSUB("GDBM_File::fetch", 0, XS_GDBM_File_gdbm_fetch, file);
305     newXSUB("GDBM_File::store", 0, XS_GDBM_File_gdbm_store, file);
306     newXSUB("GDBM_File::delete", 0, XS_GDBM_File_gdbm_delete, file);
307     newXSUB("GDBM_File::firstkey", 0, XS_GDBM_File_gdbm_firstkey, file);
308     newXSUB("GDBM_File::nextkey", 0, XS_GDBM_File_gdbm_nextkey, file);
309     newXSUB("GDBM_File::reorganize", 0, XS_GDBM_File_gdbm_reorganize, file);
310 }