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