DBM Filters (via private mail)

	Message-Id: <199904182009.NAA19152@activestate.com>
	Subject: DBM Filters

p4raw-id: //depot/perl@3317

16 files changed, 695 insertions, 104 deletions

diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index 2fab919229..82d9af5af0 100644
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -230,5 +230,10 @@
    * Updated the message that db-recno.t prints when tests 51, 53 or 55 fail.
 
 1.65 6th March 1999
+
    * Fixed a bug in the recno PUSH logic.
    * The BOOT version check now needs 2.3.4 when using Berkeley DB version 2
+
+1.66 15th March 1999
+
+   * Added DBM Filter code
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index e5759ff558..7e6c90789f 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -2,7 +2,7 @@
 #
 # written by Paul Marquess (Paul.Marquess@btinternet.com)
 # last modified 6th March 1999
-# version 1.65
+# version 1.66
 #
 #     Copyright (c) 1995-9 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver
 use Carp;
 
 
-$VERSION = "1.65" ;
+$VERSION = "1.66" ;
 
 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 $DB_BTREE = new DB_File::BTREEINFO ;
@@ -1811,7 +1811,8 @@ Berkeley DB authors or the author of DB_File. See L<"AUTHOR"> for details.
 
 =head1 SEE ALSO
 
-L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)> 
+L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>,
+L<dbmfilter>
 
 =head1 AUTHOR
 
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 3f6c094395..cdadf29068 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -4,7 +4,7 @@
 
  written by Paul Marquess <Paul.Marquess@btinternet.com>
  last modified 6th March 1999
- version 1.65
+ version 1.66
 
  All comments/suggestions/problems are welcome
 
@@ -65,6 +65,7 @@
 		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
 
 
 
@@ -105,6 +106,7 @@
 #include <fcntl.h> 
 
 /* #define TRACE */
+#define DBM_FILTERING
 
 
 
@@ -277,28 +279,67 @@ 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 ;*/   /* save $_ */			\
+	    save_defsv = newSVsv(DEFSV) ;			\
+	    sv_setsv(DEFSV, arg) ;				\
+	    PUSHMARK(sp) ;					\
+	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
+	    /* SPAGAIN ; */						\
+	    sv_setsv(arg, DEFSV) ;				\
+	    sv_setsv(DEFSV, save_defsv) ;				\
+	    SvREFCNT_dec(save_defsv) ;				\
+	    /* PUTBACK ; */						\
+	    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") ; 	\
+	  } 								\
 	}
 
 
@@ -620,6 +661,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 ;
 
@@ -1165,6 +1211,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 +1436,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)
@@ -1531,3 +1588,63 @@ db_seq(db, key, value, flags)
 	  key
 	  value
 
+#ifdef DBM_FILTERING
+
+#define setFilter(type)					\
+	{						\
+	    if (db->type)				\
+	        RETVAL = newSVsv(db->type) ; 		\
+	    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) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_key(db, code)
+	DB_File		db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_fetch_value(db, code)
+	DB_File		db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_value) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_value(db, code)
+	DB_File		db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_value) ;
+	OUTPUT:
+	    RETVAL
+
+#endif /* DBM_FILTERING */
diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
index 994ba27232..29dc778df7 100644
--- a/ext/DB_File/typemap
+++ b/ext/DB_File/typemap
@@ -1,8 +1,8 @@
 # typemap for Perl 5 interface to Berkeley 
 #
 # written by Paul Marquess <Paul.Marquess@btinternet.com>
-# last modified 21st February 1999
-# version 1.65
+# last modified 20th March 1999
+# version 1.66
 #
 #################################### DB SECTION
 #
@@ -15,6 +15,7 @@ DBTKEY			T_dbtkeydatum
 
 INPUT
 T_dbtkeydatum
