1 #define PERL_NO_GET_CONTEXT 2 #include "EXTERN.h" 3 #include "perl.h" 4 #include "XSUB.h" 5 #include "sdbm/sdbm.h" 6 7 #define fetch_key 0 8 #define store_key 1 9 #define fetch_value 2 10 #define store_value 3 11 12 typedef struct { 13 DBM * dbp ; 14 SV * filter[4]; 15 int filtering ; 16 } SDBM_File_type; 17 18 typedef SDBM_File_type * SDBM_File ; 19 typedef datum datum_key ; 20 typedef datum datum_value ; 21 22 #define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key) 23 #define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags) 24 #define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key) 25 #define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key) 26 #define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp) 27 #define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp) 28 29 30 MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ 31 32 SDBM_File 33 sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL) 34 char * dbtype 35 char * filename 36 int flags 37 int mode 38 char * pagname 39 CODE: 40 { 41 DBM * dbp ; 42 43 RETVAL = NULL ; 44 if (pagname == NULL) { 45 dbp = sdbm_open(filename, flags, mode); 46 } 47 else { 48 dbp = sdbm_prep(filename, pagname, flags, mode); 49 } 50 if (dbp) { 51 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); 52 RETVAL->dbp = dbp ; 53 } 54 55 } 56 OUTPUT: 57 RETVAL 58 59 void 60 sdbm_DESTROY(db) 61 SDBM_File db 62 CODE: 63 if (db) { 64 int i = store_value; 65 sdbm_close(db->dbp); 66 do { 67 if (db->filter[i]) 68 SvREFCNT_dec(db->filter[i]); 69 } while (i-- > 0); 70 safefree(db) ; 71 } 72 73 datum_value 74 sdbm_FETCH(db, key) 75 SDBM_File db 76 datum_key key 77 78 int 79 sdbm_STORE(db, key, value, flags = DBM_REPLACE) 80 SDBM_File db 81 datum_key key 82 datum_value value 83 int flags 84 CLEANUP: 85 if (RETVAL) { 86 if (RETVAL < 0 && errno == EPERM) 87 croak("No write permission to sdbm file"); 88 croak("sdbm store returned %d, errno %d, key \"%s\"", 89 RETVAL,errno,key.dptr); 90 sdbm_clearerr(db->dbp); 91 } 92 93 int 94 sdbm_DELETE(db, key) 95 SDBM_File db 96 datum_key key 97 98 int 99 sdbm_EXISTS(db,key) 100 SDBM_File db 101 datum_key key 102 103 datum_key 104 sdbm_FIRSTKEY(db) 105 SDBM_File db 106 107 datum_key 108 sdbm_NEXTKEY(db, key) 109 SDBM_File db 110 111 int 112 sdbm_error(db) 113 SDBM_File db 114 ALIAS: 115 sdbm_clearerr = 1 116 CODE: 117 RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp); 118 OUTPUT: 119 RETVAL 120 121 SV * 122 filter_fetch_key(db, code) 123 SDBM_File db 124 SV * code 125 SV * RETVAL = &PL_sv_undef ; 126 ALIAS: 127 SDBM_File::filter_fetch_key = fetch_key 128 SDBM_File::filter_store_key = store_key 129 SDBM_File::filter_fetch_value = fetch_value 130 SDBM_File::filter_store_value = store_value 131 CODE: 132 DBM_setFilter(db->filter[ix], code); 133 134 BOOT: 135 { 136 HV *stash = gv_stashpvs("SDBM_File", 1); 137 newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT)); 138 newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT)); 139 newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX)); 140 } 141