X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDB_File%2FDB_File.xs;h=ed3a7fa3e044f780dbf1e74f53123b73ec7525ba;hb=873b149f049701f76396c28e70d7cccfec0b011f;hp=94113eb4e28d14c86415fe49fbbbfa9bd923a429;hpb=ca63f0d242a6920af7209f1a190c17b7800ce145;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 94113eb..ed3a7fa 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess - last modified 6th March 1999 - version 1.65 + last modified 6th June 1999 + version 1.67 All comments/suggestions/problems are welcome @@ -65,6 +65,10 @@ to fix a flag mapping problem with O_RDONLY on the Hurd 1.65 - Fixed a bug in the PUSH logic. Added BOOT check that using 2.3.4 or greater + 1.66 - Added DBM filter code + 1.67 - Backed off the use of newSVpvn. + Fixed DBM Filter code for Perl 5.004. + Fixed a small memory leak in the filter code. @@ -88,6 +92,11 @@ #endif +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +#define DEFSV GvSV(defgv) +#endif + /* Being the Berkeley DB we prefer the (which will be * shortly #included by the ) __attribute__ to the possibly * already defined __attribute__, for example by GNUC or by Perl. */ @@ -105,6 +114,7 @@ #include /* #define TRACE */ +#define DBM_FILTERING @@ -277,28 +287,64 @@ typedef struct { #ifdef DB_VERSION_MAJOR DBC * cursor ; #endif +#ifdef DBM_FILTERING + SV * filter_fetch_key ; + SV * filter_store_key ; + SV * filter_fetch_value ; + SV * filter_store_value ; + int filtering ; +#endif /* DBM_FILTERING */ + } DB_File_type; typedef DB_File_type * DB_File ; typedef DBT DBTKEY ; +#ifdef DBM_FILTERING + +#define ckFilter(arg,type,name) \ + if (db->type) { \ + SV * save_defsv ; \ + /* printf("filtering %s\n", name) ;*/ \ + if (db->filtering) \ + croak("recursion detected in %s", name) ; \ + db->filtering = TRUE ; \ + save_defsv = newSVsv(DEFSV) ; \ + sv_setsv(DEFSV, arg) ; \ + PUSHMARK(sp) ; \ + (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ + sv_setsv(arg, DEFSV) ; \ + sv_setsv(DEFSV, save_defsv) ; \ + SvREFCNT_dec(save_defsv) ; \ + db->filtering = FALSE ; \ + /*printf("end of filtering %s\n", name) ;*/ \ + } + +#else + +#define ckFilter(arg,type, name) + +#endif /* DBM_FILTERING */ + #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s) -#define OutputValue(arg, name) \ - { if (RETVAL == 0) { \ - my_sv_setpvn(arg, name.data, name.size) ; \ - } \ +#define OutputValue(arg, name) \ + { if (RETVAL == 0) { \ + my_sv_setpvn(arg, name.data, name.size) ; \ + ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \ + } \ } -#define OutputKey(arg, name) \ - { if (RETVAL == 0) \ - { \ - if (db->type != DB_RECNO) { \ - my_sv_setpvn(arg, name.data, name.size); \ - } \ - else \ - sv_setiv(arg, (I32)*(I32*)name.data - 1); \ - } \ +#define OutputKey(arg, name) \ + { if (RETVAL == 0) \ + { \ + if (db->type != DB_RECNO) { \ + my_sv_setpvn(arg, name.data, name.size); \ + } \ + else \ + sv_setiv(arg, (I32)*(I32*)name.data - 1); \ + ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \ + } \ } @@ -311,12 +357,7 @@ static DBTKEY empty ; #ifdef DB_VERSION_MAJOR static int -db_put(db, key, value, flags) -DB_File db ; -DBTKEY key ; -DBT value ; -u_int flags ; - +db_put(DB_File db, DBTKEY key, DBT value, u_int flags) { int status ; @@ -340,7 +381,7 @@ u_int flags ; #endif /* DB_VERSION_MAJOR */ static void -GetVersionInfo() +GetVersionInfo(pTHX) { SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ; #ifdef DB_VERSION_MAJOR @@ -371,10 +412,9 @@ GetVersionInfo() static int -btree_compare(key1, key2) -const DBT * key1 ; -const DBT * key2 ; +btree_compare(const DBT *key1, const DBT *key2) { + dTHX; dSP ; void * data1, * data2 ; int retval ; @@ -418,10 +458,9 @@ const DBT * key2 ; } static DB_Prefix_t -btree_prefix(key1, key2) -const DBT * key1 ; -const DBT * key2 ; +btree_prefix(const DBT *key1, const DBT *key2) { + dTHX; dSP ; void * data1, * data2 ; int retval ; @@ -465,10 +504,9 @@ const DBT * key2 ; } static DB_Hash_t -hash_cb(data, size) -const void * data ; -size_t size ; +hash_cb(const void *data, size_t size) { + dTHX; dSP ; int retval ; int count ; @@ -505,8 +543,7 @@ size_t size ; #ifdef TRACE static void -PrintHash(hash) -INFO * hash ; +PrintHash(INFO *hash) { printf ("HASH Info\n") ; printf (" hash = %s\n", @@ -520,8 +557,7 @@ INFO * hash ; } static void -PrintRecno(recno) -INFO * recno ; +PrintRecno(INFO *recno) { printf ("RECNO Info\n") ; printf (" flags = %d\n", recno->db_RE_flags) ; @@ -534,8 +570,7 @@ INFO * recno ; } static void -PrintBtree(btree) -INFO * btree ; +PrintBtree(INFO *btree) { printf ("BTREE Info\n") ; printf (" compare = %s\n", @@ -562,8 +597,7 @@ INFO * btree ; static I32 -GetArrayLength(db) -DB_File db ; +GetArrayLength(pTHX_ DB_File db) { DBT key ; DBT value ; @@ -581,13 +615,11 @@ DB_File db ; } static recno_t -GetRecnoKey(db, value) -DB_File db ; -I32 value ; +GetRecnoKey(pTHX_ DB_File db, I32 value) { if (value < 0) { /* Get the length of the array */ - I32 length = GetArrayLength(db) ; + I32 length = GetArrayLength(aTHX_ db) ; /* check for attempt to write before start of array */ if (length + value + 1 <= 0) @@ -602,12 +634,7 @@ I32 value ; } static DB_File -ParseOpenInfo(isHASH, name, flags, mode, sv) -int isHASH ; -char * name ; -int flags ; -int mode ; -SV * sv ; +ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv) { SV ** svp; HV * action ; @@ -620,6 +647,11 @@ SV * sv ; Zero(RETVAL, 1, DB_File_type) ; /* Default to HASH */ +#ifdef DBM_FILTERING + RETVAL->filtering = 0 ; + RETVAL->filter_fetch_key = RETVAL->filter_store_key = + RETVAL->filter_fetch_value = RETVAL->filter_store_value = +#endif /* DBM_FILTERING */ RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; RETVAL->type = DB_HASH ; @@ -871,18 +903,8 @@ SV * sv ; } -static int -not_here(s) -char *s; -{ - croak("DB_File::%s not implemented on this architecture", s); - return -1; -} - static double -constant(name, arg) -char *name; -int arg; +constant(char *name, int arg) { errno = 0; switch (*name) { @@ -1115,7 +1137,7 @@ MODULE = DB_File PACKAGE = DB_File PREFIX = db_ BOOT: { - GetVersionInfo() ; + GetVersionInfo(aTHX) ; empty.data = &zero ; empty.size = sizeof(recno_t) ; @@ -1146,7 +1168,7 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H if (items == 6) sv = ST(5) ; - RETVAL = ParseOpenInfo(isHASH, name, flags, mode, sv) ; + RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ; if (RETVAL->dbp == NULL) RETVAL = NULL ; } @@ -1165,6 +1187,16 @@ db_DESTROY(db) SvREFCNT_dec(db->compare) ; if (db->prefix) SvREFCNT_dec(db->prefix) ; +#ifdef DBM_FILTERING + if (db->filter_fetch_key) + SvREFCNT_dec(db->filter_fetch_key) ; + if (db->filter_store_key) + SvREFCNT_dec(db->filter_store_key) ; + if (db->filter_fetch_value) + SvREFCNT_dec(db->filter_fetch_value) ; + if (db->filter_store_value) + SvREFCNT_dec(db->filter_store_value) ; +#endif /* DBM_FILTERING */ Safefree(db) ; #ifdef DB_VERSION_MAJOR if (RETVAL > 0) @@ -1380,7 +1412,8 @@ push(db, ...) if (RETVAL != 0) break; } -#else +#else + /* Set the Cursor to the Last element */ RETVAL = do_SEQ(db, key, value, R_LAST) ; if (RETVAL >= 0) @@ -1408,7 +1441,7 @@ length(db) ALIAS: FETCHSIZE = 1 CODE: CurrentDB = db ; - RETVAL = GetArrayLength(db) ; + RETVAL = GetArrayLength(aTHX_ db) ; OUTPUT: RETVAL @@ -1531,3 +1564,56 @@ db_seq(db, key, value, flags) key value +#ifdef DBM_FILTERING + +#define setFilter(type) \ + { \ + if (db->type) \ + RETVAL = sv_mortalcopy(db->type) ; \ + ST(0) = RETVAL ; \ + if (db->type && (code == &PL_sv_undef)) { \ + SvREFCNT_dec(db->type) ; \ + db->type = NULL ; \ + } \ + else if (code) { \ + if (db->type) \ + sv_setsv(db->type, code) ; \ + else \ + db->type = newSVsv(code) ; \ + } \ + } + + +SV * +filter_fetch_key(db, code) + DB_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_fetch_key) ; + +SV * +filter_store_key(db, code) + DB_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_key) ; + +SV * +filter_fetch_value(db, code) + DB_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_fetch_value) ; + +SV * +filter_store_value(db, code) + DB_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_value) ; + +#endif /* DBM_FILTERING */