8 SV * filter_fetch_key ;
9 SV * filter_store_key ;
10 SV * filter_fetch_value ;
11 SV * filter_store_value ;
15 typedef SDBM_File_type * SDBM_File ;
16 typedef datum datum_key ;
17 typedef datum datum_value ;
19 #define ckFilter(arg,type,name) \
22 /* printf("filtering %s\n", name) ;*/ \
24 croak("recursion detected in %s", name) ; \
25 db->filtering = TRUE ; \
26 /* SAVE_DEFSV ;*/ /* save $_ */ \
27 save_defsv = newSVsv(DEFSV) ; \
28 sv_setsv(DEFSV, arg) ; \
30 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
32 sv_setsv(arg, DEFSV) ; \
33 sv_setsv(DEFSV, save_defsv) ; \
34 SvREFCNT_dec(save_defsv) ; \
36 db->filtering = FALSE ; \
37 /*printf("end of filtering %s\n", name) ;*/ \
40 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
41 #define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
42 #define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
43 #define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
44 #define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
45 #define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
46 #define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
49 MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
52 sdbm_TIEHASH(dbtype, filename, flags, mode)
62 if (dbp = sdbm_open(filename,flags,mode) ) {
63 RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
64 Zero(RETVAL, 1, SDBM_File_type) ;
77 if (db->filter_fetch_key)
78 SvREFCNT_dec(db->filter_fetch_key) ;
79 if (db->filter_store_key)
80 SvREFCNT_dec(db->filter_store_key) ;
81 if (db->filter_fetch_value)
82 SvREFCNT_dec(db->filter_fetch_value) ;
83 if (db->filter_store_value)
84 SvREFCNT_dec(db->filter_store_value) ;
93 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
100 if (RETVAL < 0 && errno == EPERM)
101 croak("No write permission to sdbm file");
102 croak("sdbm store returned %d, errno %d, key \"%s\"",
103 RETVAL,errno,key.dptr);
104 sdbm_clearerr(db->dbp);
122 sdbm_NEXTKEY(db, key)
130 RETVAL = sdbm_error(db->dbp) ;
138 RETVAL = sdbm_clearerr(db->dbp) ;
143 #define setFilter(type) \
146 RETVAL = newSVsv(db->type) ; \
147 if (db->type && (code == &PL_sv_undef)) { \
148 SvREFCNT_dec(db->type) ; \
153 sv_setsv(db->type, code) ; \
155 db->type = newSVsv(code) ; \
162 filter_fetch_key(db, code)
165 SV * RETVAL = &PL_sv_undef ;
167 setFilter(filter_fetch_key) ;
172 filter_store_key(db, code)
175 SV * RETVAL = &PL_sv_undef ;
177 setFilter(filter_store_key) ;
182 filter_fetch_value(db, code)
185 SV * RETVAL = &PL_sv_undef ;
187 setFilter(filter_fetch_value) ;
192 filter_store_value(db, code)
195 SV * RETVAL = &PL_sv_undef ;
197 setFilter(filter_store_value) ;