+	ckFilter($arg, filter_store_key, \"filter_store_key\");
 	if (db->type != DB_RECNO) {
 	    $var.data = SvPV($arg, PL_na);
 	    $var.size = (int)PL_na;
@@ -27,6 +28,7 @@ T_dbtkeydatum
 	    DBT_flags($var);
 	}
 T_dbtdatum
+	ckFilter($arg, filter_store_value, \"filter_store_value\");
 	$var.data = SvPV($arg, PL_na);
 	$var.size = (int)PL_na;
 	DBT_flags($var);
diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm
index af9a5dc6a3..42bb6d28e8 100644
--- a/ext/GDBM_File/GDBM_File.pm
+++ b/ext/GDBM_File/GDBM_File.pm
@@ -33,7 +33,7 @@ The available functions and the gdbm/perl interface need to be documented.
 
 =head1 SEE ALSO
 
-L<perl(1)>, L<DB_File(3)>. 
+L<perl(1)>, L<DB_File(3)>, L<perldbmfilter>. 
 
 =cut
 
@@ -59,7 +59,7 @@ require DynaLoader;
 	GDBM_WRITER
 );
 
-$VERSION = "1.01";
+$VERSION = "1.02";
 
 sub AUTOLOAD {
     my($constname);
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index 808850d849..275c509698 100644
--- a/ext/GDBM_File/GDBM_File.xs
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -5,18 +5,40 @@
 #include <gdbm.h>
 #include <fcntl.h>
 
-typedef GDBM_FILE GDBM_File;
+typedef struct {
+	GDBM_FILE 	dbp ;
+	SV *    filter_fetch_key ;
+	SV *    filter_store_key ;
+	SV *    filter_fetch_value ;
+	SV *    filter_store_value ;
+	int     filtering ;
+	} GDBM_File_type;
+
+typedef GDBM_File_type * GDBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+
+#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) ;*/		\
+	}
 
-#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
-#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
-	gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
 
-#define gdbm_FETCH(db,key)			gdbm_fetch(db,key)
-#define gdbm_STORE(db,key,value,flags)		gdbm_store(db,key,value,flags)
-#define gdbm_DELETE(db,key)			gdbm_delete(db,key)
-#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db)
-#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db,key)
-#define gdbm_EXISTS(db,key)			gdbm_exists(db,key)
+
+#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
 
 typedef void (*FATALFUNC)();
 
@@ -187,7 +209,23 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
 	int		read_write
 	int		mode
 	FATALFUNC	fatal_func
+	CODE:
+	{
+	    GDBM_FILE  	dbp ;
 
+	    RETVAL = NULL ;
+	    if (dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)) {
+	        RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
+    	        Zero(RETVAL, 1, GDBM_File_type) ;
+		RETVAL->dbp = dbp ;
+	    }
+	    
+	}
+	OUTPUT:
+	  RETVAL
+	
+
+#define gdbm_close(db)			gdbm_close(db->dbp)
 void
 gdbm_close(db)
 	GDBM_File	db
@@ -199,16 +237,18 @@ gdbm_DESTROY(db)
 	CODE:
 	gdbm_close(db);
 
-datum
+#define gdbm_FETCH(db,key)			gdbm_fetch(db->dbp,key)
+datum_value
 gdbm_FETCH(db, key)
 	GDBM_File	db
-	datum		key
+	datum_key	key
 
+#define gdbm_STORE(db,key,value,flags)		gdbm_store(db->dbp,key,value,flags)
 int
 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 	GDBM_File	db
-	datum		key
-	datum		value
+	datum_key	key
+	datum_value	value
 	int		flags
     CLEANUP:
 	if (RETVAL) {
@@ -216,37 +256,44 @@ gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
 		croak("No write permission to gdbm file");
 	    croak("gdbm store returned %d, errno %d, key \"%.*s\"",
 			RETVAL,errno,key.dsize,key.dptr);
-	    /* gdbm_clearerr(db); */
+	    gdbm_clearerr(db);
 	}
 
+#define gdbm_DELETE(db,key)			gdbm_delete(db->dbp,key)
 int
 gdbm_DELETE(db, key)
 	GDBM_File	db
-	datum		key
+	datum_key	key
 
-datum
+#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db->dbp)
+datum_key
 gdbm_FIRSTKEY(db)
 	GDBM_File	db
 
