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