Pass multiple keys to del() to speed up prune_db()

lib/Qpsmtpd/DB/File/DBM.pm

@@ -159,17 +159,19 @@ sub size {
 }
 
 sub delete {
-    my ( $self, $key ) = @_;
+    my ( $self, @keys ) = @_;
     my $tied = $self->{tied};
     if ( ! $tied ) {
         warn "DBM db not yet set up, delete() failed\n";
         return;
     }
-    if ( ! $key ) {
+    if ( ! @keys ) {
         warn "No key provided, delete() failed\n";
         return;
     }
-    delete $tied->{$key};
+    @keys = grep { exists $tied->{$_} } @keys;
+    delete @$tied{@keys};
+    return scalar @keys;
 }
 
 sub flush {

lib/Qpsmtpd/DB/Redis.pm

@@ -91,12 +91,12 @@ sub set {
 }
 
 sub delete {
-    my ( $self, $key ) = @_;
+    my ( $self, @keys ) = @_;
-    if ( ! $key ) {
+    if ( ! @keys ) {
         warn "No key provided, delete() failed\n";
         return;
     }
-    return $self->redis->del($key);
+    return $self->redis->del(@keys);
 }
 
 sub get_keys { shift->redis->keys('*') }

plugins/greylisting

@@ -489,7 +489,7 @@ sub prune_db {
     $self->db->lock or return;
     my $count = $self->db->size;
 
-    my $pruned = 0;
+    my @to_delete;
     my $greylist = {};
     my @keys = $self->db->get_keys or return;
     @$greylist{ @keys } = ( $self->db->mget(@keys) );
@@ -497,9 +497,10 @@ sub prune_db {
         my ($ts) = split /:/, delete $greylist->{$key};
         my $age = $self->now - $ts;
         next if $age < $self->{_args}{white_timeout};
-        $pruned++;
+        push @to_delete, $key;
-        $self->db->delete($key);
     }
+    return if ! @to_delete;
+    my $pruned = $self->db->delete(@to_delete);
     $self->db->unlock;
     $self->log(LOGINFO, "pruned $pruned of $count DB entries");
 }

t/qpsmtpd-db-file-dbm.t

@@ -56,8 +56,18 @@ sub __delete {
     $db->flush;
     $db->set( oink  => 1 );
     $db->set( quack => 1 );
-    $db->delete('quack');
+    $db->set( woof  => 1 );
-    is( join( '|', $db->get_keys ), 'oink', 'delete() removes key' );
+    $db->set( moo   => 1 );
+    is( $db->delete('quack'), 1,
+        'delete() return value when removing a single key' );
+    is( join( '|', sort $db->get_keys ), 'moo|oink|woof',
+        'delete() removes a single key' );
+    is( $db->delete(qw( moo oink )), 2,
+        'delete() return value when removing a single key' );
+    is( join( '|', sort $db->get_keys ), 'woof',
+        'delete() removes two keys' );
+    is( $db->delete('noop'), 0,
+        'delete() return value when removing a non-existent key' );
     $db->unlock;
 }
 

t/qpsmtpd-db-redis.t

@@ -115,8 +115,19 @@ sub __delete {
     $redis->flushdb;
     $redis->set( oink  => 1 );
     $redis->set( quack => 1 );
-    $db->delete('quack');
+    $redis->set( woof  => 1 );
-    is( join( '|', $redis->keys('*') ), 'oink', 'delete() removes key' );
+    $redis->set( moo   => 1 );
+
+    is( $db->delete('quack'), 1,
+        'delete() return value when removing a single key' );
+    is( join( '|', sort $redis->keys('*') ), 'moo|oink|woof',
+        'delete() removes a single key' );
+    is( $db->delete(qw( moo oink )), 2,
+        'delete() return value when removing a single key' );
+    is( join( '|', sort $redis->keys('*') ), 'woof',
+        'delete() removes two keys' );
+    is( $db->delete('noop'), 0,
+        'delete() return value when removing a non-existent key' );
 }
 
 sub __get_keys {
@@ -158,7 +169,14 @@ sub select   { $_[0]->{selected} = $_[1] }
 sub dbsize   { scalar keys %{ $_[0]->fakestore }   }
 sub get      { $_[0]->fakestore->{ $_[1] }         }
 sub set      { $_[0]->fakestore->{ $_[1] } = $_[2] }
-sub del      { delete $_[0]->fakestore->{ $_[1] }  }
+
+sub del {
+    my ($self,@keys) = @_;
+    my $f = $self->fakestore;
+    @keys = grep { exists $f->{$_} } @keys;
+    delete @$f{ @keys };
+    return scalar @keys;
+}
 
 sub mget {
     my ($self,@keys) = @_;