-datum
+#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db->dbp,key)
+datum_key
 gdbm_NEXTKEY(db, key)
 	GDBM_File	db
-	datum		key
+	datum_key	key
 
+#define gdbm_reorganize(db)			gdbm_reorganize(db->dbp)
 int
 gdbm_reorganize(db)
 	GDBM_File	db
 
 
+#define gdbm_sync(db)				gdbm_sync(db->dbp)
 void
 gdbm_sync(db)
 	GDBM_File	db
 
+#define gdbm_EXISTS(db,key)			gdbm_exists(db->dbp,key)
 int
 gdbm_EXISTS(db, key)
 	GDBM_File	db
-	datum		key
+	datum_key	key
 
+#define gdbm_setopt(db,optflag, optval, optlen)	gdbm_setopt(db->dbp,optflag, optval, optlen)
 int
 gdbm_setopt (db, optflag, optval, optlen)
 	GDBM_File	db
@@ -254,3 +301,62 @@ gdbm_setopt (db, optflag, optval, optlen)
 	int		&optval
 	int		optlen
 
+
+#define setFilter(type)					\
+	{						\
+	    if (db->type)				\
+	        RETVAL = newSVsv(db->type) ; 		\
+	    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)
+	GDBM_File	db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_key(db, code)
+	GDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_fetch_value(db, code)
+	GDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_value) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_value(db, code)
+	GDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_value) ;
+	OUTPUT:
+	    RETVAL
+
diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap
index d122d07a43..20d5cd99bd 100644
--- a/ext/GDBM_File/typemap
+++ b/ext/GDBM_File/typemap
@@ -2,7 +2,8 @@
 #################################### DBM SECTION
 #
 
-datum			T_DATUM
+datum_key		T_DATUM_K
+datum_value		T_DATUM_V
 NDBM_File		T_PTROBJ
 GDBM_File		T_PTROBJ
 SDBM_File		T_PTROBJ
@@ -12,11 +13,20 @@ DBZ_File		T_PTROBJ
 FATALFUNC		T_OPAQUEPTR
 
 INPUT
