1 #define PERL_NO_GET_CONTEXT 2 3 #include "EXTERN.h" 4 #include "perl.h" 5 #include "XSUB.h" 6 7 #ifdef I_DBM 8 # include <dbm.h> 9 #else 10 # ifdef I_RPCSVC_DBM 11 # include <rpcsvc/dbm.h> 12 # endif 13 #endif 14 15 #ifndef HAS_DBMINIT_PROTO 16 int dbminit(char* filename); 17 int dbmclose(void); 18 datum fetch(datum key); 19 int store(datum key, datum dat); 20 int delete(datum key); 21 datum firstkey(void); 22 datum nextkey(datum key); 23 #endif 24 25 #ifdef DBM_BUG_DUPLICATE_FREE 26 /* 27 * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(), 28 * resulting in duplicate free() because dbmclose() does *not* 29 * check if it has already been called for this DBM. 30 * If some malloc/free calls have been done between dbmclose() and 31 * the next dbminit(), the memory might be used for something else when 32 * it is freed. 33 * Verified to work on ultrix4.3. Probably will work on HP/UX. 34 * Set DBM_BUG_DUPLICATE_FREE in the extension hint file. 35 */ 36 /* Close the previous dbm, and fail to open a new dbm */ 37 #define dbmclose() ((void) dbminit("/non/exist/ent")) 38 #endif 39 40 #include <fcntl.h> 41 42 #define fetch_key 0 43 #define store_key 1 44 #define fetch_value 2 45 #define store_value 3 46 47 typedef struct { 48 void * dbp ; 49 SV * filter[4]; 50 int filtering ; 51 } ODBM_File_type; 52 53 typedef ODBM_File_type * ODBM_File ; 54 typedef datum datum_key ; 55 typedef datum datum_key_copy ; 56 typedef datum datum_value ; 57 58 #define odbm_FETCH(db,key) fetch(key) 59 #define odbm_STORE(db,key,value,flags) store(key,value) 60 #define odbm_DELETE(db,key) delete(key) 61 #define odbm_FIRSTKEY(db) firstkey() 62 #define odbm_NEXTKEY(db,key) nextkey(key) 63 64 #define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION 65 66 typedef struct { 67 int x_dbmrefcnt; 68 } my_cxt_t; 69 70 START_MY_CXT 71 72 #define dbmrefcnt (MY_CXT.x_dbmrefcnt) 73 74 #ifndef DBM_REPLACE 75 #define DBM_REPLACE 0 76 #endif 77 78 MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ 79 80 BOOT: 81 { 82 MY_CXT_INIT; 83 } 84 85 ODBM_File 86 odbm_TIEHASH(dbtype, filename, flags, mode) 87 char * dbtype 88 char * filename 89 int flags 90 int mode 91 CODE: 92 { 93 char *tmpbuf; 94 void * dbp ; 95 dMY_CXT; 96 97 if (dbmrefcnt++) 98 croak("Old dbm can only open one database"); 99 Newx(tmpbuf, strlen(filename) + 5, char); 100 SAVEFREEPV(tmpbuf); 101 sprintf(tmpbuf,"%s.dir",filename); 102 if (stat(tmpbuf, &PL_statbuf) < 0) { 103 if (flags & O_CREAT) { 104 if (mode < 0 || close(creat(tmpbuf,mode)) < 0) 105 croak("ODBM_File: Can't create %s", filename); 106 sprintf(tmpbuf,"%s.pag",filename); 107 if (close(creat(tmpbuf,mode)) < 0) 108 croak("ODBM_File: Can't create %s", filename); 109 } 110 else 111 croak("ODBM_FILE: Can't open %s", filename); 112 } 113 dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); 114 RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type)); 115 RETVAL->dbp = dbp ; 116 } 117 OUTPUT: 118 RETVAL 119 120 void 121 DESTROY(db) 122 ODBM_File db 123 PREINIT: 124 dMY_CXT; 125 int i = store_value; 126 CODE: 127 dbmrefcnt--; 128 dbmclose(); 129 do { 130 if (db->filter[i]) 131 SvREFCNT_dec(db->filter[i]); 132 } while (i-- > 0); 133 safefree(db); 134 135 datum_value 136 odbm_FETCH(db, key) 137 ODBM_File db 138 datum_key_copy key 139 140 int 141 odbm_STORE(db, key, value, flags = DBM_REPLACE) 142 ODBM_File db 143 datum_key key 144 datum_value value 145 int flags 146 CLEANUP: 147 if (RETVAL) { 148 if (RETVAL < 0 && errno == EPERM) 149 croak("No write permission to odbm file"); 150 croak("odbm store returned %d, errno %d, key \"%s\"", 151 RETVAL,errno,key.dptr); 152 } 153 154 int 155 odbm_DELETE(db, key) 156 ODBM_File db 157 datum_key key 158 159 datum_key 160 odbm_FIRSTKEY(db) 161 ODBM_File db 162 163 datum_key 164 odbm_NEXTKEY(db, key) 165 ODBM_File db 166 datum_key key 167 168 169 #define setFilter(type) \ 170 { \ 171 if (db->type) \ 172 RETVAL = sv_mortalcopy(db->type) ; \ 173 ST(0) = RETVAL ; \ 174 if (db->type && (code == &PL_sv_undef)) { \ 175 SvREFCNT_dec(db->type) ; \ 176 db->type = Nullsv ; \ 177 } \ 178 else if (code) { \ 179 if (db->type) \ 180 sv_setsv(db->type, code) ; \ 181 else \ 182 db->type = newSVsv(code) ; \ 183 } \ 184 } 185 186 187 188 SV * 189 filter_fetch_key(db, code) 190 ODBM_File db 191 SV * code 192 SV * RETVAL = &PL_sv_undef ; 193 ALIAS: 194 ODBM_File::filter_fetch_key = fetch_key 195 ODBM_File::filter_store_key = store_key 196 ODBM_File::filter_fetch_value = fetch_value 197 ODBM_File::filter_store_value = store_value 198 CODE: 199 DBM_setFilter(db->filter[ix], code); 200