1 #define PERL_NO_GET_CONTEXT 2 3 #include "EXTERN.h" 4 #include "perl.h" 5 #include "XSUB.h" 6 7 #include <gdbm.h> 8 #include <fcntl.h> 9 10 #define fetch_key 0 11 #define store_key 1 12 #define fetch_value 2 13 #define store_value 3 14 15 typedef struct { 16 GDBM_FILE dbp ; 17 SV * filter[4]; 18 int filtering ; 19 } GDBM_File_type; 20 21 typedef GDBM_File_type * GDBM_File ; 22 typedef datum datum_key ; 23 typedef datum datum_value ; 24 typedef datum datum_key_copy; 25 26 #define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ 27 28 typedef void (*FATALFUNC)(); 29 30 #ifndef GDBM_FAST 31 static int 32 not_here(char *s) 33 { 34 croak("GDBM_File::%s not implemented on this architecture", s); 35 return -1; 36 } 37 #endif 38 39 /* GDBM allocates the datum with system malloc() and expects the user 40 * to free() it. So we either have to free() it immediately, or have 41 * perl free() it when it deallocates the SV, depending on whether 42 * perl uses malloc()/free() or not. */ 43 static void 44 output_datum(pTHX_ SV *arg, char *str, int size) 45 { 46 sv_setpvn(arg, str, size); 47 # undef free 48 free(str); 49 } 50 51 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync, 52 gdbm_exists, and gdbm_setopt functions. Apparently Slackware 53 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). 54 */ 55 #ifndef GDBM_FAST 56 #define gdbm_exists(db,key) not_here("gdbm_exists") 57 #define gdbm_sync(db) (void) not_here("gdbm_sync") 58 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") 59 #endif 60 61 #include "const-c.inc" 62 63 MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ 64 65 INCLUDE: const-xs.inc 66 67 GDBM_File 68 gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) 69 char * dbtype 70 char * name 71 int read_write 72 int mode 73 FATALFUNC fatal_func 74 CODE: 75 { 76 GDBM_FILE dbp ; 77 78 RETVAL = NULL ; 79 if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { 80 RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ; 81 RETVAL->dbp = dbp ; 82 } 83 84 } 85 OUTPUT: 86 RETVAL 87 88 89 #define gdbm_close(db) gdbm_close(db->dbp) 90 void 91 gdbm_close(db) 92 GDBM_File db 93 CLEANUP: 94 95 void 96 gdbm_DESTROY(db) 97 GDBM_File db 98 PREINIT: 99 int i = store_value; 100 CODE: 101 gdbm_close(db); 102 do { 103 if (db->filter[i]) 104 SvREFCNT_dec(db->filter[i]); 105 } while (i-- > 0); 106 safefree(db); 107 108 #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) 109 datum_value 110 gdbm_FETCH(db, key) 111 GDBM_File db 112 datum_key_copy key 113 114 #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) 115 int 116 gdbm_STORE(db, key, value, flags = GDBM_REPLACE) 117 GDBM_File db 118 datum_key key 119 datum_value value 120 int flags 121 CLEANUP: 122 if (RETVAL) { 123 if (RETVAL < 0 && errno == EPERM) 124 croak("No write permission to gdbm file"); 125 croak("gdbm store returned %d, errno %d, key \"%.*s\"", 126 RETVAL,errno,key.dsize,key.dptr); 127 } 128 129 #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) 130 int 131 gdbm_DELETE(db, key) 132 GDBM_File db 133 datum_key key 134 135 #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) 136 datum_key 137 gdbm_FIRSTKEY(db) 138 GDBM_File db 139 140 #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) 141 datum_key 142 gdbm_NEXTKEY(db, key) 143 GDBM_File db 144 datum_key key 145 146 #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) 147 int 148 gdbm_reorganize(db) 149 GDBM_File db 150 151 152 #define gdbm_sync(db) gdbm_sync(db->dbp) 153 void 154 gdbm_sync(db) 155 GDBM_File db 156 157 #define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) 158 int 159 gdbm_EXISTS(db, key) 160 GDBM_File db 161 datum_key key 162 163 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) 164 int 165 gdbm_setopt (db, optflag, optval, optlen) 166 GDBM_File db 167 int optflag 168 int &optval 169 int optlen 170 171 172 SV * 173 filter_fetch_key(db, code) 174 GDBM_File db 175 SV * code 176 SV * RETVAL = &PL_sv_undef ; 177 ALIAS: 178 GDBM_File::filter_fetch_key = fetch_key 179 GDBM_File::filter_store_key = store_key 180 GDBM_File::filter_fetch_value = fetch_value 181 GDBM_File::filter_store_value = store_value 182 CODE: 183 DBM_setFilter(db->filter[ix], code); 184