-T_DATUM
+T_DATUM_K
+	ckFilter($arg, filter_store_key, \"filter_store_key\");
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_DATUM_V
+        ckFilter($arg, filter_store_value, \"filter_store_value\");
 	$var.dptr = SvPV($arg, PL_na);
 	$var.dsize = (int)PL_na;
 OUTPUT
-T_DATUM
+T_DATUM_K
+	output_datum($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_key,\"filter_fetch_key\");
+T_DATUM_V
 	output_datum($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_value,\"filter_fetch_value\");
 T_PTROBJ
         sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm
index ed4fe2b36f..cad800adf4 100644
--- a/ext/NDBM_File/NDBM_File.pm
+++ b/ext/NDBM_File/NDBM_File.pm
@@ -12,7 +12,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.01";
+$VERSION = "1.02";
 
 bootstrap NDBM_File $VERSION;
 
@@ -35,6 +35,6 @@ NDBM_File - Tied access to ndbm files
 
 =head1 DESCRIPTION
 
-See L<perlfunc/tie>
+See L<perlfunc/tie>, L<perldbmfilter>
 
 =cut
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
index d129a9c490..f5bc0f9a6a 100644
--- a/ext/NDBM_File/NDBM_File.xs
+++ b/ext/NDBM_File/NDBM_File.xs
@@ -3,13 +3,37 @@
 #include "XSUB.h"
 #include <ndbm.h>
 
-typedef DBM* NDBM_File;
-#define dbm_TIEHASH(dbtype,filename,flags,mode) dbm_open(filename,flags,mode)
-#define dbm_FETCH(db,key)			dbm_fetch(db,key)
-#define dbm_STORE(db,key,value,flags)		dbm_store(db,key,value,flags)
-#define dbm_DELETE(db,key)			dbm_delete(db,key)
-#define dbm_FIRSTKEY(db)			dbm_firstkey(db)
-#define dbm_NEXTKEY(db,key)			dbm_nextkey(db)
+typedef struct {
+	DBM * 	dbp ;
+	SV *    filter_fetch_key ;
+	SV *    filter_store_key ;
+	SV *    filter_fetch_value ;
+	SV *    filter_store_value ;
+	int     filtering ;
+	} NDBM_File_type;
+
+typedef NDBM_File_type * NDBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+
+#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) ;*/		\
+	}
+
 
 MODULE = NDBM_File	PACKAGE = NDBM_File	PREFIX = dbm_
 
@@ -19,23 +43,39 @@ dbm_TIEHASH(dbtype, filename, flags, mode)
 	char *		filename
 	int		flags
 	int		mode
+	CODE:
+	{
+	    DBM * 	dbp ;
+
+	    RETVAL = NULL ;
+	    if (dbp =  dbm_open(filename, flags, mode)) {
+	        RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
+    	        Zero(RETVAL, 1, NDBM_File_type) ;
+		RETVAL->dbp = dbp ;
+	    }
+	    
+	}
+	OUTPUT:
+	  RETVAL
 
 void
 dbm_DESTROY(db)
 	NDBM_File	db
 	CODE:
-	dbm_close(db);
+	dbm_close(db->dbp);
 
-datum
+#define dbm_FETCH(db,key)			dbm_fetch(db->dbp,key)
+datum_value
 dbm_FETCH(db, key)
 	NDBM_File	db
-	datum		key
+	datum_key	key
 
+#define dbm_STORE(db,key,value,flags)		dbm_store(db->dbp,key,value,flags)
 int
 dbm_STORE(db, key, value, flags = DBM_REPLACE)
 	NDBM_File	db
-	datum		key
-	datum		value
+	datum_key	key
+	datum_value	value
 	int		flags
     CLEANUP:
 	if (RETVAL) {
@@ -43,28 +83,92 @@ dbm_STORE(db, key, value, flags = DBM_REPLACE)
 		croak("No write permission to ndbm file");
 	    croak("ndbm store returned %d, errno %d, key \"%s\"",
 			RETVAL,errno,key.dptr);
-	    dbm_clearerr(db);
+	    dbm_clearerr(db->dbp);
 	}
 
+#define dbm_DELETE(db,key)			dbm_delete(db->dbp,key)
 int
 dbm_DELETE(db, key)
 	NDBM_File	db
-	datum		key
+	datum_key	key
 
-datum
+#define dbm_FIRSTKEY(db)			dbm_firstkey(db->dbp)
+datum_key
 dbm_FIRSTKEY(db)
 	NDBM_File	db
 
-datum
+#define dbm_NEXTKEY(db,key)			dbm_nextkey(db->dbp)
+datum_key
 dbm_NEXTKEY(db, key)
 	NDBM_File	db
-	datum		key
+	datum_key	key
 
+#define dbm_error(db)				dbm_error(db->dbp)
 int
 dbm_error(db)
 	NDBM_File	db
 
+#define dbm_clearerr(db)			dbm_clearerr(db->dbp)
 void
 dbm_clearerr(db)
 	NDBM_File	db
 
+
+#define setFilter(type)					\
+	{						\
+	    if (db->type)				\
+	        RETVAL = newSVsv(db->type) ; 		\
+	    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)
+	NDBM_File	db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_key(db, code)
+	NDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_fetch_value(db, code)
+	NDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_value) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_value(db, code)
+	NDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_value) ;
+	OUTPUT:
+	    RETVAL
+
diff --git a/ext/NDBM_File/typemap b/ext/NDBM_File/typemap
index 317a8f3886..eeb5d59027 100644
--- a/ext/NDBM_File/typemap
+++ b/ext/NDBM_File/typemap
@@ -2,7 +2,8 @@
 #################################### DBM SECTION
 #
 
-datum			T_DATUM
+datum_key		T_DATUM_K
+datum_value		T_DATUM_V
 gdatum			T_GDATUM
 NDBM_File		T_PTROBJ
 GDBM_File		T_PTROBJ
@@ -13,14 +14,23 @@ DBZ_File		T_PTROBJ
 FATALFUNC		T_OPAQUEPTR
 
 INPUT
-T_DATUM
+T_DATUM_K
+	ckFilter($arg, filter_store_key, \"filter_store_key\");
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_DATUM_V
+        ckFilter($arg, filter_store_value, \"filter_store_value\");
 	$var.dptr = SvPV($arg, PL_na);
 	$var.dsize = (int)PL_na;
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
-T_DATUM
+T_DATUM_K
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_key,\"filter_fetch_key\");
+T_DATUM_V
 	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_value,\"filter_fetch_value\");
 T_GDATUM
 	sv_usepvn($arg, $var.dptr, $var.dsize);
 T_PTROBJ
diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm
index 923640ff34..572318b0cd 100644
--- a/ext/ODBM_File/ODBM_File.pm
+++ b/ext/ODBM_File/ODBM_File.pm
@@ -8,7 +8,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.00";
+$VERSION = "1.01";
 
 bootstrap ODBM_File $VERSION;
 
@@ -30,6 +30,6 @@ ODBM_File - Tied access to odbm files
 
 =head1 DESCRIPTION
 
-See L<perlfunc/tie>
+See L<perlfunc/tie>, L<perldbmfilter>
 
 =cut
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index 892c038a9c..0ab06ef6b1 100644
--- a/ext/ODBM_File/ODBM_File.xs
+++ b/ext/ODBM_File/ODBM_File.xs
@@ -30,7 +30,37 @@
 
 #include <fcntl.h>
 
-typedef void* ODBM_File;
+typedef struct {
+	void * 	dbp ;
+	SV *    filter_fetch_key ;
+	SV *    filter_store_key ;
+	SV *    filter_fetch_value ;
+	SV *    filter_store_value ;
+	int     filtering ;
+	} ODBM_File_type;
+
+typedef ODBM_File_type * ODBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+
+#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) ;*/		\
+	}
+
 
 #define odbm_FETCH(db,key)			fetch(key)
 #define odbm_STORE(db,key,value,flags)		store(key,value)
@@ -59,6 +89,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 	CODE:
 	{
 	    char *tmpbuf;
+	    void * dbp ;
 	    if (dbmrefcnt++)
 		croak("Old dbm can only open one database");
 	    New(0, tmpbuf, strlen(filename) + 5, char);
@@ -75,7 +106,10 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 		else
 		    croak("ODBM_FILE: Can't open %s", filename);
 	    }
-	    RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
+	    dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
+	    RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
+    	    Zero(RETVAL, 1, ODBM_File_type) ;
+	    RETVAL->dbp = dbp ;
 	    ST(0) = sv_mortalcopy(&PL_sv_undef);
 	    sv_setptrobj(ST(0), RETVAL, dbtype);
 	}
@@ -87,16 +121,16 @@ DESTROY(db)
 	dbmrefcnt--;
 	dbmclose();
 
-datum
+datum_key
 odbm_FETCH(db, key)
 	ODBM_File	db
-	datum		key
+	datum_key	key
 
 int
 odbm_STORE(db, key, value, flags = DBM_REPLACE)
 	ODBM_File	db
-	datum		key
-	datum		value
+	datum_key	key
+	datum_value	value
 	int		flags
     CLEANUP:
 	if (RETVAL) {
@@ -109,14 +143,73 @@ odbm_STORE(db, key, value, flags = DBM_REPLACE)
 int
 odbm_DELETE(db, key)
 	ODBM_File	db
-	datum		key
+	datum_key	key
 
-datum
+datum_key
 odbm_FIRSTKEY(db)
 	ODBM_File	db
 
-datum
+datum_key
 odbm_NEXTKEY(db, key)
 	ODBM_File	db
-	datum		key
+	datum_key	key
+
+
+#define setFilter(type)					\
+	{						\
+	    if (db->type)				\
+	        RETVAL = newSVsv(db->type) ; 		\
+	    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)
+	ODBM_File	db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_key(db, code)
+	ODBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_fetch_value(db, code)
+	ODBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_value) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_value(db, code)
+	ODBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_value) ;
+	OUTPUT:
+	    RETVAL
 
