From e3187ace0d6f08f3638360c20a45229026e2392c Mon Sep 17 00:00:00 2001
From: Jared Johnson <jjohnson@efolder.net>
Date: Wed, 21 Jan 2015 16:32:11 -0600
Subject: [PATCH 1/2] Add tests for Qpsmtpd::DB::File::DBM

---
 t/qpsmtpd-db-file-dbm.t | 80 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 t/qpsmtpd-db-file-dbm.t

diff --git a/t/qpsmtpd-db-file-dbm.t b/t/qpsmtpd-db-file-dbm.t
new file mode 100644
index 0000000..c43aba2
--- /dev/null
+++ b/t/qpsmtpd-db-file-dbm.t
@@ -0,0 +1,80 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'lib';    # test lib/Qpsmtpd (vs site_perl)
+use lib 't';
+
+use_ok('Qpsmtpd::DB::File::DBM');
+
+my $db = Qpsmtpd::DB::File::DBM->new( name => 'testing' );
+__new();
+__get();
+__set();
+__delete();
+__get_keys();
+__size();
+__flush();
+
+done_testing();
+
+sub __new {
+    is( ref $db, 'Qpsmtpd::DB::File::DBM', 'Qpsmtpd::DB::File::DBM object created' );
+}
+
+sub __get {
+    $db->lock;
+    $db->flush;
+    $db->set( moo => 'oooo' );
+    is( $db->get('moo'), 'oooo', 'get() retrieves key' );
+    $db->unlock;
+}
+
+sub __set {
+    $db->lock;
+    $db->flush;
+    $db->set( mee => 'ow' );
+    is( $db->get('mee'), 'ow', 'set() stores key' );
+    $db->unlock;
+}
+
+sub __delete {
+    $db->lock;
+    $db->flush;
+    $db->set( oink  => 1 );
+    $db->set( quack => 1 );
+    $db->delete('quack');
+    is( join( '|', $db->get_keys ), 'oink', 'delete() removes key' );
+    $db->unlock;
+}
+
+sub __get_keys {
+    $db->lock;
+    $db->flush;
+    $db->set( asdf   => 1 );
+    $db->set( qwerty => 1 );
+    is( join( '|', sort $db->get_keys ), 'asdf|qwerty',
+        'get_keys() lists all keys in the db' );
+    $db->unlock;
+}
+
+sub __size {
+    $db->lock;
+    $db->flush;
+    $db->set( baz  => 1 );
+    $db->set( blah => 1 );
+    is( $db->size, 2, 'size() shows key count for db' );
+    $db->unlock;
+}
+
+sub __flush {
+    $db->lock;
+    $db->flush;
+    $db->set( bogus => 1 );
+    is( join( '|', $db->get_keys ), 'bogus', 'DBM db populated' );
+    $db->flush;
+    is( join( '|', $db->get_keys ), '', 'flush() empties db' );
+    $db->unlock;
+}
+

From e76b6a9048d49111f2cdeaef3117df4ccf0e5c65 Mon Sep 17 00:00:00 2001
From: Jared Johnson <jjohnson@efolder.net>
Date: Wed, 21 Jan 2015 16:43:23 -0600
Subject: [PATCH 2/2] Fix consistency problems with DBM store

Destroy the AnyDBM-tied hash after untying

Google's wisdom seems to indicate that leaving the AnyDBM-tied hash around after
untying it was causing data to not flush to the DBM file... or something. At any
rate the regression test added here confirms inconsistency when using multiple
instances which is fixed by destroying the AnyDBM-tied hash after untying.
---
 lib/Qpsmtpd/DB/File/DBM.pm |  1 +
 t/qpsmtpd-db-file-dbm.t    | 15 +++++++++++++++
 2 files changed, 16 insertions(+)

diff --git a/lib/Qpsmtpd/DB/File/DBM.pm b/lib/Qpsmtpd/DB/File/DBM.pm
index 914aeed..1892833 100644
--- a/lib/Qpsmtpd/DB/File/DBM.pm
+++ b/lib/Qpsmtpd/DB/File/DBM.pm
@@ -93,6 +93,7 @@ sub unlock {
     my ( $self ) = @_;
     close $self->{lock};
     untie $self->{tied};
+    delete $self->{tied};
 }
 
 sub get {
diff --git a/t/qpsmtpd-db-file-dbm.t b/t/qpsmtpd-db-file-dbm.t
index c43aba2..b9871ac 100644
--- a/t/qpsmtpd-db-file-dbm.t
+++ b/t/qpsmtpd-db-file-dbm.t
@@ -16,6 +16,7 @@ __delete();
 __get_keys();
 __size();
 __flush();
+__untie_gotcha();
 
 done_testing();
 
@@ -78,3 +79,17 @@ sub __flush {
     $db->unlock;
 }
 
+sub __untie_gotcha {
+    # Regression test for 'gotcha' with untying hash that never goes away
+    $db->lock;
+    $db->flush;
+    $db->set( cut => 'itout' );
+    $db->unlock;
+    my $db2 = Qpsmtpd::DB::File::DBM->new( name => 'testing' );
+    $db2->lock;
+    is( $db2->get('cut'), 'itout',
+        'get() in second db handle reads key set in first handle' );
+    $db2->unlock;
+    $db->flush;
+    $db2->flush;
+}