b2fa7ddcba76011fb0c6a2c7f9ad35191a576640
[perl.git] / ext / dbm / ODBM_File.c
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #ifdef NULL
6 #undef NULL
7 #endif
8 #include <dbm.h>
9
10 #include <fcntl.h>
11
12 typedef void* ODBM_File;
13
14 #define odbm_fetch(db,key)                      fetch(key)
15 #define odbm_store(db,key,value,flags)          store(key,value)
16 #define odbm_delete(db,key)                     delete(key)
17 #define odbm_firstkey(db)                       firstkey()
18 #define odbm_nextkey(db,key)                    nextkey(key)
19
20 static int dbmrefcnt;
21
22 #define DBM_REPLACE 0
23
24 static int
25 XS_ODBM_File_odbm_new(ix, sp, items)
26 register int ix;
27 register int sp;
28 register int items;
29 {
30     if (items < 4 || items > 4) {
31         fatal("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
32     }
33     {
34         char *  dbtype = SvPV(ST(1),na);
35         char *  filename = SvPV(ST(2),na);
36         int     flags = (int)SvIV(ST(3));
37         int     mode = (int)SvIV(ST(4));
38         ODBM_File       RETVAL;
39         {
40             char tmpbuf[1025];
41             if (dbmrefcnt++)
42                 fatal("Old dbm can only open one database");
43             sprintf(tmpbuf,"%s.dir",filename);
44             if (stat(tmpbuf, &statbuf) < 0) {
45                 if (flags & O_CREAT) {
46                     if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
47                         fatal("ODBM_File: Can't create %s", filename);
48                     sprintf(tmpbuf,"%s.pag",filename);
49                     if (close(creat(tmpbuf,mode)) < 0)
50                         fatal("ODBM_File: Can't create %s", filename);
51                 }
52                 else
53                     fatal("ODBM_FILE: Can't open %s", filename);
54             }
55             RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
56             ST(0) = sv_mortalcopy(&sv_undef);
57             sv_setptrobj(ST(0), RETVAL, "ODBM_File");
58         }
59     }
60     return sp;
61 }
62
63 static int
64 XS_ODBM_File_DESTROY(ix, sp, items)
65 register int ix;
66 register int sp;
67 register int items;
68 {
69     if (items < 1 || items > 1) {
70         fatal("Usage: ODBM_File::DESTROY(db)");
71     }
72     {
73         ODBM_File       db;
74
75         if (sv_isa(ST(1), "ODBM_File"))
76             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
77         else
78             fatal("db is not of type ODBM_File");
79         dbmrefcnt--;
80         dbmclose();
81     }
82     return sp;
83 }
84
85 static int
86 XS_ODBM_File_odbm_fetch(ix, sp, items)
87 register int ix;
88 register int sp;
89 register int items;
90 {
91     if (items < 2 || items > 2) {
92         fatal("Usage: ODBM_File::fetch(db, key)");
93     }
94     {
95         ODBM_File       db;
96         datum   key;
97         datum   RETVAL;
98
99         if (sv_isa(ST(1), "ODBM_File"))
100             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
101         else
102             fatal("db is not of type ODBM_File");
103
104         key.dptr = SvPV(ST(2), key.dsize);;
105
106         RETVAL = odbm_fetch(db, key);
107         ST(0) = sv_mortalcopy(&sv_undef);
108         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
109     }
110     return sp;
111 }
112
113 static int
114 XS_ODBM_File_odbm_store(ix, sp, items)
115 register int ix;
116 register int sp;
117 register int items;
118 {
119     if (items < 3 || items > 4) {
120         fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
121     }
122     {
123         ODBM_File       db;
124         datum   key;
125         datum   value;
126         int     flags;
127         int     RETVAL;
128
129         if (sv_isa(ST(1), "ODBM_File"))
130             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
131         else
132             fatal("db is not of type ODBM_File");
133
134         key.dptr = SvPV(ST(2), key.dsize);;
135
136         value.dptr = SvPV(ST(3), value.dsize);;
137
138         if (items < 4)
139             flags = DBM_REPLACE;
140         else {
141             flags = (int)SvIV(ST(4));
142         }
143
144         RETVAL = odbm_store(db, key, value, flags);
145         ST(0) = sv_mortalcopy(&sv_undef);
146         sv_setiv(ST(0), (I32)RETVAL);
147     }
148     return sp;
149 }
150
151 static int
152 XS_ODBM_File_odbm_delete(ix, sp, items)
153 register int ix;
154 register int sp;
155 register int items;
156 {
157     if (items < 2 || items > 2) {
158         fatal("Usage: ODBM_File::delete(db, key)");
159     }
160     {
161         ODBM_File       db;
162         datum   key;
163         int     RETVAL;
164
165         if (sv_isa(ST(1), "ODBM_File"))
166             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
167         else
168             fatal("db is not of type ODBM_File");
169
170         key.dptr = SvPV(ST(2), key.dsize);;
171
172         RETVAL = odbm_delete(db, key);
173         ST(0) = sv_mortalcopy(&sv_undef);
174         sv_setiv(ST(0), (I32)RETVAL);
175     }
176     return sp;
177 }
178
179 static int
180 XS_ODBM_File_odbm_firstkey(ix, sp, items)
181 register int ix;
182 register int sp;
183 register int items;
184 {
185     if (items < 1 || items > 1) {
186         fatal("Usage: ODBM_File::firstkey(db)");
187     }
188     {
189         ODBM_File       db;
190         datum   RETVAL;
191
192         if (sv_isa(ST(1), "ODBM_File"))
193             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
194         else
195             fatal("db is not of type ODBM_File");
196
197         RETVAL = odbm_firstkey(db);
198         ST(0) = sv_mortalcopy(&sv_undef);
199         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
200     }
201     return sp;
202 }
203
204 static int
205 XS_ODBM_File_odbm_nextkey(ix, sp, items)
206 register int ix;
207 register int sp;
208 register int items;
209 {
210     if (items < 2 || items > 2) {
211         fatal("Usage: ODBM_File::nextkey(db, key)");
212     }
213     {
214         ODBM_File       db;
215         datum   key;
216         datum   RETVAL;
217
218         if (sv_isa(ST(1), "ODBM_File"))
219             db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
220         else
221             fatal("db is not of type ODBM_File");
222
223         key.dptr = SvPV(ST(2), key.dsize);;
224
225         RETVAL = odbm_nextkey(db, key);
226         ST(0) = sv_mortalcopy(&sv_undef);
227         sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
228     }
229     return sp;
230 }
231
232 int init_ODBM_File(ix,sp,items)
233 int ix;
234 int sp;
235 int items;
236 {
237     char* file = __FILE__;
238
239     newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file);
240     newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file);
241     newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file);
242     newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file);
243     newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file);
244     newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file);
245     newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file);
246 }