diff --git a/ext/ODBM_File/typemap b/ext/ODBM_File/typemap
index 5e12e73933..7c23815ec7 100644
--- a/ext/ODBM_File/typemap
+++ b/ext/ODBM_File/typemap
@@ -2,7 +2,8 @@
 #################################### DBM SECTION
 #
 
-datum			T_DATUM
+datum_key		T_DATUM_K
+datum_value		T_DATUM_V
 gdatum			T_GDATUM
 NDBM_File		T_PTROBJ
 GDBM_File		T_PTROBJ
@@ -13,13 +14,22 @@ DBZ_File		T_PTROBJ
 FATALFUNC		T_OPAQUEPTR
 
 INPUT
-T_DATUM
+T_DATUM_K
+	ckFilter($arg, filter_store_key, \"filter_store_key\");
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_DATUM_V
+        ckFilter($arg, filter_store_value, \"filter_store_value\");
 	$var.dptr = SvPV($arg, PL_na);
 	$var.dsize = (int)PL_na;
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
-T_DATUM
+T_DATUM_K
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_key,\"filter_fetch_key\");
+T_DATUM_V
 	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_value,\"filter_fetch_value\");
 T_GDATUM
 	sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm
index a2d4df8558..006bbbd17d 100644
--- a/ext/SDBM_File/SDBM_File.pm
+++ b/ext/SDBM_File/SDBM_File.pm
@@ -8,7 +8,7 @@ require DynaLoader;
 
 @ISA = qw(Tie::Hash DynaLoader);
 
-$VERSION = "1.00" ;
+$VERSION = "1.01" ;
 
 bootstrap SDBM_File $VERSION;
 
@@ -30,6 +30,6 @@ SDBM_File - Tied access to sdbm files
 
 =head1 DESCRIPTION
 
-See L<perlfunc/tie>
+See L<perlfunc/tie>, L<perldbmfilter>
 
 =cut
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
index 789e5c80b8..681cf14696 100644
--- a/ext/SDBM_File/SDBM_File.xs
+++ b/ext/SDBM_File/SDBM_File.xs
@@ -3,14 +3,47 @@
 #include "XSUB.h"
 #include "sdbm/sdbm.h"
 
-typedef DBM* SDBM_File;
+typedef struct {
+	DBM * 	dbp ;
+	SV *    filter_fetch_key ;
+	SV *    filter_store_key ;
+	SV *    filter_fetch_value ;
+	SV *    filter_store_value ;
+	int     filtering ;
+	} SDBM_File_type;
+
+typedef SDBM_File_type * SDBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+
+#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 ;*/   /* save $_ */			\
+	    save_defsv = newSVsv(DEFSV) ;			\
+	    sv_setsv(DEFSV, arg) ;				\
+	    PUSHMARK(sp) ;					\
+	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
+	    /* SPAGAIN ; */						\
+	    sv_setsv(arg, DEFSV) ;				\
+	    sv_setsv(DEFSV, save_defsv) ;				\
+	    SvREFCNT_dec(save_defsv) ;				\
+	    /* PUTBACK ; */						\
+	    db->filtering = FALSE ;				\
+	    /*printf("end of filtering %s\n", name) ;*/		\
+	}
+
 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
-#define sdbm_FETCH(db,key)			sdbm_fetch(db,key)
-#define sdbm_STORE(db,key,value,flags)		sdbm_store(db,key,value,flags)
-#define sdbm_DELETE(db,key)			sdbm_delete(db,key)
-#define sdbm_EXISTS(db,key)			sdbm_exists(db,key)
-#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db)
-#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db)
+#define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
+#define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
+#define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
+#define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
+#define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
+#define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)
 
 
 MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_
@@ -21,23 +54,46 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 	char *		filename
 	int		flags
 	int		mode
+	CODE:
+	{
+	    DBM * 	dbp ;
+
+	    RETVAL = NULL ;
+	    if (dbp = sdbm_open(filename,flags,mode) ) {
+	        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
+    	        Zero(RETVAL, 1, SDBM_File_type) ;
+		RETVAL->dbp = dbp ;
+	    }
+	    
+	}
+	OUTPUT:
+	  RETVAL
 
 void
 sdbm_DESTROY(db)
 	SDBM_File	db
 	CODE:
-	sdbm_close(db);
+	  sdbm_close(db->dbp);
+	  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) ;
+	  Safefree(db) ;	
 
