perl 5.0 alpha 6
[perl.git] / NDBM_File.c
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include <ndbm.h>
5
6 typedef DBM* NDBM_File;
7 #define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode)
8 #define nextkey(db,key) dbm_nextkey(db)
9
10 static int
11 XS_NDBM_File_dbm_new(ix, ax, items)
12 register int ix;
13 register int ax;
14 register int items;
15 {
16     if (items != 4) {
17         croak("Usage: NDBM_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         NDBM_File       RETVAL;
25
26         RETVAL = dbm_new(dbtype, filename, flags, mode);
27         ST(0) = sv_newmortal();
28         sv_setptrobj(ST(0), RETVAL, "NDBM_File");
29     }
30     return ax;
31 }
32
33 static int
34 XS_NDBM_File_dbm_DESTROY(ix, ax, items)
35 register int ix;
36 register int ax;
37 register int items;
38 {
39     if (items != 1) {
40         croak("Usage: NDBM_File::DESTROY(db)");
41     }
42     {
43         NDBM_File       db;
44
45         if (SvROK(ST(1)))
46             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
47         else
48             croak("db is not a reference");
49         dbm_close(db);
50     }
51     return ax;
52 }
53
54 static int
55 XS_NDBM_File_dbm_fetch(ix, ax, items)
56 register int ix;
57 register int ax;
58 register int items;
59 {
60     if (items != 2) {
61         croak("Usage: NDBM_File::fetch(db, key)");
62     }
63     {
64         NDBM_File       db;
65         datum   key;
66         datum   RETVAL;
67
68         if (sv_isa(ST(1), "NDBM_File"))
69             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
70         else
71             croak("db is not of type NDBM_File");
72
73         key.dptr = SvPV(ST(2), key.dsize);;
74
75         RETVAL = dbm_fetch(db, key);
76         ST(0) = sv_newmortal();
77         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
78     }
79     return ax;
80 }
81
82 static int
83 XS_NDBM_File_dbm_store(ix, ax, items)
84 register int ix;
85 register int ax;
86 register int items;
87 {
88     if (items < 3 || items > 4) {
89         croak("Usage: NDBM_File::store(db, key, value, flags = DBM_REPLACE)");
90     }
91     {
92         NDBM_File       db;
93         datum   key;
94         datum   value;
95         int     flags;
96         int     RETVAL;
97
98         if (sv_isa(ST(1), "NDBM_File"))
99             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
100         else
101             croak("db is not of type NDBM_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 = dbm_store(db, key, value, flags);
114         ST(0) = sv_newmortal();
115         sv_setiv(ST(0), (I32)RETVAL);
116     }
117     return ax;
118 }
119
120 static int
121 XS_NDBM_File_dbm_delete(ix, ax, items)
122 register int ix;
123 register int ax;
124 register int items;
125 {
126     if (items != 2) {
127         croak("Usage: NDBM_File::delete(db, key)");
128     }
129     {
130         NDBM_File       db;
131         datum   key;
132         int     RETVAL;
133
134         if (sv_isa(ST(1), "NDBM_File"))
135             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
136         else
137             croak("db is not of type NDBM_File");
138
139         key.dptr = SvPV(ST(2), key.dsize);;
140
141         RETVAL = dbm_delete(db, key);
142         ST(0) = sv_newmortal();
143         sv_setiv(ST(0), (I32)RETVAL);
144     }
145     return ax;
146 }
147
148 static int
149 XS_NDBM_File_dbm_firstkey(ix, ax, items)
150 register int ix;
151 register int ax;
152 register int items;
153 {
154     if (items != 1) {
155         croak("Usage: NDBM_File::firstkey(db)");
156     }
157     {
158         NDBM_File       db;
159         datum   RETVAL;
160
161         if (sv_isa(ST(1), "NDBM_File"))
162             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
163         else
164             croak("db is not of type NDBM_File");
165
166         RETVAL = dbm_firstkey(db);
167         ST(0) = sv_newmortal();
168         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
169     }
170     return ax;
171 }
172
173 static int
174 XS_NDBM_File_nextkey(ix, ax, items)
175 register int ix;
176 register int ax;
177 register int items;
178 {
179     if (items != 2) {
180         croak("Usage: NDBM_File::nextkey(db, key)");
181     }
182     {
183         NDBM_File       db;
184         datum   key;
185         datum   RETVAL;
186
187         if (sv_isa(ST(1), "NDBM_File"))
188             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
189         else
190             croak("db is not of type NDBM_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 ax;
199 }
200
201 static int
202 XS_NDBM_File_dbm_error(ix, ax, items)
203 register int ix;
204 register int ax;
205 register int items;
206 {
207     if (items != 1) {
208         croak("Usage: NDBM_File::error(db)");
209     }
210     {
211         NDBM_File       db;
212         int     RETVAL;
213
214         if (sv_isa(ST(1), "NDBM_File"))
215             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
216         else
217             croak("db is not of type NDBM_File");
218
219         RETVAL = dbm_error(db);
220         ST(0) = sv_newmortal();
221         sv_setiv(ST(0), (I32)RETVAL);
222     }
223     return ax;
224 }
225
226 static int
227 XS_NDBM_File_dbm_clearerr(ix, ax, items)
228 register int ix;
229 register int ax;
230 register int items;
231 {
232     if (items != 1) {
233         croak("Usage: NDBM_File::clearerr(db)");
234     }
235     {
236         NDBM_File       db;
237         int     RETVAL;
238
239         if (sv_isa(ST(1), "NDBM_File"))
240             db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
241         else
242             croak("db is not of type NDBM_File");
243
244         RETVAL = dbm_clearerr(db);
245         ST(0) = sv_newmortal();
246         sv_setiv(ST(0), (I32)RETVAL);
247     }
248     return ax;
249 }
250
251 int boot_NDBM_File(ix,ax,items)
252 int ix;
253 int ax;
254 int items;
255 {
256     char* file = __FILE__;
257
258     newXSUB("NDBM_File::new", 0, XS_NDBM_File_dbm_new, file);
259     newXSUB("NDBM_File::DESTROY", 0, XS_NDBM_File_dbm_DESTROY, file);
260     newXSUB("NDBM_File::fetch", 0, XS_NDBM_File_dbm_fetch, file);
261     newXSUB("NDBM_File::store", 0, XS_NDBM_File_dbm_store, file);
262     newXSUB("NDBM_File::delete", 0, XS_NDBM_File_dbm_delete, file);
263     newXSUB("NDBM_File::firstkey", 0, XS_NDBM_File_dbm_firstkey, file);
264     newXSUB("NDBM_File::nextkey", 0, XS_NDBM_File_nextkey, file);
265     newXSUB("NDBM_File::error", 0, XS_NDBM_File_dbm_error, file);
266     newXSUB("NDBM_File::clearerr", 0, XS_NDBM_File_dbm_clearerr, file);
267 }