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 21 #define ckFilter(arg,type,name) \ 22 if (db->type) { \ 23 SV * save_defsv ; \ 24 /* printf("filtering %s\n", name) ;*/ \ 25 if (db->filtering) \ 26 croak("recursion detected in %s", name) ; \ 27 db->filtering = TRUE ; \ 28 save_defsv = newSVsv(DEFSV) ; \ 29 sv_setsv(DEFSV, arg) ; \ 30 PUSHMARK(sp) ; \ 31 (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) ; \ 35 db->filtering = FALSE ; \ 36 /*printf("end of filtering %s\n", name) ;*/ \ 37 } 38 39 40 41 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ 42 43 typedef void (*FATALFUNC)(); 44 45 #ifndef GDBM_FAST 46 static int 47 not_here(char *s) 48 { 49 croak("GDBM_File::%s not implemented on this architecture", s); 50 return -1; 51 } 52 #endif 53 54 /* GDBM allocates the datum with system malloc() and expects the user 55 * to free() it. So we either have to free() it immediately, or have 56 * perl free() it when it deallocates the SV, depending on whether 57 * perl uses malloc()/free() or not. */ 58 static void 59 output_datum(pTHX_ SV *arg, char *str, int size) 60 { 61 #if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC) && !defined(LEAKTEST)) 62 sv_usepvn(arg, str, size); 63 #else 64 sv_setpvn(arg, str, size); 65 safesysfree(str); 66 #endif 67 } 68 69 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync, 70 gdbm_exists, and gdbm_setopt functions. Apparently Slackware 71 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). 72 */ 73 #ifndef GDBM_FAST 74 #define gdbm_exists(db,key) not_here("gdbm_exists") 75 #define gdbm_sync(db) (void) not_here("gdbm_sync") 76 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") 77 #endif 78 79 static double 80 constant(char *name, int arg) 81 { 82 errno = 0; 83 switch (*name) { 84 case 'A': 85 break; 86 case 'B': 87 break; 88 case 'C': 89 break; 90 case 'D': 91 break; 92 case 'E': 93 break; 94 case 'F': 95 break; 96 case 'G': 97 if (strEQ(name, "GDBM_CACHESIZE")) 98 #ifdef GDBM_CACHESIZE 99 return GDBM_CACHESIZE; 100 #else 101 goto not_there; 102 #endif 103 if (strEQ(name, "GDBM_FAST")) 104 #ifdef GDBM_FAST 105 return GDBM_FAST; 106 #else 107 goto not_there; 108 #endif 109 if (strEQ(name, "GDBM_FASTMODE")) 110 #ifdef GDBM_FASTMODE 111 return GDBM_FASTMODE; 112 #else 113 goto not_there; 114 #endif 115 if (strEQ(name, "GDBM_INSERT")) 116 #ifdef GDBM_INSERT 117 return GDBM_INSERT; 118 #else 119 goto not_there; 120 #endif 121 if (strEQ(name, "GDBM_NEWDB")) 122 #ifdef GDBM_NEWDB 123 return GDBM_NEWDB; 124 #else 125 goto not_there; 126 #endif 127 if (strEQ(name, "GDBM_NOLOCK")) 128 #ifdef GDBM_NOLOCK 129 return GDBM_NOLOCK; 130 #else 131 goto not_there; 132 #endif 133 if (strEQ(name, "GDBM_READER")) 134 #ifdef GDBM_READER 135 return GDBM_READER; 136 #else 137 goto not_there; 138 #endif 139 if (strEQ(name, "GDBM_REPLACE")) 140 #ifdef GDBM_REPLACE 141 return GDBM_REPLACE; 142 #else 143 goto not_there; 144 #endif 145 if (strEQ(name, "GDBM_WRCREAT")) 146 #ifdef GDBM_WRCREAT 147 return GDBM_WRCREAT; 148 #else 149 goto not_there; 150 #endif 151 if (strEQ(name, "GDBM_WRITER")) 152 #ifdef GDBM_WRITER 153 return GDBM_WRITER; 154 #else 155 goto not_there; 156 #endif 157 break; 158 case 'H': 159 break; 160 case 'I': 161 break; 162 case 'J': 163 break; 164 case 'K': 165 break; 166 case 'L': 167 break; 168 case 'M': 169 break; 170 case 'N': 171 break; 172 case 'O': 173 break; 174 case 'P': 175 break; 176 case 'Q': 177 break; 178 case 'R': 179 break; 180 case 'S': 181 break; 182 case 'T': 183 break; 184 case 'U': 185 break; 186 case 'V': 187 break; 188 case 'W': 189 break; 190 case 'X': 191 break; 192 case 'Y': 193 break; 194 case 'Z': 195 break; 196 } 197 errno = EINVAL; 198 return 0; 199 200 not_there: 201 errno = ENOENT; 202 return 0; 203 } 204 205 MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ 206 207 double 208 constant(name,arg) 209 char * name 210 int arg 211 212 213 GDBM_File 214 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) 215 char * dbtype 216 char * name 217 int read_write 218 int mode 219 FATALFUNC fatal_func 220 CODE: 221 { 222 GDBM_FILE dbp ; 223 224 RETVAL = NULL ; 225 if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { 226 RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ; 227 Zero(RETVAL, 1, GDBM_File_type) ; 228 RETVAL->dbp = dbp ; 229 } 230 231 } 232 OUTPUT: 233 RETVAL 234 235 236 #define gdbm_close(db) gdbm_close(db->dbp) 237 void 238 gdbm_close(db) 239 GDBM_File db 240 CLEANUP: 241 242 void 243 gdbm_DESTROY(db) 244 GDBM_File db 245 CODE: 246 gdbm_close(db); 247 safefree(db); 248 249 #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) 250 datum_value 251 gdbm_FETCH(db, key) 252 GDBM_File db 253 datum_key key 254 255 #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) 256 int 257 gdbm_STORE(db, key, value, flags = GDBM_REPLACE) 258 GDBM_File db 259 datum_key key 260 datum_value value 261 int flags 262 CLEANUP: 263 if (RETVAL) { 264 if (RETVAL < 0 && errno == EPERM) 265 croak("No write permission to gdbm file"); 266 croak("gdbm store returned %d, errno %d, key \"%.*s\"", 267 RETVAL,errno,key.dsize,key.dptr); 268 } 269 270 #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) 271 int 272 gdbm_DELETE(db, key) 273 GDBM_File db 274 datum_key key 275 276 #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) 277 datum_key 278 gdbm_FIRSTKEY(db) 279 GDBM_File db 280 281 #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) 282 datum_key 283 gdbm_NEXTKEY(db, key) 284 GDBM_File db 285 datum_key key 286 287 #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) 288 int 289 gdbm_reorganize(db) 290 GDBM_File db 291 292 293 #define gdbm_sync(db) gdbm_sync(db->dbp) 294 void 295 gdbm_sync(db) 296 GDBM_File db 297 298 #define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) 299 int 300 gdbm_EXISTS(db, key) 301 GDBM_File db 302 datum_key key 303 304 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) 305 int 306 gdbm_setopt (db, optflag, optval, optlen) 307 GDBM_File db 308 int optflag 309 int &optval 310 int optlen 311 312 313 #define setFilter(type) \ 314 { \ 315 if (db->type) \ 316 RETVAL = sv_mortalcopy(db->type) ; \ 317 ST(0) = RETVAL ; \ 318 if (db->type && (code == &PL_sv_undef)) { \ 319 SvREFCNT_dec(db->type) ; \ 320 db->type = NULL ; \ 321 } \ 322 else if (code) { \ 323 if (db->type) \ 324 sv_setsv(db->type, code) ; \ 325 else \ 326 db->type = newSVsv(code) ; \ 327 } \ 328 } 329 330 331 332 SV * 333 filter_fetch_key(db, code) 334 GDBM_File db 335 SV * code 336 SV * RETVAL = &PL_sv_undef ; 337 CODE: 338 setFilter(filter_fetch_key) ; 339 340 SV * 341 filter_store_key(db, code) 342 GDBM_File db 343 SV * code 344 SV * RETVAL = &PL_sv_undef ; 345 CODE: 346 setFilter(filter_store_key) ; 347 348 SV * 349 filter_fetch_value(db, code) 350 GDBM_File db 351 SV * code 352 SV * RETVAL = &PL_sv_undef ; 353 CODE: 354 setFilter(filter_fetch_value) ; 355 356 SV * 357 filter_store_value(db, code) 358 GDBM_File db 359 SV * code 360 SV * RETVAL = &PL_sv_undef ; 361 CODE: 362 setFilter(filter_store_value) ; 363 364