-datum
+datum_value
 sdbm_FETCH(db, key)
 	SDBM_File	db
-	datum		key
+	datum_key	key
 
 int
 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
 	SDBM_File	db
-	datum		key
-	datum		value
+	datum_key	key
+	datum_value	value
 	int		flags
     CLEANUP:
 	if (RETVAL) {
@@ -45,7 +101,7 @@ sdbm_STORE(db, key, value, flags = DBM_REPLACE)
 		croak("No write permission to sdbm file");
 	    croak("sdbm store returned %d, errno %d, key \"%s\"",
 			RETVAL,errno,key.dptr);
-	    sdbm_clearerr(db);
+	    sdbm_clearerr(db->dbp);
 	}
 
 int
@@ -56,22 +112,89 @@ sdbm_DELETE(db, key)
 int
 sdbm_EXISTS(db,key)
 	SDBM_File	db
-	datum		key
+	datum_key	key
 
-datum
+datum_key
 sdbm_FIRSTKEY(db)
 	SDBM_File	db
 
-datum
+datum_key
 sdbm_NEXTKEY(db, key)
 	SDBM_File	db
-	datum		key
+	datum_key	key
 
 int
 sdbm_error(db)
 	SDBM_File	db
+	CODE:
+	RETVAL = sdbm_error(db->dbp) ;
+	OUTPUT:
+	  RETVAL
 
 int
 sdbm_clearerr(db)
 	SDBM_File	db
