added tests for run_hooks & run_hooks_no_respond

lib/Qpsmtpd.pm

@@ -180,8 +180,7 @@ sub load_plugins {
 }
 
 sub _load_plugin {
-    my $self = shift;
-    my ($plugin_line, @plugin_dirs) = @_;
+    my ($self, $plugin_line, @plugin_dirs) = @_;
 
     # untaint the config data before passing it to plugins
     my ($safe_line) = $plugin_line =~ /^([ -~]+)$/    # all ascii printable
@@ -273,7 +272,7 @@ sub run_hooks_no_respond {
 
     my @r;
     for my $code (@{$hooks->{$hook}}) {
-        eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
+        eval { @r = $code->{code}->($self, $self->transaction, @_); };
         if ($@) {
             warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@);
             next;

lib/Qpsmtpd/Plugin.pm

@@ -99,7 +99,7 @@ sub adjust_log_level {
 
 sub transaction {
 
-    # not sure if this will work in a non-forking or a threaded daemon
+    # does this work in a non-forking or a threaded daemon?
     shift->qp->transaction;
 }
 
@@ -137,7 +137,7 @@ sub temp_dir {
 # usage:
 #  sub init {
 #    my $self = shift;
-#    $self->isa_plugin("rhsbl");
+#    $self->isa_plugin('rhsbl');
 #    $self->SUPER::register(@_);
 #  }
 sub isa_plugin {
@@ -164,30 +164,29 @@ sub isa_plugin {
     $self->compile($self->plugin_name . "_isa_$cleanParent",
                    $newPackage, "$parent_dir/$parent");
     warn "---- $newPackage\n";
-    no strict 'refs';
+    no strict 'refs'; ## no critic (strict)
     push @{"${currentPackage}::ISA"}, $newPackage;
 }
 
-# why isn't compile private?  it's only called from Plugin and Qpsmtpd.
 sub compile {
     my ($class, $plugin, $package, $file, $test_mode, $orig_name) = @_;
 
     my $sub;
-    open F, $file or die "could not open $file: $!";
+    open my $F, '<', $file or die "could not open $file: $!";
     {
         local $/ = undef;
-        $sub = <F>;
+        $sub = <$F>;
     }
-    close F;
+    close $F;
 
     my $line = "\n#line 0 $file\n";
 
     if ($test_mode) {
-        if (open(F, "t/plugin_tests/$orig_name")) {
+        if (open(my $F, '<', "t/plugin_tests/$orig_name")) {
             local $/ = undef;
             $sub .= "#line 1 t/plugin_tests/$orig_name\n";
-            $sub .= <F>;
-            close F;
+            $sub .= <$F>;
+            close $F;
         }
     }
 
@@ -206,12 +205,10 @@ sub compile {
         "\n",                               # last line comment without newline?
                    );
 
-    #warn "eval: $eval";
-
     $eval =~ m/(.*)/s;
     $eval = $1;
 
-    eval $eval;
+    eval $eval;  ## no critic (Eval)
     die "eval $@" if $@;
 }
 
@@ -355,8 +352,8 @@ sub _register_standard_hooks {
     for my $hook (@hooks) {
         my $hooksub = "hook_$hook";
         $hooksub =~ s/\W/_/g;
+        next if !$plugin->can($hooksub);
         $plugin->register_hook($hook, $hooksub)
-          if ($plugin->can($hooksub));
     }
 }
 

t/qpsmtpd.t

@@ -24,10 +24,12 @@ __hooks_none();
 ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
 __hooks();
 
+__run_hooks_no_respond();
+__run_hooks();
+
 __register_hook();
 __hook_responder();
 __run_continuation();
-done_testing() and exit;
 
 __temp_file();
 __temp_dir();
@@ -45,6 +47,33 @@ __config();
 
 done_testing();
 
+sub __run_hooks {
+    my @r = $qp->run_hooks('nope');
+    is($r[0], 0, "run_hooks, invalid hook");
+
+    @r = $smtpd->run_hooks('nope');
+    is($r[0], 0, "run_hooks, invalid hook");
+
+    foreach my $hook (qw/ connect helo rset /) {
+        my $r = $smtpd->run_hooks('connect');
+        is($r->[0], 220, "run_hooks, $hook code");
+        ok($r->[1] =~ /ready/, "run_hooks, $hook result");
+    }
+}
+
+sub __run_hooks_no_respond {
+    my @r = $qp->run_hooks_no_respond('nope');
+    is($r[0], 0, "run_hooks_no_respond, invalid hook");
+
+    @r = $smtpd->run_hooks_no_respond('nope');
+    is($r[0], 0, "run_hooks_no_respond, invalid hook");
+
+    foreach my $hook (qw/ connect helo rset /) {
+        @r = $smtpd->run_hooks_no_respond('connect');
+        is($r[0], 909, "run_hooks_no_respond, $hook hook");
+    }
+}
+
 sub __hooks {
     ok(Qpsmtpd::hooks(), "hooks, populated");
     my $r = $qp->hooks;
@@ -52,7 +81,6 @@ sub __hooks {
 
     $r = $qp->hooks('connect');
     ok(@$r, "hooks, populated, connect");
-    #warn Data::Dumper::Dumper($r);
 
     my @r = $qp->hooks('connect');
     ok(@r, "hooks, populated, connect, wants array");
@@ -78,8 +106,6 @@ sub __run_continuation {
     ok(!$@, "run_continuation with a continuation doesn't throw exception");
     is($r->[0], 220, "hook_responder, code");
     ok($r->[1] =~ /ESMTP qpsmtpd/, "hook_responder, message: ". $r->[1]);
-
-    #print Data::Dumper::Dumper(@r);
 }
 
 sub __hook_responder {
@@ -216,7 +242,6 @@ sub __config_dir {
     my $dir = $qp->config_dir('logging');
     ok($dir, "config_dir, $dir");
 
-    #warn Data::Dumper::Dumper($Qpsmtpd::config_dir_memo{logging});
     $dir = $Qpsmtpd::Config::dir_memo{logging};
     ok($dir, "config_dir, $dir (memo)");
 }