1 #define PERL_NO_GET_CONTEXT 2 #include "EXTERN.h" 3 #include "perl.h" 4 #include "XSUB.h" 5 #include "sdbm/sdbm.h" 6 7 typedef struct { 8 DBM * dbp ; 9 SV * filter_fetch_key ; 10 SV * filter_store_key ; 11 SV * filter_fetch_value ; 12 SV * filter_store_value ; 13 int filtering ; 14 } SDBM_File_type; 15 16 typedef SDBM_File_type * SDBM_File ; 17 typedef datum datum_key ; 18 typedef datum datum_value ; 19 20 #define ckFilter(arg,type,name) \ 21 if (db->type) { \ 22 SV * save_defsv ; \ 23 /* printf("filtering %s\n", name) ;*/ \ 24 if (db->filtering) \ 25 croak("recursion detected in %s", name) ; \ 26 db->filtering = TRUE ; \ 27 save_defsv = newSVsv(DEFSV) ; \ 28 sv_setsv(DEFSV, arg) ; \ 29 PUSHMARK(sp) ; \ 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) ;*/ \ 36 } 37 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) 45 46 47 MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ 48 49 SDBM_File 50 sdbm_TIEHASH(dbtype, filename, flags, mode) 51 char * dbtype 52 char * filename 53 int flags 54 int mode 55 CODE: 56 { 57 DBM * dbp ; 58 59 RETVAL = NULL ; 60 if ((dbp = sdbm_open(filename,flags,mode))) { 61 RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ; 62 Zero(RETVAL, 1, SDBM_File_type) ; 63 RETVAL->dbp = dbp ; 64 } 65 66 } 67 OUTPUT: 68 RETVAL 69 70 void 71 sdbm_DESTROY(db) 72 SDBM_File db 73 CODE: 74 sdbm_close(db->dbp); 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) ; 83 safefree(db) ; 84 85 datum_value 86 sdbm_FETCH(db, key) 87 SDBM_File db 88 datum_key key 89 90 int 91 sdbm_STORE(db, key, value, flags = DBM_REPLACE) 92 SDBM_File db 93 datum_key key 94 datum_value value 95 int flags 96 CLEANUP: 97 if (RETVAL) { 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); 103 } 104 105 int 106 sdbm_DELETE(db, key) 107 SDBM_File db 108 datum_key key 109 110 int 111 sdbm_EXISTS(db,key) 112 SDBM_File db 113 datum_key key 114 115 datum_key 116 sdbm_FIRSTKEY(db) 117 SDBM_File db 118 119 datum_key 120 sdbm_NEXTKEY(db, key) 121 SDBM_File db 122 datum_key key = key; /* never used - silence picky compilers. */ 123 124 int 125 sdbm_error(db) 126 SDBM_File db 127 CODE: 128 RETVAL = sdbm_error(db->dbp) ; 129 OUTPUT: 130 RETVAL 131 132 int 133 sdbm_clearerr(db) 134 SDBM_File db 135 CODE: 136 RETVAL = sdbm_clearerr(db->dbp) ; 137 OUTPUT: 138 RETVAL 139 140 141 #define setFilter(type) \ 142 { \ 143 if (db->type) \ 144 RETVAL = sv_mortalcopy(db->type) ; \ 145 ST(0) = RETVAL ; \ 146 if (db->type && (code == &PL_sv_undef)) { \ 147 SvREFCNT_dec(db->type) ; \ 148 db->type = NULL ; \ 149 } \ 150 else if (code) { \ 151 if (db->type) \ 152 sv_setsv(db->type, code) ; \ 153 else \ 154 db->type = newSVsv(code) ; \ 155 } \ 156 } 157 158 159 160 SV * 161 filter_fetch_key(db, code) 162 SDBM_File db 163 SV * code 164 SV * RETVAL = &PL_sv_undef ; 165 CODE: 166 setFilter(filter_fetch_key) ; 167 168 SV * 169 filter_store_key(db, code) 170 SDBM_File db 171 SV * code 172 SV * RETVAL = &PL_sv_undef ; 173 CODE: 174 setFilter(filter_store_key) ; 175 176 SV * 177 filter_fetch_value(db, code) 178 SDBM_File db 179 SV * code 180 SV * RETVAL = &PL_sv_undef ; 181 CODE: 182 setFilter(filter_fetch_value) ; 183 184 SV * 185 filter_store_value(db, code) 186 SDBM_File db 187 SV * code 188 SV * RETVAL = &PL_sv_undef ; 189 CODE: 190 setFilter(filter_store_value) ; 191 192