1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 /* If using the DB3 emulation, ENTER is defined both 5 * by DB3 and Perl. We drop the Perl definition now. 6 * See also INSTALL section on DB3. 7 * -- Stanislav Brabec <utx@penguin.cz> */ 8 #undef ENTER 9 #include <ndbm.h> 10 11 typedef struct { 12 DBM * dbp ; 13 SV * filter_fetch_key ; 14 SV * filter_store_key ; 15 SV * filter_fetch_value ; 16 SV * filter_store_value ; 17 int filtering ; 18 } NDBM_File_type; 19 20 typedef NDBM_File_type * NDBM_File ; 21 typedef datum datum_key ; 22 typedef datum datum_value ; 23 24 #define ckFilter(arg,type,name) \ 25 if (db->type) { \ 26 SV * save_defsv ; \ 27 /* printf("filtering %s\n", name) ;*/ \ 28 if (db->filtering) \ 29 croak("recursion detected in %s", name) ; \ 30 db->filtering = TRUE ; \ 31 save_defsv = newSVsv(DEFSV) ; \ 32 sv_setsv(DEFSV, arg) ; \ 33 PUSHMARK(sp) ; \ 34 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ 35 sv_setsv(arg, DEFSV) ; \ 36 sv_setsv(DEFSV, save_defsv) ; \ 37 SvREFCNT_dec(save_defsv) ; \ 38 db->filtering = FALSE ; \ 39 /*printf("end of filtering %s\n", name) ;*/ \ 40 } 41 42 43 MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_ 44 45 NDBM_File 46 ndbm_TIEHASH(dbtype, filename, flags, mode) 47 char * dbtype 48 char * filename 49 int flags 50 int mode 51 CODE: 52 { 53 DBM * dbp ; 54 55 RETVAL = NULL ; 56 if ((dbp = dbm_open(filename, flags, mode))) { 57 RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ; 58 Zero(RETVAL, 1, NDBM_File_type) ; 59 RETVAL->dbp = dbp ; 60 } 61 62 } 63 OUTPUT: 64 RETVAL 65 66 void 67 ndbm_DESTROY(db) 68 NDBM_File db 69 CODE: 70 dbm_close(db->dbp); 71 safefree(db); 72 73 #define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) 74 datum_value 75 ndbm_FETCH(db, key) 76 NDBM_File db 77 datum_key key 78 79 #define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags) 80 int 81 ndbm_STORE(db, key, value, flags = DBM_REPLACE) 82 NDBM_File db 83 datum_key key 84 datum_value value 85 int flags 86 CLEANUP: 87 if (RETVAL) { 88 if (RETVAL < 0 && errno == EPERM) 89 croak("No write permission to ndbm file"); 90 croak("ndbm store returned %d, errno %d, key \"%s\"", 91 RETVAL,errno,key.dptr); 92 dbm_clearerr(db->dbp); 93 } 94 95 #define ndbm_DELETE(db,key) dbm_delete(db->dbp,key) 96 int 97 ndbm_DELETE(db, key) 98 NDBM_File db 99 datum_key key 100 101 #define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp) 102 datum_key 103 ndbm_FIRSTKEY(db) 104 NDBM_File db 105 106 #define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp) 107 datum_key 108 ndbm_NEXTKEY(db, key) 109 NDBM_File db 110 datum_key key = NO_INIT 111 112 #define ndbm_error(db) dbm_error(db->dbp) 113 int 114 ndbm_error(db) 115 NDBM_File db 116 117 #define ndbm_clearerr(db) dbm_clearerr(db->dbp) 118 void 119 ndbm_clearerr(db) 120 NDBM_File db 121 122 123 #define setFilter(type) \ 124 { \ 125 if (db->type) \ 126 RETVAL = sv_mortalcopy(db->type) ; \ 127 ST(0) = RETVAL ; \ 128 if (db->type && (code == &PL_sv_undef)) { \ 129 SvREFCNT_dec(db->type) ; \ 130 db->type = NULL ; \ 131 } \ 132 else if (code) { \ 133 if (db->type) \ 134 sv_setsv(db->type, code) ; \ 135 else \ 136 db->type = newSVsv(code) ; \ 137 } \ 138 } 139 140 141 142 SV * 143 filter_fetch_key(db, code) 144 NDBM_File db 145 SV * code 146 SV * RETVAL = &PL_sv_undef ; 147 CODE: 148 setFilter(filter_fetch_key) ; 149 150 SV * 151 filter_store_key(db, code) 152 NDBM_File db 153 SV * code 154 SV * RETVAL = &PL_sv_undef ; 155 CODE: 156 setFilter(filter_store_key) ; 157 158 SV * 159 filter_fetch_value(db, code) 160 NDBM_File db 161 SV * code 162 SV * RETVAL = &PL_sv_undef ; 163 CODE: 164 setFilter(filter_fetch_value) ; 165 166 SV * 167 filter_store_value(db, code) 168 NDBM_File db 169 SV * code 170 SV * RETVAL = &PL_sv_undef ; 171 CODE: 172 setFilter(filter_store_value) ; 173 174