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