1 #define PERL_NO_GET_CONTEXT
9 SV * filter_fetch_key ;
10 SV * filter_store_key ;
11 SV * filter_fetch_value ;
12 SV * filter_store_value ;
16 typedef SDBM_File_type * SDBM_File ;
17 typedef datum datum_key ;
18 typedef datum datum_value ;
20 #define ckFilter(arg,type,name) \
23 /* printf("filtering %s\n", name) ;*/ \
25 croak("recursion detected in %s", name) ; \
26 db->filtering = TRUE ; \
27 save_defsv = newSVsv(DEFSV) ; \
28 sv_setsv(DEFSV, arg) ; \
30 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
31 sv_setsv(arg, DEFSV) ; \
32 sv_setsv(DEFSV, save_defsv) ; \
33 SvREFCNT_dec(save_defsv) ; \
34 db->filtering = FALSE ; \
35 /*printf("end of filtering %s\n", name) ;*/ \
38 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
39 #define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
40 #define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
41 #define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
42 #define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
43 #define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
44 #define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
47 MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
50 sdbm_TIEHASH(dbtype, filename, flags, mode)
60 if ((dbp = sdbm_open(filename,flags,mode))) {
61 RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
62 Zero(RETVAL, 1, SDBM_File_type) ;
75 if (db->filter_fetch_key)
76 SvREFCNT_dec(db->filter_fetch_key) ;
77 if (db->filter_store_key)
78 SvREFCNT_dec(db->filter_store_key) ;
79 if (db->filter_fetch_value)
80 SvREFCNT_dec(db->filter_fetch_value) ;
81 if (db->filter_store_value)
82 SvREFCNT_dec(db->filter_store_value) ;
91 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
98 if (RETVAL < 0 && errno == EPERM)
99 croak("No write permission to sdbm file");
100 croak("sdbm store returned %d, errno %d, key \"%s\"",
101 RETVAL,errno,key.dptr);
102 sdbm_clearerr(db->dbp);
120 sdbm_NEXTKEY(db, key)
122 datum_key key = key; /* never used - silence picky compilers. */
128 RETVAL = sdbm_error(db->dbp) ;
136 RETVAL = sdbm_clearerr(db->dbp) ;
141 #define setFilter(type) \
144 RETVAL = sv_mortalcopy(db->type) ; \
146 if (db->type && (code == &PL_sv_undef)) { \
147 SvREFCNT_dec(db->type) ; \
152 sv_setsv(db->type, code) ; \
154 db->type = newSVsv(code) ; \
161 filter_fetch_key(db, code)
164 SV * RETVAL = &PL_sv_undef ;
166 setFilter(filter_fetch_key) ;
169 filter_store_key(db, code)
172 SV * RETVAL = &PL_sv_undef ;
174 setFilter(filter_store_key) ;
177 filter_fetch_value(db, code)
180 SV * RETVAL = &PL_sv_undef ;
182 setFilter(filter_fetch_value) ;
185 filter_store_value(db, code)
188 SV * RETVAL = &PL_sv_undef ;
190 setFilter(filter_store_value) ;