1 #define PERL_NO_GET_CONTEXT 2 3 #include "EXTERN.h" 4 #include "perl.h" 5 #include "XSUB.h" 6 #undef NDBM_HEADER_USES_PROTOTYPES 7 #if defined(I_GDBM_NDBM) 8 # ifdef GDBM_NDBM_H_USES_PROTOTYPES 9 # define NDBM_HEADER_USES_PROTOTYPES 10 START_EXTERN_C 11 # endif 12 # include <gdbm-ndbm.h> /* Debian compatibility version */ 13 #elif defined(I_GDBMNDBM) 14 # ifdef GDBMNDBM_H_USES_PROTOTYPES 15 # define NDBM_HEADER_USES_PROTOTYPES 16 START_EXTERN_C 17 # endif 18 # include <gdbm/ndbm.h> /* RedHat compatibility version */ 19 #elif defined(I_NDBM) 20 # ifdef NDBM_H_USES_PROTOTYPES 21 # define NDBM_HEADER_USES_PROTOTYPES 22 START_EXTERN_C 23 # endif 24 # include <ndbm.h> 25 #endif 26 #ifdef NDBM_HEADER_USES_PROTOTYPES 27 END_EXTERN_C 28 #endif 29 30 #define fetch_key 0 31 #define store_key 1 32 #define fetch_value 2 33 #define store_value 3 34 35 typedef struct { 36 DBM * dbp ; 37 SV * filter[4]; 38 int filtering ; 39 } NDBM_File_type; 40 41 typedef NDBM_File_type * NDBM_File ; 42 typedef datum datum_key ; 43 typedef datum datum_value ; 44 45 46 #if defined(__cplusplus) && !defined(NDBM_HEADER_USES_PROTOTYPES) 47 /* gdbm's header file used for compatibility with gdbm */ 48 /* isn't compatible to C++ syntax, so we need these */ 49 /* declarations to make everyone happy. */ 50 EXTERN_C DBM *dbm_open(const char *, int, mode_t); 51 EXTERN_C void dbm_close(DBM *); 52 EXTERN_C datum dbm_fetch(DBM *, datum); 53 EXTERN_C int dbm_store(DBM *, datum, datum, int); 54 EXTERN_C int dbm_delete(DBM *, datum); 55 EXTERN_C datum dbm_firstkey(DBM *); 56 EXTERN_C datum dbm_nextkey(DBM *); 57 #endif 58 59 MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_ 60 61 NDBM_File 62 ndbm_TIEHASH(dbtype, filename, flags, mode) 63 char * dbtype 64 char * filename 65 int flags 66 int mode 67 CODE: 68 { 69 DBM * dbp ; 70 71 RETVAL = NULL ; 72 if ((dbp = dbm_open(filename, flags, mode))) { 73 RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type)); 74 RETVAL->dbp = dbp ; 75 } 76 77 } 78 OUTPUT: 79 RETVAL 80 81 void 82 ndbm_DESTROY(db) 83 NDBM_File db 84 PREINIT: 85 int i = store_value; 86 CODE: 87 dbm_close(db->dbp); 88 do { 89 if (db->filter[i]) 90 SvREFCNT_dec(db->filter[i]); 91 } while (i-- > 0); 92 safefree(db); 93 94 #define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) 95 datum_value 96 ndbm_FETCH(db, key) 97 NDBM_File db 98 datum_key key 99 100 #define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags) 101 int 102 ndbm_STORE(db, key, value, flags = DBM_REPLACE) 103 NDBM_File db 104 datum_key key 105 datum_value value 106 int flags 107 CLEANUP: 108 if (RETVAL) { 109 if (RETVAL < 0 && errno == EPERM) 110 croak("No write permission to ndbm file"); 111 croak("ndbm store returned %d, errno %d, key \"%s\"", 112 RETVAL, errno, (const char *)key.dptr); 113 dbm_clearerr(db->dbp); 114 } 115 116 #define ndbm_DELETE(db,key) dbm_delete(db->dbp,key) 117 int 118 ndbm_DELETE(db, key) 119 NDBM_File db 120 datum_key key 121 122 #define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp) 123 datum_key 124 ndbm_FIRSTKEY(db) 125 NDBM_File db 126 127 #define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp) 128 datum_key 129 ndbm_NEXTKEY(db, key) 130 NDBM_File db 131 datum_key key = NO_INIT 132 CLEANUP: 133 PERL_UNUSED_VAR(key); 134 135 #define ndbm_error(db) dbm_error(db->dbp) 136 int 137 ndbm_error(db) 138 NDBM_File db 139 CLEANUP: 140 PERL_UNUSED_VAR(db); 141 142 #define ndbm_clearerr(db) dbm_clearerr(db->dbp) 143 void 144 ndbm_clearerr(db) 145 NDBM_File db 146 CLEANUP: 147 PERL_UNUSED_VAR(db); 148 149 150 SV * 151 filter_fetch_key(db, code) 152 NDBM_File db 153 SV * code 154 SV * RETVAL = &PL_sv_undef ; 155 ALIAS: 156 NDBM_File::filter_fetch_key = fetch_key 157 NDBM_File::filter_store_key = store_key 158 NDBM_File::filter_fetch_value = fetch_value 159 NDBM_File::filter_store_value = store_value 160 CODE: 161 DBM_setFilter(db->filter[ix], code); 162