Enhanced DBM Filters

From: "Paul Marquess" <Paul.Marquess@btinternet.com>
Message-ID: <AIEAJICLCBDNAAOLLOKLAEPPPHAA.Paul.Marquess@btinternet.com>

add DBM_Filter

p4raw-id: //depot/perl@22168

13 files changed, 1721 insertions, 0 deletions

diff --git a/lib/DBM_Filter/Changes b/lib/DBM_Filter/Changes
new file mode 100644
index 0000000000..3f0841f664
--- /dev/null
+++ b/lib/DBM_Filter/Changes
@@ -0,0 +1,5 @@
+Revision history for Perl extension DBM_Filter.
+
+0.01  Sat, 17 Jan 2004
+
+      * Original version created.
diff --git a/lib/DBM_Filter/compress.pm b/lib/DBM_Filter/compress.pm
new file mode 100644
index 0000000000..4c3356c3fc
--- /dev/null
+++ b/lib/DBM_Filter/compress.pm
@@ -0,0 +1,51 @@
+package DBM_Filter::compress ;
+
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.01';
+
+BEGIN
+{
+    eval { require Compress::Zlib; Compress::Zlib->import() };
+
+    croak "Compress::Zlib module not found.\n"
+        if $@;
+}
+
+
+
+sub Store { $_ = compress($_) }
+sub Fetch { $_ = uncompress($_) }
+
+1;
+
+__END__
+
+=head1 DBM_Filter::compress
+
+=head1 SYNOPSIS
+
+    use SDBM_File; # or DB_File, or GDBM_File, or NDBM_File, or ODBM_File
+    use DBM_Filter ;
+
+    $db = tie %hash, ...
+    $db->Filter_Push('compress');
+    
+=head1 DESCRIPTION
+
+This DBM filter will compress all data before it is written to the database
+and uncompressed it on reading.
+
+A fatal error will be thrown if the Compress::Zlib module is not
+available.
+
+=head1 SEE ALSO
+
+L<DBM_Filter>, L<perldbmfilter>, L<Compress::Zlib>
+
+=head1 AUTHOR
+
+Paul Marquess pmqs@cpan.org
+
diff --git a/lib/DBM_Filter/encode.pm b/lib/DBM_Filter/encode.pm
new file mode 100644
index 0000000000..f5ca7a97b7
--- /dev/null
+++ b/lib/DBM_Filter/encode.pm
@@ -0,0 +1,84 @@
+package DBM_Filter::encode ;
+
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.01';
+
+BEGIN
+{
+    eval { require Encode; };
+
+    croak "Encode module not found.\n"
+        if $@;
+}
+
+
+sub Filter
+{
+    my $encoding_name = shift || "utf8";
+
+    my $encoding = Encode::find_encoding($encoding_name) ;
+
+    croak "Encoding '$encoding_name' is not available"
+        unless $encoding;
+
+    return {
+        Store   => sub { 
+			 $_ = $encoding->encode($_) 
+			     if defined $_ ;
+		   },
+        Fetch   => sub { 
+			 $_ = $encoding->decode($_)
+			     if defined $_ ;
+			}
+        } ;
+}
+
+1;
+
+__END__
+
+=head1 DBM_Filter::encode
+
+=head1 SYNOPSIS
+
+    use SDBM_File; # or DB_File, or GDBM_File, or NDBM_File, or ODBM_File
+    use DBM_Filter ;
+
+    $db = tie %hash, ...
+    $db->Filter_Push('encode' => 'iso-8859-16');
+    
+=head1 DESCRIPTION
+
+This DBM filter allows you to choose the character encoding will be
+store in the DBM file. The usage is
+
+    $db->Filter_Push('encode' => ENCODING);
+
+where "ENCODING" must be a valid encoding name that the Encode module
+recognises.
+
+A fatal error will be thrown if:
+
+=over 5
+
+=item 1
+
+The Encode module is not available.
+
+=item 2
+
+The encoding requested is not supported by the Encode module.
+
+=back
+
+=head1 SEE ALSO
+
+L<DBM_Filter>, L<perldbmfilter>, L<Encode>
+
+=head1 AUTHOR
+
+Paul Marquess pmqs@cpan.org
+
diff --git a/lib/DBM_Filter/int32.pm b/lib/DBM_Filter/int32.pm
new file mode 100644
index 0000000000..76d4a11e7d
--- /dev/null
+++ b/lib/DBM_Filter/int32.pm
@@ -0,0 +1,48 @@
+package DBM_Filter::int32 ;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+# todo get Filter to figure endian.
+
+sub Store
+{
+    $_ = 0 if ! defined $_ || $_ eq "" ;
+    $_ = pack("i", $_);
+}
+
+sub Fetch
+{
+    no warnings 'uninitialized';
+    $_ = unpack("i", $_);
+}
+
+1;
+
+__END__
+
+=head1 DBM_Filter::int32
+
+=head1 SYNOPSIS
+
+    use SDBM_File; # or DB_File, or GDBM_File, or NDBM_File, or ODBM_File
+    use DBM_Filter ;
+
+    $db = tie %hash, ...
+    $db->Filter_Push('int32');
+    
+=head1 DESCRIPTION
+
+This DBM filter is used when interoperating with a C/C++ application
+that uses a C int as either the key and/or value in the DBM file.
+
+=head1 SEE ALSO
+
+L<DBM_Filter>, L<perldbmfilter>
+
+=head1 AUTHOR
+
+Paul Marquess pmqs@cpan.org
+
diff --git a/lib/DBM_Filter/null.pm b/lib/DBM_Filter/null.pm
new file mode 100644
index 0000000000..1eb9556629
--- /dev/null
+++ b/lib/DBM_Filter/null.pm
@@ -0,0 +1,50 @@
+package DBM_Filter::null ;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+sub Store
+{
+    no warnings 'uninitialized';
+    $_ .= "\x00" ;
+}
+
+sub Fetch
+{
+    no warnings 'uninitialized';
+    s/\x00$// ;
+}
+
+1;
+
+__END__
+
+=head1 DBM_Filter::null
+
+=head1 SYNOPSIS
+
+    use SDBM_File; # or DB_File, or GDBM_File, or NDBM_File, or ODBM_File
+    use DBM_Filter ;
+
+    $db = tie %hash, ...
+    $db->Filter_Push('null');
+    
+=head1 DESCRIPTION
+
+This filter ensures that all data written to the DBM file is null
+terminated. This is useful when you have a perl script that needs
+to interoperate with a DBM file that a C program also uses. A fairly
+common issue is for the C application to include the terminating null
+in a string when it writes to the DBM file. This filter will ensure that
+all data written to the DBM file can be read by the C application.
+
+
+=head1 SEE ALSO
+
+L<DBM_Filter>, L<perldbmfilter>
+
+=head1 AUTHOR
+
+Paul Marquess pmqs@cpan.org
diff --git a/lib/DBM_Filter/t/01error.t b/lib/DBM_Filter/t/01error.t
new file mode 100644
index 0000000000..4ebbfd8495
--- /dev/null
+++ b/lib/DBM_Filter/t/01error.t
@@ -0,0 +1,236 @@
+
+use strict;
+use warnings;
+use Carp;
+
+use lib '.';
+our $db ;
+
+{
+    chdir 't' if -d 't';
+    if ( ! -d 'DBM_Filter')
+    {
+        mkdir 'DBM_Filter', 0777 
+            || die "Cannot create directory 'DBM_Filter': $!\n" ;
+    }
+}
+
+sub writeFile
+{
+    my $filename = shift ;
+    my $content = shift;
+    open F, ">$filename" || croak "Cannot open $filename: $!" ;
+    print F $content ;
+    close F;
+}
+
+sub runFilter
+{
+    my $name = shift ;
+    my $filter = shift ;
+
+print "# runFilter $name\n" ;
+    my $filename = "DBM_Filter/$name.pm";
+    $filter = "package DBM_Filter::$name ;\n$filter"
+        unless $filter =~ /^\s*package/ ;
+
+    writeFile($filename, $filter);
+    eval { $db->Filter_Push($name) };
+    unlink $filename;
+    return $@;
+}
+
+use Test::More tests => 21;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my %h2 = () ;
+$db = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db, "tied to SDBM_File ok";
+
+
+# Error cases
+
+eval { $db->Filter_Push() ; };
+like $@, qr/^Filter_Push: no parameters present/,
+        "croak if not parameters passed to Filter_Push";
+
+eval { $db->Filter_Push("unknown_class") ; };
+like $@, qr/^Filter_Push: Cannot Load DBM Filter 'DBM_Filter::unknown_class'/, 
+        "croak on unknown class" ;
+
+eval { $db->Filter_Push("Some::unknown_class") ; };
+like $@, qr/^Filter_Push: Cannot Load DBM Filter 'Some::unknown_class'/, 
+        "croak on unknown fully qualified class" ;
+
+eval { $db->Filter_Push('Store') ; };
+like $@, qr/^Filter_Push: not even params/,
+        "croak if not passing even number or params to Filter_Push";
+
+runFilter('bad1', <<'EOM');
+    package DBM_Filter::bad1 ;
+    1;
+EOM
+
+like $@, qr/^Filter_Push: No methods \(Filter, Fetch or Store\) found in class 'DBM_Filter::bad1'/,
+        "croak if none of Filter/Fetch/Store in filter" ;
+
+
+runFilter('bad2', <<'EOM');
+    package DBM_Filter::bad2 ;
+
+    sub Filter
+    {
+        return 2;
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: 'DBM_Filter::bad2::Filter' did not return a hash reference./,
+        "croak if Filter doesn't return hash reference" ;
+
+runFilter('bad3', <<'EOM');
+    package DBM_Filter::bad3 ;
+
+    sub Filter
+    {
+        return { BadKey => sub { } } ;
+
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Unknown key 'BadKey'/,
+        "croak if bad keyword returned from Filter";
+
+runFilter('bad4', <<'EOM');
+    package DBM_Filter::bad4 ;
+
+    sub Filter
+    {
+        return { Store => "abc" } ;
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: value associated with key 'Store' is not a code reference/,
+        "croak if not a code reference";
+
+runFilter('bad5', <<'EOM');
+    package DBM_Filter::bad5 ;
+
+    sub Filter
+    {
+        return { } ;
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: expected both Store & Fetch - got neither/,
+        "croak if neither fetch or store is present";
+
+runFilter('bad6', <<'EOM');
+    package DBM_Filter::bad6 ;
+
+    sub Filter
+    {
+        return { Store => sub {} } ;
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: expected both Store & Fetch - got Store/,
+        "croak if store is present but fetch isn't";
+
+runFilter('bad7', <<'EOM');
+    package DBM_Filter::bad7 ;
+
+    sub Filter
+    {
+        return { Fetch => sub {} } ;
+    }
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: expected both Store & Fetch - got Fetch/,
+        "croak if fetch is present but store isn't";
+
+runFilter('bad8', <<'EOM');
+    package DBM_Filter::bad8 ;
+
+    sub Filter {}
+    sub Store {}
+    sub Fetch {}
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Can't mix Filter with Store and Fetch in class 'DBM_Filter::bad8'/,
+        "croak if Fetch, Store and Filter";
+
+runFilter('bad9', <<'EOM');
+    package DBM_Filter::bad9 ;
+
+    sub Filter {}
+    sub Store {}
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Can't mix Filter with Store and Fetch in class 'DBM_Filter::bad9'/,
+        "croak if Store and Filter";
+
+runFilter('bad10', <<'EOM');
+    package DBM_Filter::bad10 ;
+
+    sub Filter {}
+    sub Fetch {}
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Can't mix Filter with Store and Fetch in class 'DBM_Filter::bad10'/,
+        "croak if Fetch and Filter";
+
+runFilter('bad11', <<'EOM');
+    package DBM_Filter::bad11 ;
+
+    sub Fetch {}
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Missing method 'Store' in class 'DBM_Filter::bad11'/,
+        "croak if Fetch but no Store";
+
+runFilter('bad12', <<'EOM');
+    package DBM_Filter::bad12 ;
+
+    sub Store {}
+
+    1;
+EOM
+
+like $@, qr/^Filter_Push: Missing method 'Fetch' in class 'DBM_Filter::bad12'/,
+        "croak if Store but no Fetch";
+
+undef $db;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/t/02core.t b/lib/DBM_Filter/t/02core.t
new file mode 100644
index 0000000000..fe1dc8c73c
--- /dev/null
+++ b/lib/DBM_Filter/t/02core.t
@@ -0,0 +1,719 @@
+
+use strict;
+use warnings;
+use Carp;
+
+my %files = ();
+
+use lib '.';
+
+{
+    chdir 't' if -d 't';
+    if ( ! -d 'DBM_Filter')
+    {
+        mkdir 'DBM_Filter', 0777 
+            || die "Cannot create directory 'DBM_Filter': $!\n" ;
+    }
+}
+
+
+sub writeFile
+{
+    my $filename = shift ;
+    my $content = shift;
+    open F, ">DBM_Filter/$filename.pm" || croak "Cannot open $filename: $!" ;
+    print F $content ;
+    close F;
+    $files{"DBM_Filter/$filename.pm"} ++;
+}
+
+END { unlink keys %files if keys %files }
+
+use Test::More tests => 189;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+writeFile('times_ten', <<'EOM');
+    package DBM_Filter::times_ten;
+    sub Store { $_ *= 10 }
+    sub Fetch { $_ /= 10 }
+    1;
+EOM
+
+writeFile('append_A', <<'EOM');
+    package DBM_Filter::append_A;
+    sub Store { $_ .= 'A' }
+    sub Fetch { s/A$//    }
+    1;
+EOM
+
+writeFile('append_B', <<'EOM');
+    package DBM_Filter::append_B;
+    sub Store { $_ .= 'B' }
+    sub Fetch { s/B$//    }
+    1;
+EOM
+
+writeFile('append_C', <<'EOM');
+    package DBM_Filter::append_C;
+    sub Store { $_ .= 'C' }
+    sub Fetch { s/C$//    }
+    1;
+EOM
+
+writeFile('append_D', <<'EOM');
+    package DBM_Filter::append_D;
+    sub Store { $_ .= 'D' }
+    sub Fetch { s/D$//    }
+    1;
+EOM
+
+writeFile('append', <<'EOM');
+    package DBM_Filter::append;
+    sub Filter
+    {
+         my $string = shift ;
+         return {
+                    Store => sub { $_ .= $string   },
+                    Fetch => sub { s/${string}$//  }
+                }
+    }
+    1;
+EOM
+
+writeFile('double', <<'EOM');
+    package DBM_Filter::double;
+    sub Store { $_ *= 2 }
+    sub Fetch { $_ /= 2 }
+    1;
+EOM
+
+writeFile('uc', <<'EOM');
+    package DBM_Filter::uc;
+    sub Store { $_ = uc $_ }
+    sub Fetch { $_ = lc $_ }
+    1;
+EOM
+
+writeFile('reverse', <<'EOM');
+    package DBM_Filter::reverse;
+    sub Store { $_ = reverse $_ }
+    sub Fetch { $_ = reverse $_ }
+    1;
+EOM
+
+
+my %PreData = (
+	'abc'	=> 'def',
+	'123'	=> '456',
+	);
+
+my %PostData = (
+	'alpha'	=> 'beta',
+	'green'	=> 'blue',
+	);
+
+sub doPreData
+{
+    my $h = shift ;
+
+    $$h{"abc"} = "def";
+    $$h{"123"} = "456";
+    ok $$h{"abc"} eq "def", "read eq written" ;
+    ok $$h{"123"} eq "456", "read eq written" ;
+
+}
+
+sub doPostData
+{
+    my $h = shift ;
+
+    no warnings 'uninitialized';
+    $$h{undef()} = undef();
+    $$h{"alpha"} = "beta";
+    $$h{"green"} = "blue";
+    ok $$h{""} eq "", "read eq written" ;
+    ok $$h{"green"} eq "blue", "read eq written" ;
+    ok $$h{"green"} eq "blue", "read eq written" ;
+
+}
+
+sub checkRaw
+{
+    my $filename = shift ;
+    my %expected = @_ ;
+    my %h;
+
+    # read the dbm file without the filter
+    ok tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), "tied to SDBM_File";
+
+    my %bad = ();
+    while (my ($k, $v) = each %h) {
+        if ( defined $expected{$k} &&  $expected{$k} eq $v ) {
+            delete $expected{$k} ;
+        }
+        else
+          { $bad{$k} = $v }
+    }
+
+    ok keys(%expected) + keys(%bad) == 0, "Raw hash is ok"; 
+
+    if ( keys(%expected) + keys(%bad) ) {
+        my $bad = "Expected does not match actual\nExpected:\n" ;
+        while (my ($k, $v) = each %expected) {
+            $bad .= "\t'$k' =>\t'$v'\n";
+        }
+        $bad .= "\nGot:\n" ;
+        while (my ($k, $v) = each %bad) {
+            $bad .= "\t'$k' =>\t'$v'\n";
+        }
+        diag $bad ;
+    }
+    
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+    unlink <Op_dbmx*>;
+}
+
+{
+    #diag "Test Set: Key and Value Filter, no stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'A'	=> 'A',
+	    'alphaA'	=> 'betaA',
+	    'greenA'	=> 'blueA';
+
+}
+
+{
+    #diag "Test Set: Key Only Filter, no stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Key_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'A'	=> '',
+	    'alphaA'	=> 'beta',
+	    'greenA'	=> 'blue';
+
+}
+
+{
+    #diag "Test Set: Value Only Filter, no stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Value_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    ''	=> 'A',
+	    'alpha'	=> 'betaA',
+	    'green'	=> 'blueA';
+
+}
+
+{
+    #diag "Test Set: Key and Value Filter, with stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'AB'	=> 'AB',
+	    'alphaAB'	=> 'betaAB',
+	    'greenAB'	=> 'blueAB';
+
+}
+
+{
+    #diag "Test Set: Key Filter != Value Filter, with stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Value_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { $db->Filter_Value_Push('append_C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_D') };
+    is $@, '', "push 'append_D' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'BD'	=> 'AC',
+	    'alphaBD'	=> 'betaAC',
+	    'greenBD'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Key only Filter, with stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Key_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_D') };
+    is $@, '', "push 'append_D' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'BD'	=> '',
+	    'alphaBD'	=> 'beta',
+	    'greenBD'	=> 'blue';
+
+}
+
+{
+    #diag "Test Set: Value only Filter, with stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Value_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Value_Push('append_C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    ''	=> 'AC',
+	    'alpha'	=> 'betaAC',
+	    'green'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Combination Key/Value + Key Filter != Value Filter, with stacking, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Value_Push('append_C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_D') };
+    is $@, '', "push 'append_D' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'AD'	=> 'AC',
+	    'alphaAD'	=> 'betaAC',
+	    'greenAD'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Combination Key/Value + Key + Key/Value, no closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append_A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { $db->Filter_Push('append_C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'ABC'	=> 'AC',
+	    'alphaABC'	=> 'betaAC',
+	    'greenABC'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Combination Key/Value + Key + Key/Value, with closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append' => 'A') };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Key_Push('append' => 'B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { $db->Filter_Push('append' => 'C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'ABC'	=> 'AC',
+	    'alphaABC'	=> 'betaAC',
+	    'greenABC'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { 
+        $db->Filter_Push(
+                Store => sub { $_ .= 'A' },
+                Fetch => sub { s/A$//    }) };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { 
+        $db->Filter_Key_Push(
+                Store => sub { $_ .= 'B' },
+                Fetch => sub { s/B$//    }) };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { 
+        $db->Filter_Push(
+                Store => sub { $_ .= 'C' },
+                Fetch => sub { s/C$//    }) };
+    is $@, '', "push 'append_C' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'ABC'	=> 'AC',
+	    'alphaABC'	=> 'betaAC',
+	    'greenABC'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Combination Key/Value + Key + Key/Value, immediate, closure";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { 
+        $db->Filter_Push(
+                Store => sub { $_ .= 'A' },
+                Fetch => sub { s/A$//    }) };
+    is $@, '', "push 'append_A' filter" ;
+    
+    eval { $db->Filter_Key_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    eval { $db->Filter_Push('append' => 'C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'ABC'	=> 'AC',
+	    'alphaABC'	=> 'betaAC',
+	    'greenABC'	=> 'blueAC';
+
+}
+
+{
+    #diag "Test Set: Filtered & Filter_Pop";
+
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    ok ! $db->Filtered, "not filtered" ;
+
+    eval { 
+        $db->Filter_Push(
+                Store => sub { $_ .= 'A' },
+                Fetch => sub { s/A$//    }) };
+    is $@, '', "push 'append_A' filter" ;
+    
+    ok $db->Filtered, "is filtered" ;
+
+    eval { $db->Filter_Key_Push('append_B') };
+    is $@, '', "push 'append_B' filter" ;
+    
+    ok $db->Filtered, "is filtered" ;
+    
+    eval { $db->Filter_Push('append' => 'C') };
+    is $@, '', "push 'append_C' filter" ;
+    
+    ok $db->Filtered, "is filtered" ;
+    
+    doPostData(\%h);
+    
+    eval { $db->Filter_Pop() };
+    is $@, '', "Filter_Pop";
+    
+    ok $db->Filtered, "is filtered" ;
+
+    $h{'after'} = 'noon';
+    is $h{'after'}, 'noon', "read eq written";
+
+    eval { $db->Filter_Pop() };
+    is $@, '', "Filter_Pop";
+    
+    ok $db->Filtered, "is filtered" ;
+
+    $h{'morning'} = 'after';
+    is $h{'morning'}, 'after', "read eq written";
+
+    eval { $db->Filter_Pop() };
+    is $@, '', "Filter_Pop";
+    
+    ok ! $db->Filtered, "not filtered" ;
+
+    $h{'and'} = 'finally';
+    is $h{'and'}, 'finally', "read eq written";
+
+    eval { $db->Filter_Pop() };
+    is $@, '', "Filter_Pop";
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'ABC'	=> 'AC',
+	    'alphaABC'	=> 'betaAC',
+	    'greenABC'	=> 'blueAC',
+	    'afterAB'	=> 'noonA',
+	    'morningA'	=> 'afterA',
+	    'and'	=> 'finally';
+
+}
+
+{
+    #diag "Test Set: define the filter package in-line";
+
+    {
+        package DBM_Filter::append_X;
+
+        sub Store { $_ .= 'X' }
+        sub Fetch { s/X$//    }
+    }
+    
+    my %h = () ;
+    my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+    ok $db, "tied to SDBM_File";
+    
+    doPreData(\%h);
+
+    eval { $db->Filter_Push('append_X') };
+    is $@, '', "push 'append_X' filter" ;
+    
+    doPostData(\%h);
+    
+    undef $db;
+    {
+        use warnings FATAL => 'untie';
+        eval { untie %h };
+        is $@, '', "untie without inner references" ;
+    }
+
+    checkRaw 'Op_dbmx', 
+	    'abc'	=> 'def',
+	    '123'	=> '456',
+	    'X'  	=> 'X',
+	    'alphaX'	=> 'betaX',
+	    'greenX'	=> 'blueX';
+
+}
+
diff --git a/lib/DBM_Filter/t/compress.t b/lib/DBM_Filter/t/compress.t
new file mode 100644
index 0000000000..b7f04bb57b
--- /dev/null
+++ b/lib/DBM_Filter/t/compress.t
@@ -0,0 +1,111 @@
+
+use strict;
+use warnings;
+use Carp;
+
+BEGIN 
+{
+    eval { require Compress::Zlib ; };
+    if ($@) {
+        print "1..0 # Skip: Compress::Zlib is not available\n";
+print "# $@\n";
+        exit 0;
+    }
+}
+require "dbm_filter_util.pl";
+
+use Test::More tests => 23;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+BEGIN { use_ok('Compress::Zlib') };
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db1, "tied to SDBM_File";
+
+# store before adding the filter
+
+StoreData(\%h1,
+	{	
+		1234	=> 5678,
+		-3	=> -5,
+		"22"	=> "88",
+		"-45"	=> "-88",
+		"fred"	=> "Joe",
+		"alpha"	=> "Alpha",
+		"Beta"	=> "beta",
+	});
+
+VerifyData(\%h1,
+	{
+		1234	=> 5678,
+		-3	=> -5,
+		"22"	=> "88",
+		"-45"	=> "-88",
+		"fred"	=> "Joe",
+		"alpha"	=> "Alpha",
+		"Beta"	=> "beta",
+	});
+
+
+eval { $db1->Filter_Push('compress') };
+is $@, '', "push a 'compress' filter" ;
+
+{
+    no warnings 'uninitialized';
+    StoreData(\%h1,
+	{	
+		undef()	=> undef(),
+		"400"	=> "500",
+		0	=> 1,
+		1	=> 0,
+		"abc"	=> "de0",
+		"\x00\x01"	=> "\x03\xFF",
+	});
+
+}
+
+undef $db1;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
+# read the dbm file without the filter
+my %h2 = () ;
+my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db2, "tied to SDBM_File";
+
+VerifyData(\%h2,
+	{
+		1234	=> 5678,
+		-3	=> -5,
+		"22"	=> "88",
+		"-45"	=> "-88",
+		"fred"	=> "Joe",
+		"alpha"	=> "Alpha",
+		"Beta"	=> "beta",
+
+		compress("")	=> compress(""),
+		compress("400")	=> compress("500"),
+		compress("0")	=> compress("1"),
+		compress("1")	=> compress("0"),
+		compress("abc")	=> compress("de0"),
+		compress("\x00\x01")	=> compress("\x03\xFF"),
+	});
+
+undef $db2;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h2 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/t/encode.t b/lib/DBM_Filter/t/encode.t
new file mode 100644
index 0000000000..7b71a98b2e
--- /dev/null
+++ b/lib/DBM_Filter/t/encode.t
@@ -0,0 +1,105 @@
+
+use strict;
+use warnings;
+use Carp;
+
+
+BEGIN 
+{
+
+    eval { require Encode; };
+    
+    if ($@) {
+        print "1..0 #  Skip: Encode is not available\n";
+        exit 0;
+    }
+}
+
+
+require "dbm_filter_util.pl";
+
+use Test::More tests => 26;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+BEGIN { use_ok('charnames', qw{greek})};
+
+use charnames qw{greek};
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db1, "tied to SDBM_File";
+
+eval { $db1->Filter_Push('encode' => 'blah') };
+like $@, qr/^Encoding 'blah' is not available/, "push an illigal filter" ;
+
+eval { $db1->Filter_Push('encode') };
+is $@, '', "push an 'encode' filter (default to utf-8)" ;
+
+
+{
+    no warnings 'uninitialized';
+    StoreData(\%h1,
+	{	
+		undef()	=> undef(),
+		'alpha'	=> "\N{alpha}",
+		"\N{gamma}"=> "gamma",
+		"beta"	=> "\N{beta}",
+	});
+
+}
+
+VerifyData(\%h1,
+	{
+		'alpha'	=> "\N{alpha}",
+		"beta"	=> "\N{beta}",
+		"\N{gamma}"=> "gamma",
+		""		=> "",
+	});
+
+eval { $db1->Filter_Pop() };
+is $@, '', "pop the 'utf8' filter" ;
+
+eval { $db1->Filter_Push('encode' => 'iso-8859-16') };
+is $@, '', "push an 'encode' filter (specify iso-8859-16)" ;
+
+use charnames qw{:full};
+StoreData(\%h1,
+	{	
+		'euro'	=> "\N{EURO SIGN}",
+	});
+
+undef $db1;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
+# read the dbm file without the filter
+my %h2 = () ;
+my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db2, "tied to SDBM_File";
+
+VerifyData(\%h2,
+	{
+		'alpha'	=> "\xCE\xB1",
+		'beta'	=> "\xCE\xB2",
+		"\xCE\xB3"=> "gamma",
+		'euro'	=> "\xA4",
+		""		=> "",
+	});
+
+undef $db2;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h2 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/t/int32.t b/lib/DBM_Filter/t/int32.t
new file mode 100644
index 0000000000..5cdadde057
--- /dev/null
+++ b/lib/DBM_Filter/t/int32.t
@@ -0,0 +1,90 @@
+
+use strict;
+use warnings;
+use Carp;
+
+require "dbm_filter_util.pl";
+
+use Test::More tests => 22;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db1, "tied to SDBM_File";
+
+# store before adding the filter
+
+StoreData(\%h1,
+	{	
+		1234	=> 5678,
+		-3	=> -5,
+		"22"	=> "88",
+		"-45"	=> "-88",
+	});
+
+VerifyData(\%h1,
+	{
+		1234	=> 5678,
+		-3	=> -5,
+		22	=> 88,
+		-45	=> -88,
+	});
+
+
+eval { $db1->Filter_Push('int32') };
+is $@, '', "push an 'int32' filter" ;
+
+{
+    no warnings 'uninitialized';
+    StoreData(\%h1,
+	{	
+		undef()	=> undef(),
+		"400"	=> "500",
+		0	=> 1,
+		1	=> 0,
+		-47	=> -6,
+	});
+
+}
+
+undef $db1;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
+# read the dbm file without the filter
+my %h2 = () ;
+my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db2, "tied to SDBM_File";
+
+VerifyData(\%h2,
+	{
+		1234	=> 5678,
+		-3	=> -5,
+		22	=> 88,
+		-45	=> -88,
+
+		#undef()	=> undef(),
+		pack("i", 400)	=> pack("i", 500),
+		pack("i", 0)	=> pack("i", 1),
+		pack("i", 1)	=> pack("i", 0),
+		pack("i", -47)	=> pack("i", -6),
+	});
+
+undef $db2;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h2 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/t/null.t b/lib/DBM_Filter/t/null.t
new file mode 100644
index 0000000000..2d1c22a8af
--- /dev/null
+++ b/lib/DBM_Filter/t/null.t
@@ -0,0 +1,86 @@
+
+use strict;
+use warnings;
+use Carp;
+
+require "dbm_filter_util.pl";
+
+use Test::More tests => 26;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db1, "tied to SDBM_File";
+
+# store before adding the filter
+
+StoreData(\%h1,
+	{	
+		"abc"	=> "def",
+	});
+
+VerifyData(\%h1,
+	{
+		"abc"	=> "def",
+	});
+
+
+eval { $db1->Filter_Push('null') };
+is $@, '', "push a 'null' filter" ;
+
+{
+    no warnings 'uninitialized';
+    StoreData(\%h1,
+	{	
+		undef()	=> undef(),
+		"alpha"	=> "beta",
+	});
+
+    VerifyData(\%h1,
+	{
+		undef()	=> undef(),
+		"abc"	=> "", # not "def", because the filter is in place
+		"alpha"	=> "beta", 
+	});
+}
+
+    while (my ($k, $v) = each %h1) {
+        no warnings 'uninitialized';
+        #diag "After Match [$k][$v]"; 
+    }
+
+
+undef $db1;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
+# read the dbm file without the filter, check for null termination
+my %h2 = () ;
+my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db2, "tied to SDBM_File";
+
+VerifyData(\%h2,
+	{
+		"abc"		=> "def",
+		"alpha\x00"	=> "beta\x00",
+		"\x00"		=> "\x00",
+	});
+
+undef $db2;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h2 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/t/utf8.t b/lib/DBM_Filter/t/utf8.t
new file mode 100644
index 0000000000..e37afa2d4a
--- /dev/null
+++ b/lib/DBM_Filter/t/utf8.t
@@ -0,0 +1,86 @@
+
+use strict;
+use warnings;
+use Carp;
+
+BEGIN 
+{
+
+    eval { require Encode; };
+    
+    if ($@) {
+        print "1..0 #  Skip: Encode is not available\n";
+        exit 0;
+    }
+}
+
+require "dbm_filter_util.pl";
+
+use Test::More tests => 20;
+
+BEGIN { use_ok('DBM_Filter') };
+BEGIN { use_ok('SDBM_File') };
+BEGIN { use_ok('Fcntl') };
+BEGIN { use_ok('charnames', qw{greek})};
+
+use charnames qw{greek};
+
+unlink <Op_dbmx*>;
+END { unlink <Op_dbmx*>; }
+
+my %h1 = () ;
+my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db1, "tied to SDBM_File";
+
+eval { $db1->Filter_Push('utf8') };
+is $@, '', "push a 'utf8' filter" ;
+
+{
+    no warnings 'uninitialized';
+    StoreData(\%h1,
+	{	
+		undef()	=> undef(),
+		"beta"	=> "\N{beta}",
+		'alpha'	=> "\N{alpha}",
+		"\N{gamma}"=> "gamma",
+	});
+
+}
+
+VerifyData(\%h1,
+	{
+		'alpha'	=> "\N{alpha}",
+		"beta"	=> "\N{beta}",
+		"\N{gamma}"=> "gamma",
+		""		=> "",
+	});
+
+undef $db1;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h1 };
+    is $@, '', "untie without inner references" ;
+}
+
+# read the dbm file without the filter
+my %h2 = () ;
+my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
+
+ok $db2, "tied to SDBM_File";
+
+VerifyData(\%h2,
+	{
+		'alpha'	=> "\xCE\xB1",
+		'beta'	=> "\xCE\xB2",
+		"\xCE\xB3"=> "gamma",
+		""		=> "",
+	});
+
+undef $db2;
+{
+    use warnings FATAL => 'untie';
+    eval { untie %h2 };
+    is $@, '', "untie without inner references" ;
+}
+
diff --git a/lib/DBM_Filter/utf8.pm b/lib/DBM_Filter/utf8.pm
new file mode 100644
index 0000000000..89d8238568
--- /dev/null
+++ b/lib/DBM_Filter/utf8.pm
@@ -0,0 +1,50 @@
+package DBM_Filter::utf8 ;
+
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.01';
+
+BEGIN
+{
+    eval { require Encode; };
+
+    croak "Encode module not found.\n"
+        if $@;
+}
+
+sub Store { $_ = Encode::encode_utf8($_) if defined $_ }
+
+sub Fetch { $_ = Encode::decode_utf8($_) if defined $_ }
+
+1;
+
+__END__
+
+=head1 DBM_Filter::utf8
+
+=head1 SYNOPSIS
+
+    use SDBM_File; # or DB_File, or GDBM_File, or NDBM_File, or ODBM_File
+    use DBM_Filter ;
+    
+
+    $db = tie %hash, ...
+    $db->Filter_Push('utf8');
+    
+=head1 DESCRIPTION
+
+This Filter will ensure that all data written to the DBM will be encoded
+in UTF-8.
+
+This module uses the Encode module.
+
+=head1 SEE ALSO
+
+L<DBM_Filter>, L<perldbmfilter>, L<Encode>
+
+=head1 AUTHOR
+
+Paul Marquess pmqs@cpan.org
+