This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[perl5.git] / SDBM_File.c
CommitLineData
463ee0b2
LW
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4#include "ext/dbm/sdbm/sdbm.h"
5
6typedef DBM* SDBM_File;
7#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
ed6116ce 8#define nextkey(db,key) sdbm_nextkey(db)
463ee0b2
LW
9
10static int
11XS_SDBM_File_sdbm_new(ix, sp, items)
12register int ix;
13register int sp;
14register 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_mortalcopy(&sv_undef);
28 sv_setptrobj(ST(0), RETVAL, "SDBM_File");
29 }
30 return sp;
31}
32
33static int
34XS_SDBM_File_sdbm_DESTROY(ix, sp, items)
35register int ix;
36register int sp;
37register 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 (sv_isa(ST(1), "SDBM_File"))
ed6116ce 46 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
47 else
48 croak("db is not of type SDBM_File");
49 sdbm_close(db);
50 }
51 return sp;
52}
53
54static int
55XS_SDBM_File_sdbm_fetch(ix, sp, items)
56register int ix;
57register int sp;
58register 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"))
ed6116ce 69 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
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_mortalcopy(&sv_undef);
77 sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
78 }
79 return sp;
80}
81
82static int
83XS_SDBM_File_sdbm_store(ix, sp, items)
84register int ix;
85register int sp;
86register 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"))
ed6116ce 99 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
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_mortalcopy(&sv_undef);
115 sv_setiv(ST(0), (I32)RETVAL);
116 }
117 return sp;
118}
119
120static int
121XS_SDBM_File_sdbm_delete(ix, sp, items)
122register int ix;
123register int sp;
124register 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"))
ed6116ce 135 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
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_mortalcopy(&sv_undef);
143 sv_setiv(ST(0), (I32)RETVAL);
144 }
145 return sp;
146}
147
148static int
149XS_SDBM_File_sdbm_firstkey(ix, sp, items)
150register int ix;
151register int sp;
152register 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"))
ed6116ce 162 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
163 else
164 croak("db is not of type SDBM_File");
165
166 RETVAL = sdbm_firstkey(db);
167 ST(0) = sv_mortalcopy(&sv_undef);
168 sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
169 }
170 return sp;
171}
172
173static int
ed6116ce 174XS_SDBM_File_nextkey(ix, sp, items)
463ee0b2
LW
175register int ix;
176register int sp;
177register 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"))
ed6116ce 188 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
189 else
190 croak("db is not of type SDBM_File");
191
192 key.dptr = SvPV(ST(2), key.dsize);;
193
ed6116ce 194 RETVAL = nextkey(db, key);
463ee0b2
LW
195 ST(0) = sv_mortalcopy(&sv_undef);
196 sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
197 }
198 return sp;
199}
200
201static int
202XS_SDBM_File_sdbm_error(ix, sp, items)
203register int ix;
204register int sp;
205register 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"))
ed6116ce 215 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
216 else
217 croak("db is not of type SDBM_File");
218
219 RETVAL = sdbm_error(db);
220 ST(0) = sv_mortalcopy(&sv_undef);
221 sv_setiv(ST(0), (I32)RETVAL);
222 }
223 return sp;
224}
225
226static int
227XS_SDBM_File_sdbm_clearerr(ix, sp, items)
228register int ix;
229register int sp;
230register 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"))
ed6116ce 240 db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2
LW
241 else
242 croak("db is not of type SDBM_File");
243
244 RETVAL = sdbm_clearerr(db);
245 ST(0) = sv_mortalcopy(&sv_undef);
246 sv_setiv(ST(0), (I32)RETVAL);
247 }
248 return sp;
249}
250
251int init_SDBM_File(ix,sp,items)
252int ix;
253int sp;
254int 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);
ed6116ce 264 newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_nextkey, file);
463ee0b2
LW
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}