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