Commit | Line | Data |
463ee0b2 |
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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | fatal("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 | } |