1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 5 #include <gdbm.h> 6 #include <fcntl.h> 7 8 typedef struct { 9 GDBM_FILE dbp ; 10 SV * filter_fetch_key ; 11 SV * filter_store_key ; 12 SV * filter_fetch_value ; 13 SV * filter_store_value ; 14 int filtering ; 15 } GDBM_File_type; 16 17 typedef GDBM_File_type * GDBM_File ; 18 typedef datum datum_key ; 19 typedef datum datum_value ; 20 typedef datum datum_key_copy; 21 22 #define ckFilter(arg,type,name) \ 23 if (db->type) { \ 24 SV * save_defsv ; \ 25 /* printf("filtering %s\n", name) ;*/ \ 26 if (db->filtering) \ 27 croak("recursion detected in %s", name) ; \ 28 db->filtering = TRUE ; \ 29 save_defsv = newSVsv(DEFSV) ; \ 30 sv_setsv(DEFSV, arg) ; \ 31 PUSHMARK(sp) ; \ 32 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ 33 sv_setsv(arg, DEFSV) ; \ 34 sv_setsv(DEFSV, save_defsv) ; \ 35 SvREFCNT_dec(save_defsv) ; \ 36 db->filtering = FALSE ; \ 37 /*printf("end of filtering %s\n", name) ;*/ \ 38 } 39 40 41 42 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ 43 44 typedef void (*FATALFUNC)(); 45 46 #ifndef GDBM_FAST 47 static int 48 not_here(char *s) 49 { 50 croak("GDBM_File::%s not implemented on this architecture", s); 51 return -1; 52 } 53 #endif 54 55 /* GDBM allocates the datum with system malloc() and expects the user 56 * to free() it. So we either have to free() it immediately, or have 57 * perl free() it when it deallocates the SV, depending on whether 58 * perl uses malloc()/free() or not. */ 59 static void 60 output_datum(pTHX_ SV *arg, char *str, int size) 61 { 62 #if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC))) && !defined(LEAKTEST) 63 sv_usepvn(arg, str, size); 64 #else 65 sv_setpvn(arg, str, size); 66 safesysfree(str); 67 #endif 68 } 69 70 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync, 71 gdbm_exists, and gdbm_setopt functions. Apparently Slackware 72 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). 73 */ 74 #ifndef GDBM_FAST 75 #define gdbm_exists(db,key) not_here("gdbm_exists") 76 #define gdbm_sync(db) (void) not_here("gdbm_sync") 77 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") 78 #endif 79 80 #include "const-c.inc" 81 82 MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ 83 84 INCLUDE: const-xs.inc 85 86 GDBM_File 87 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) 88 char * dbtype 89 char * name 90 int read_write 91 int mode 92 FATALFUNC fatal_func 93 CODE: 94 { 95 GDBM_FILE dbp ; 96 97 RETVAL = NULL ; 98 if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { 99 RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ; 100 Zero(RETVAL, 1, GDBM_File_type) ; 101 RETVAL->dbp = dbp ; 102 } 103 104 } 105 OUTPUT: 106 RETVAL 107 108 109 #define gdbm_close(db) gdbm_close(db->dbp) 110 void 111 gdbm_close(db) 112 GDBM_File db 113 CLEANUP: 114 115 void 116 gdbm_DESTROY(db) 117 GDBM_File db 118 CODE: 119 gdbm_close(db); 120 safefree(db); 121 122 #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) 123 datum_value 124 gdbm_FETCH(db, key) 125 GDBM_File db 126 datum_key_copy key 127 128 #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) 129 int 130 gdbm_STORE(db, key, value, flags = GDBM_REPLACE) 131 GDBM_File db 132 datum_key key 133 datum_value value 134 int flags 135 CLEANUP: 136 if (RETVAL) { 137 if (RETVAL < 0 && errno == EPERM) 138 croak("No write permission to gdbm file"); 139 croak("gdbm store returned %d, errno %d, key \"%.*s\"", 140 RETVAL,errno,key.dsize,key.dptr); 141 } 142 143 #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) 144 int 145 gdbm_DELETE(db, key) 146 GDBM_File db 147 datum_key key 148 149 #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) 150 datum_key 151 gdbm_FIRSTKEY(db) 152 GDBM_File db 153 154 #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) 155 datum_key 156 gdbm_NEXTKEY(db, key) 157 GDBM_File db 158 datum_key key 159 160 #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) 161 int 162 gdbm_reorganize(db) 163 GDBM_File db 164 165 166 #define gdbm_sync(db) gdbm_sync(db->dbp) 167 void 168 gdbm_sync(db) 169 GDBM_File db 170 171 #define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) 172 int 173 gdbm_EXISTS(db, key) 174 GDBM_File db 175 datum_key key 176 177 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) 178 int 179 gdbm_setopt (db, optflag, optval, optlen) 180 GDBM_File db 181 int optflag 182 int &optval 183 int optlen 184 185 186 #define setFilter(type) \ 187 { \ 188 if (db->type) \ 189 RETVAL = sv_mortalcopy(db->type) ; \ 190 ST(0) = RETVAL ; \ 191 if (db->type && (code == &PL_sv_undef)) { \ 192 SvREFCNT_dec(db->type) ; \ 193 db->type = NULL ; \ 194 } \ 195 else if (code) { \ 196 if (db->type) \ 197 sv_setsv(db->type, code) ; \ 198 else \ 199 db->type = newSVsv(code) ; \ 200 } \ 201 } 202 203 204 205 SV * 206 filter_fetch_key(db, code) 207 GDBM_File db 208 SV * code 209 SV * RETVAL = &PL_sv_undef ; 210 CODE: 211 setFilter(filter_fetch_key) ; 212 213 SV * 214 filter_store_key(db, code) 215 GDBM_File db 216 SV * code 217 SV * RETVAL = &PL_sv_undef ; 218 CODE: 219 setFilter(filter_store_key) ; 220 221 SV * 222 filter_fetch_value(db, code) 223 GDBM_File db 224 SV * code 225 SV * RETVAL = &PL_sv_undef ; 226 CODE: 227 setFilter(filter_fetch_value) ; 228 229 SV * 230 filter_store_value(db, code) 231 GDBM_File db 232 SV * code 233 SV * RETVAL = &PL_sv_undef ; 234 CODE: 235 setFilter(filter_store_value) ; 236 237