+	CODE:
+	RETVAL = sdbm_clearerr(db->dbp) ;
+	OUTPUT:
+	  RETVAL
+
+
+#define setFilter(type)					\
+	{						\
+	    if (db->type)				\
+	        RETVAL = newSVsv(db->type) ; 		\
+	    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)
+	SDBM_File	db
+	SV *		code
+	SV *		RETVAL = &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_key(db, code)
+	SDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_key) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_fetch_value(db, code)
+	SDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_fetch_value) ;
+	OUTPUT:
+	    RETVAL
+
+SV *
+filter_store_value(db, code)
+	SDBM_File	db
+	SV *		code
+	SV *		RETVAL =  &PL_sv_undef ;
+	CODE:
+	    setFilter(filter_store_value) ;
+	OUTPUT:
+	    RETVAL
 
diff --git a/ext/SDBM_File/typemap b/ext/SDBM_File/typemap
index 317a8f3886..eeb5d59027 100644
--- a/ext/SDBM_File/typemap
+++ b/ext/SDBM_File/typemap
@@ -2,7 +2,8 @@
 #################################### DBM SECTION
 #
 
-datum			T_DATUM
+datum_key		T_DATUM_K
+datum_value		T_DATUM_V
 gdatum			T_GDATUM
 NDBM_File		T_PTROBJ
 GDBM_File		T_PTROBJ
@@ -13,14 +14,23 @@ DBZ_File		T_PTROBJ
 FATALFUNC		T_OPAQUEPTR
 
 INPUT
-T_DATUM
+T_DATUM_K
+	ckFilter($arg, filter_store_key, \"filter_store_key\");
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
+T_DATUM_V
+        ckFilter($arg, filter_store_value, \"filter_store_value\");
 	$var.dptr = SvPV($arg, PL_na);
 	$var.dsize = (int)PL_na;
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
-T_DATUM
+T_DATUM_K
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_key,\"filter_fetch_key\");
+T_DATUM_V
 	sv_setpvn($arg, $var.dptr, $var.dsize);
+	ckFilter($arg, filter_fetch_value,\"filter_fetch_value\");
 T_GDATUM
 	sv_usepvn($arg, $var.dptr, $var.dsize);
 T_PTROBJ