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