Merge pull request #169 from jaredj/hook-testing

Generalize hook testing

t/Test/Qpsmtpd.pm

@@ -118,4 +118,65 @@ sub run_plugin_tests {
     $Test->done_testing();
 }
 
+sub fake_hook {
+    ###########################################################################
+    # Inserts a given subroutine into the beginning of the set of hooks already
+    # in place. Used to test code against different potential plugins it will
+    # interact with. For example, to test behavior against various results of
+    # the data_post hook:
+    #
+    # $self->fake_hook('data_post',sub { return DECLINED };
+    # ok(...);
+    # $self->fake_hook('data_post',sub { return DENYSOFT };
+    # ok(...);
+    # $self->fake_hook('data_post',sub { return DENY };
+    # ok(...);
+    # $self->fake_hook('data_post',sub { return DENY_DISCONNECT };
+    # ok(...);
+    # $self->unfake_hook('data_post');
+    ###########################################################################
+    my ( $self, $hook, $sub ) = @_;
+    unshift @{ $self->hooks->{$hook} ||= [] },
+        {
+            name => '___FakeHook___',
+            code => $sub,
+        };
+}
+
+sub unfake_hook {
+    my ( $self, $hook ) = @_;
+    $self->hooks->{$hook} = [
+        grep { $_->{name} ne '___FakeHook___' }
+        @{ $self->hooks->{$hook} || [] }
+    ];
+}
+
+sub fake_config {
+    ####################################################################
+    # Used to test code against various possible configurations
+    # For example, to test against various possible config('me') values:
+    #
+    # $self->fake_config( me => '***invalid***' );
+    # ok(...);
+    # $self->fake_config( me => 'valid-nonfqdn' );
+    # ok(...);
+    # $self->fake_config( me => 'valid-fqdn.com');
+    # ok(...);
+    # $self->unfake_config();
+    ####################################################################
+    my $self = shift;
+    my $fake_config = {@_};
+    $self->fake_hook( 'config',
+        sub {
+            my ( $self, $txn, $conf ) = @_;
+            return DECLINED if ! exists $fake_config->{$conf};
+            return OK, $fake_config->{$conf};
+    } );
+}
+
+sub unfake_config {
+    my ( $self ) = @_;
+    $self->unfake_hook('config');
+}
+
 1;

t/Test/Qpsmtpd/Plugin.pm

@@ -84,27 +84,9 @@ sub validate_password {
     return $deny, "$file - wrong password";
 }
 
-sub fake_config {
+sub fake_hook     { shift->qp->fake_hook(@_)     }
-    my $self = shift;
+sub unfake_hook   { shift->qp->unfake_hook(@_)   }
-    my $fake_config = {@_};
+sub fake_config   { shift->qp->fake_config(@_)   }
-    $self->qp->hooks->{config} = [
+sub unfake_config { shift->qp->unfake_config(@_) }
-        {
-            name => '___FakeHook___',
-            code => sub {
-                my ( $self, $txn, $conf ) = @_;
-                return DECLINED if ! exists $fake_config->{$conf};
-                return OK, $fake_config->{$conf};
-            },
-        },
-    ];
-}
-
-sub unfake_config {
-    my ( $self ) = @_;
-    $self->qp->hooks->{config} = [
-        grep { $_->{name} ne '___FakeHook___' }
-        @{ $self->qp->hooks->{config} || [] }
-    ];
-}
 
 1;

t/qpsmtpd-address.t

@@ -152,13 +152,13 @@ sub __config {
     my @test_data = (
             {
              pref     => 'size_threshold',
-             result   => [],
+             result   => undef,
              expected => 10000,
              descr => 'fall back to global config when user_config is absent',
             },
             {
              pref     => 'test_config',
-             result   => [],
+             result   => undef,
              expected => undef,
              descr    => 'return nothing when no user_config plugins exist',
             },
@@ -176,16 +176,11 @@ sub __config {
             },
     );
     for (@test_data) {
-        $qp->hooks->{user_config} = @{$_->{result}}
+        $qp->fake_hook( 'user_config', sub { return @{$_->{result}} } )
-          ? [
+            if $_->{result};
-            {
-             name => 'test hook',
-             code => sub { return @{$_->{result}} }
-            }
-          ]
-          : undef;
         is($sender->config($_->{pref}), $_->{expected}, $_->{descr});
     }
+    $qp->unfake_hook('user_config');
 }
 
 sub __canonify {

t/qpsmtpd.t

@@ -258,8 +258,8 @@ sub __config {
         {
          pref  => 'size_threshold',
          hooks => {
-                   user_config => [],
+                   user_config => undef,
-                   config      => [],
+                   config      => undef,
                   },
          expected => {
                       user   => 10000,
@@ -270,8 +270,8 @@ sub __config {
         {
          pref  => 'timeout',
          hooks => {
-                   user_config => [],
+                   user_config => undef,
-                   config      => [],
+                   config      => undef,
                   },
          expected => {
                       user   => 1200,
@@ -329,15 +329,8 @@ sub __config {
         },
     );
     for my $t (@test_data) {
-        for my $hook (qw( config user_config )) {
+        for my $hook ( grep { $t->{hooks}{$_} } qw( config user_config ) ) {
-            $qp->hooks->{$hook} = @{$t->{hooks}{$hook}}
+            $qp->fake_hook( $hook, sub { return @{ $t->{hooks}{$hook} } } );
-              ? [
-                {
-                 name => 'test hook',
-                 code => sub { return @{$t->{hooks}{$hook}} }
-                }
-              ]
-              : undef;
         }
         is(
             $qp->config($t->{pref}, $a),
@@ -348,6 +341,7 @@ sub __config {
             $t->{expected}{global},
             "Global config: $t->{descr}");
     }
+    $qp->unfake_hook($_) for qw( config user_config );
 }
 
 sub __warn_level {