Get rid of Qpsmtpd::DB::File

DBM is probably the only file format we'll ever support anyhow

lib/Qpsmtpd/DB/File.pm

@@ -1,34 +0,0 @@
-package Qpsmtpd::DB::File;
-use strict;
-use warnings;
-use parent 'Qpsmtpd::DB';
-
-sub dir {
-    my ( $self, @candidate_dirs ) = @_;
-    return $self->{dir} if $self->{dir} and ! @candidate_dirs;
-    push @candidate_dirs, ( $self->qphome . '/var/db', $self->qphome . '/config' );
-    for my $d ( @candidate_dirs ) {
-        next if ! $self->validate_dir($d);
-        return $self->{dir} = $d; # first match wins
-    }
-}
-
-sub validate_dir {
-    my ( $self, $d ) = @_;
-    return 0 if ! $d;
-    return 0 if ! -d $d;
-    return 1;
-}
-
-sub qphome {
-    my ( $self ) = @_;
-    my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
-    return $QPHOME;
-}
-
-sub path {
-    my ( $self ) = @_;
-    return $self->dir . '/' . $self->name . $self->file_extension;
-}
-
-1;

lib/Qpsmtpd/DB/File/DBM.pm

@@ -2,7 +2,7 @@ package Qpsmtpd::DB::File::DBM;
 use strict;
 use warnings;
 
-use parent 'Qpsmtpd::DB::File';
+use parent 'Qpsmtpd::DB';
 
 BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
 use AnyDBM_File;
@@ -13,11 +13,6 @@ sub new {
     return bless {%arg}, $class;
 }
 
-sub file_extension {
-    my ( $self, $extension ) = @_;
-    return $self->{file_extension} ||= '.dbm';
-}
-
 sub lock {
     my ( $self ) = @_;
     if ( $self->nfs_locking ) {
@@ -184,4 +179,32 @@ sub flush {
     delete $tied->{$_} for keys %$tied;
 }
 
+sub dir {
+    my ( $self, @candidate_dirs ) = @_;
+    return $self->{dir} if $self->{dir} and ! @candidate_dirs;
+    push @candidate_dirs, ( $self->qphome . '/var/db', $self->qphome . '/config' );
+    for my $d ( @candidate_dirs ) {
+        next if ! $self->validate_dir($d);
+        return $self->{dir} = $d; # first match wins
+    }
+}
+
+sub validate_dir {
+    my ( $self, $d ) = @_;
+    return 0 if ! $d;
+    return 0 if ! -d $d;
+    return 1;
+}
+
+sub qphome {
+    my ( $self ) = @_;
+    my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
+    return $QPHOME;
+}
+
+sub path {
+    my ( $self ) = @_;
+    return $self->dir . '/' . $self->name . '.dbm';
+}
+
 1;

plugins/greylisting

@@ -268,8 +268,6 @@ sub init_dbm {
     $cdir = $1 if $cdir and $cdir =~ m{^([-a-zA-Z0-9./_]+)$};
     # greylisting-specific hints for where to store the greylist DB
     my $db_dir = $self->db->dir( $cdir, '/var/lib/qpsmtpd/greylisting' );
-
-    return 1 if $self->db->file_extension ne '.dbm';
     $self->db->nfs_locking( $self->{_args}{nfslock} );
     
     # Work around old DBM filename

plugins/karma

@@ -262,8 +262,6 @@ sub init_db {
     my $cdir = $self->{_args}{db_dir};
     # karma-specific hints for where to store the DB
     $self->db->dir( $cdir, '/var/lib/qpsmtpd/karma' );
-
-    return if $self->db->file_extension ne '.dbm';
     $self->db->nfs_locking( $self->{_args}{nfslock} );
 }
 

t/qpsmtpd-db-file-dbm.t

@@ -18,6 +18,9 @@ __delete();
 __get_keys();
 __size();
 __flush();
+__qphome();
+__validate_dir();
+__dir();
 __untie_gotcha();
 
 done_testing();
@@ -101,6 +104,29 @@ sub __flush {
     $db->unlock;
 }
 
+sub __qphome {
+    is( $db->qphome, 't', 'qphome()' );
+}
+
+sub __validate_dir {
+    is( $db->validate_dir(),      0, 'validate_dir(): false on no input' );
+    is( $db->validate_dir(undef), 0, 'validate_dir(): false on undef' );
+    is( $db->validate_dir('invalid'), 0,
+        'validate_dir(): false for non-existent directory' );
+    is( $db->validate_dir('t/tmp'), 1,
+        'validate_dir(): true for real directory' );
+}
+
+sub __dir {
+    my $db2 = Qpsmtpd::DB::File::DBM->new( name => 'dirtest' );
+    is( $db2->dir(), 't/config', 'default directory' );
+    is( $db2->dir('_invalid','t/Test'), 't/Test', 'skip invalid candidate dirs' );
+    $db2->{dir} = '_cached';
+    is( $db2->dir(), '_cached', 'cached directory' );
+    is( $db2->dir('t/Test'), 't/Test', 'passing candidate dirs resets cache' );
+    is( $db2->dir('_invalid'), 't/config', 'invalid candidate dirs reverts to default' );
+}
+
 sub __untie_gotcha {
     # Regression test for 'gotcha' with untying hash that never goes away
     $db->lock;

t/qpsmtpd-db-file.t

@@ -1,47 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-use lib 'lib';    # test lib/Qpsmtpd (vs site_perl)
-use lib 't';
-
-use_ok('Qpsmtpd::DB::File');
-
-__qphome();
-__validate_dir();
-__dir();
-
-done_testing();
-
-sub __qphome {
-    my $db = FakeDB->new;
-    is( $db->qphome, 't', 'qphome()' );
-}
-
-sub __validate_dir {
-    my $db = FakeDB->new;
-    is( $db->validate_dir(),      0, 'validate_dir(): false on no input' );
-    is( $db->validate_dir(undef), 0, 'validate_dir(): false on undef' );
-    is( $db->validate_dir('invalid'), 0,
-        'validate_dir(): false for non-existent directory' );
-    is( $db->validate_dir('t/config'), 1,
-        'validate_dir(): true for real directory' );
-}
-
-sub __dir {
-    my $db = FakeDB->new;
-    is( $db->dir(), 't/config', 'default directory' );
-    is( $db->dir('_invalid','t/Test'), 't/Test', 'skip invalid candidate dirs' );
-    $db->{dir} = '_cached';
-    is( $db->dir(), '_cached', 'cached directory' );
-    is( $db->dir('t/Test'), 't/Test', 'passing candidate dirs resets cache' );
-    is( $db->dir('_invalid'), 't/config', 'invalid candidate dirs reverts to default' );
-}
-
-package FakeDB;
-use parent 'Qpsmtpd::DB::File';
-sub new {
-    my $class = shift;
-    return bless {@_}, $class;
-}