This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3504ff64fdb7a40d580d7fe968153d117d58d3d5
[perl5.git] / ext / ODBM_File / ODBM_File.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #ifdef I_DBM
6 #  include <dbm.h>
7 #else
8 #  ifdef I_RPCSVC_DBM
9 #    include <rpcsvc/dbm.h>
10 #  endif
11 #endif
12
13 #ifndef HAS_DBMINIT_PROTO
14 int     dbminit(char* filename);
15 int     dbmclose(void);
16 datum   fetch(datum key);
17 int     store(datum key, datum dat);
18 #  ifdef __cplusplus
19 int     odelete(datum key);     /* Cannot be delete() for C++. */
20 #  else
21 int     delete(datum key); 
22 #  endif
23 datum   firstkey(void);
24 datum   nextkey(datum key);
25 #endif
26
27 #ifdef DBM_BUG_DUPLICATE_FREE 
28 /*
29  * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
30  * resulting in duplicate free() because dbmclose() does *not*
31  * check if it has already been called for this DBM.
32  * If some malloc/free calls have been done between dbmclose() and
33  * the next dbminit(), the memory might be used for something else when
34  * it is freed.
35  * Verified to work on ultrix4.3.  Probably will work on HP/UX.
36  * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
37  */
38 /* Close the previous dbm, and fail to open a new dbm */
39 #define dbmclose()      ((void) dbminit("/non/exist/ent"))
40 #endif
41
42 #include <fcntl.h>
43
44 typedef struct {
45         void *  dbp ;
46         SV *    filter_fetch_key ;
47         SV *    filter_store_key ;
48         SV *    filter_fetch_value ;
49         SV *    filter_store_value ;
50         int     filtering ;
51         } ODBM_File_type;
52
53 typedef ODBM_File_type * ODBM_File ;
54 typedef datum datum_key ;
55 typedef datum datum_key_copy ;
56 typedef datum datum_value ;
57
58 #define odbm_FETCH(db,key)                      fetch(key)
59 #define odbm_STORE(db,key,value,flags)          store(key,value)
60 #ifdef __cplusplus
61 #  define odbm_DELETE(db,key)                   odelete(key)
62 #else
63 #  define odbm_DELETE(db,key)                   delete(key)
64 #endif
65 #define odbm_FIRSTKEY(db)                       firstkey()
66 #define odbm_NEXTKEY(db,key)                    nextkey(key)
67
68 #define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
69
70 typedef struct {
71     int         x_dbmrefcnt;
72 } my_cxt_t;
73
74 START_MY_CXT
75
76 #define dbmrefcnt       (MY_CXT.x_dbmrefcnt)
77
78 #ifndef DBM_REPLACE
79 #define DBM_REPLACE 0
80 #endif
81
82 MODULE = ODBM_File      PACKAGE = ODBM_File     PREFIX = odbm_
83
84 BOOT:
85 {
86     MY_CXT_INIT;
87 }
88
89 ODBM_File
90 odbm_TIEHASH(dbtype, filename, flags, mode)
91         char *          dbtype
92         char *          filename
93         int             flags
94         int             mode
95         CODE:
96         {
97             char *tmpbuf;
98             void * dbp ;
99             dMY_CXT;
100
101             if (dbmrefcnt++)
102                 croak("Old dbm can only open one database");
103             Newx(tmpbuf, strlen(filename) + 5, char);
104             SAVEFREEPV(tmpbuf);
105             sprintf(tmpbuf,"%s.dir",filename);
106             if (stat(tmpbuf, &PL_statbuf) < 0) {
107                 if (flags & O_CREAT) {
108                     if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
109                         croak("ODBM_File: Can't create %s", filename);
110                     sprintf(tmpbuf,"%s.pag",filename);
111                     if (close(creat(tmpbuf,mode)) < 0)
112                         croak("ODBM_File: Can't create %s", filename);
113                 }
114                 else
115                     croak("ODBM_FILE: Can't open %s", filename);
116             }
117             dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
118             RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
119             Zero(RETVAL, 1, ODBM_File_type) ;
120             RETVAL->dbp = dbp ;
121             ST(0) = sv_mortalcopy(&PL_sv_undef);
122             sv_setptrobj(ST(0), RETVAL, dbtype);
123         }
124
125 void
126 DESTROY(db)
127         ODBM_File       db
128         PREINIT:
129         dMY_CXT;
130         CODE:
131         dbmrefcnt--;
132         dbmclose();
133         safefree(db);
134
135 datum_value
136 odbm_FETCH(db, key)
137         ODBM_File       db
138         datum_key_copy  key
139
140 int
141 odbm_STORE(db, key, value, flags = DBM_REPLACE)
142         ODBM_File       db
143         datum_key       key
144         datum_value     value
145         int             flags
146     CLEANUP:
147         if (RETVAL) {
148             if (RETVAL < 0 && errno == EPERM)
149                 croak("No write permission to odbm file");
150             croak("odbm store returned %d, errno %d, key \"%s\"",
151                         RETVAL,errno,key.dptr);
152         }
153
154 int
155 odbm_DELETE(db, key)
156         ODBM_File       db
157         datum_key       key
158
159 datum_key
160 odbm_FIRSTKEY(db)
161         ODBM_File       db
162
163 datum_key
164 odbm_NEXTKEY(db, key)
165         ODBM_File       db
166         datum_key       key
167
168
169 #define setFilter(type)                                 \
170         {                                               \
171             if (db->type)                               \
172                 RETVAL = sv_mortalcopy(db->type) ;      \
173             ST(0) = RETVAL ;                            \
174             if (db->type && (code == &PL_sv_undef)) {   \
175                 SvREFCNT_dec(db->type) ;                \
176                 db->type = Nullsv ;                     \
177             }                                           \
178             else if (code) {                            \
179                 if (db->type)                           \
180                     sv_setsv(db->type, code) ;          \
181                 else                                    \
182                     db->type = newSVsv(code) ;          \
183             }                                           \
184         }
185
186
187
188 SV *
189 filter_fetch_key(db, code)
190         ODBM_File       db
191         SV *            code
192         SV *            RETVAL = &PL_sv_undef ;
193         CODE:
194             DBM_setFilter(db->filter_fetch_key, code) ;
195
196 SV *
197 filter_store_key(db, code)
198         ODBM_File       db
199         SV *            code
200         SV *            RETVAL =  &PL_sv_undef ;
201         CODE:
202             DBM_setFilter(db->filter_store_key, code) ;
203
204 SV *
205 filter_fetch_value(db, code)
206         ODBM_File       db
207         SV *            code
208         SV *            RETVAL =  &PL_sv_undef ;
209         CODE:
210             DBM_setFilter(db->filter_fetch_value, code) ;
211
212 SV *
213 filter_store_value(db, code)
214         ODBM_File       db
215         SV *            code
216         SV *            RETVAL =  &PL_sv_undef ;
217         CODE:
218             DBM_setFilter(db->filter_store_value, code) ;
219