perl 5.0 alpha 6
[perl.git] / SDBM_File.c
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include "ext/dbm/sdbm/sdbm.h"
5
6 typedef DBM* SDBM_File;
7 #define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
8 #define nextkey(db,key) sdbm_nextkey(db)
9
10 static int
11 XS_SDBM_File_sdbm_new(ix, sp, items)
12 register int ix;
13 register int sp;
14 register int items;
15 {
16     if (items < 4 || items > 4) {
17         croak("Usage: SDBM_File::new(dbtype, filename, flags, mode)");
18     }
19     {
20         char *  dbtype = SvPV(ST(1),na);
21         char *  filename = SvPV(ST(2),na);
22         int     flags = (int)SvIV(ST(3));
23         int     mode = (int)SvIV(ST(4));
24         SDBM_File       RETVAL;
25
26         RETVAL = sdbm_new(dbtype, filename, flags, mode);
27         ST(0) = sv_newmortal();
28         sv_setptrobj(ST(0), RETVAL, "SDBM_File");
29     }
30     return sp;
31 }
32
33 static int
34 XS_SDBM_File_sdbm_DESTROY(ix, sp, items)
35 register int ix;
36 register int sp;
37 register int items;
38 {
39     if (items < 1 || items > 1) {
40         croak("Usage: SDBM_File::DESTROY(db)");
41     }
42     {
43         SDBM_File       db;
44
45         if (SvROK(ST(1)))
46             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
47         else
48             croak("db is not a reference");
49         sdbm_close(db);
50     }
51     return sp;
52 }
53
54 static int
55 XS_SDBM_File_sdbm_fetch(ix, sp, items)
56 register int ix;
57 register int sp;
58 register int items;
59 {
60     if (items < 2 || items > 2) {
61         croak("Usage: SDBM_File::fetch(db, key)");
62     }
63     {
64         SDBM_File       db;
65         datum   key;
66         datum   RETVAL;
67
68         if (sv_isa(ST(1), "SDBM_File"))
69             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
70         else
71             croak("db is not of type SDBM_File");
72
73         key.dptr = SvPV(ST(2), key.dsize);;
74
75         RETVAL = sdbm_fetch(db, key);
76         ST(0) = sv_newmortal();
77         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
78     }
79     return sp;
80 }
81
82 static int
83 XS_SDBM_File_sdbm_store(ix, sp, items)
84 register int ix;
85 register int sp;
86 register int items;
87 {
88     if (items < 3 || items > 4) {
89         croak("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)");
90     }
91     {
92         SDBM_File       db;
93         datum   key;
94         datum   value;
95         int     flags;
96         int     RETVAL;
97
98         if (sv_isa(ST(1), "SDBM_File"))
99             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
100         else
101             croak("db is not of type SDBM_File");
102
103         key.dptr = SvPV(ST(2), key.dsize);;
104
105         value.dptr = SvPV(ST(3), value.dsize);;
106
107         if (items < 4)
108             flags = DBM_REPLACE;
109         else {
110             flags = (int)SvIV(ST(4));
111         }
112
113         RETVAL = sdbm_store(db, key, value, flags);
114         ST(0) = sv_newmortal();
115         sv_setiv(ST(0), (I32)RETVAL);
116     }
117     return sp;
118 }
119
120 static int
121 XS_SDBM_File_sdbm_delete(ix, sp, items)
122 register int ix;
123 register int sp;
124 register int items;
125 {
126     if (items < 2 || items > 2) {
127         croak("Usage: SDBM_File::delete(db, key)");
128     }
129     {
130         SDBM_File       db;
131         datum   key;
132         int     RETVAL;
133
134         if (sv_isa(ST(1), "SDBM_File"))
135             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
136         else
137             croak("db is not of type SDBM_File");
138
139         key.dptr = SvPV(ST(2), key.dsize);;
140
141         RETVAL = sdbm_delete(db, key);
142         ST(0) = sv_newmortal();
143         sv_setiv(ST(0), (I32)RETVAL);
144     }
145     return sp;
146 }
147
148 static int
149 XS_SDBM_File_sdbm_firstkey(ix, sp, items)
150 register int ix;
151 register int sp;
152 register int items;
153 {
154     if (items < 1 || items > 1) {
155         croak("Usage: SDBM_File::firstkey(db)");
156     }
157     {
158         SDBM_File       db;
159         datum   RETVAL;
160
161         if (sv_isa(ST(1), "SDBM_File"))
162             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
163         else
164             croak("db is not of type SDBM_File");
165
166         RETVAL = sdbm_firstkey(db);
167         ST(0) = sv_newmortal();
168         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
169     }
170     return sp;
171 }
172
173 static int
174 XS_SDBM_File_nextkey(ix, sp, items)
175 register int ix;
176 register int sp;
177 register int items;
178 {
179     if (items < 2 || items > 2) {
180         croak("Usage: SDBM_File::nextkey(db, key)");
181     }
182     {
183         SDBM_File       db;
184         datum   key;
185         datum   RETVAL;
186
187         if (sv_isa(ST(1), "SDBM_File"))
188             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
189         else
190             croak("db is not of type SDBM_File");
191
192         key.dptr = SvPV(ST(2), key.dsize);;
193
194         RETVAL = nextkey(db, key);
195         ST(0) = sv_newmortal();
196         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
197     }
198     return sp;
199 }
200
201 static int
202 XS_SDBM_File_sdbm_error(ix, sp, items)
203 register int ix;
204 register int sp;
205 register int items;
206 {
207     if (items < 1 || items > 1) {
208         croak("Usage: SDBM_File::error(db)");
209     }
210     {
211         SDBM_File       db;
212         int     RETVAL;
213
214         if (sv_isa(ST(1), "SDBM_File"))
215             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
216         else
217             croak("db is not of type SDBM_File");
218
219         RETVAL = sdbm_error(db);
220         ST(0) = sv_newmortal();
221         sv_setiv(ST(0), (I32)RETVAL);
222     }
223     return sp;
224 }
225
226 static int
227 XS_SDBM_File_sdbm_clearerr(ix, sp, items)
228 register int ix;
229 register int sp;
230 register int items;
231 {
232     if (items < 1 || items > 1) {
233         croak("Usage: SDBM_File::clearerr(db)");
234     }
235     {
236         SDBM_File       db;
237         int     RETVAL;
238
239         if (sv_isa(ST(1), "SDBM_File"))
240             db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
241         else
242             croak("db is not of type SDBM_File");
243
244         RETVAL = sdbm_clearerr(db);
245         ST(0) = sv_newmortal();
246         sv_setiv(ST(0), (I32)RETVAL);
247     }
248     return sp;
249 }
250
251 int boot_SDBM_File(ix,sp,items)
252 int ix;
253 int sp;
254 int items;
255 {
256     char* file = __FILE__;
257
258     newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file);
259     newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file);
260     newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file);
261     newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file);
262     newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file);
263     newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file);
264     newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_nextkey, file);
265     newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file);
266     newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file);
267 }