Plugin testing framework.

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@313 958fd67b-6ff1-0310-b445-bb7760255be9

lib/Qpsmtpd.pm

@@ -63,6 +63,18 @@ sub config {
    }
 }
 
+sub config_dir {
+  my ($self, $config) = @_;
+  my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control';
+  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+  $configdir = "$name/config" if (-e "$name/config/$config");
+  return $configdir;
+}
+
+sub plugin_dir {
+    my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+    my $dir = "$name/plugins";
+}
 
 sub get_qmail_config {
   my ($self, $config, $type) = @_;
@@ -70,9 +82,7 @@ sub get_qmail_config {
   if ($self->{_config_cache}->{$config}) {
     return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0];
   }
-  my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control';
+  my $configdir = $self->config_dir($config);
-  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
-  $configdir = "$name/config" if (-e "$name/config/$config");
 
   my $configfile = "$configdir/$config";
 
@@ -112,7 +122,7 @@ sub _config_from_file {
 }
 
 sub _compile {
-    my ($plugin, $package, $file) = @_;
+    my ($self, $plugin, $package, $file) = @_;
     
     my $sub;
     open F, $file or die "could not open $file: $!";
@@ -124,6 +134,15 @@ sub _compile {
 
     my $line = "\n#line 1 $file\n";
 
+    if ($self->{_test_mode}) {
+        if (open(F, "t/plugin_tests/$plugin")) {
+            local $/ = undef;
+            $sub .= "#line 1 t/plugin_tests/$plugin\n";
+            $sub .= <F>;
+            close F;
+        }
+    }
+
     my $eval = join(
 		    "\n",
 		    "package $package;",
@@ -131,6 +150,7 @@ sub _compile {
 		    "require Qpsmtpd::Plugin;",
 		    'use vars qw(@ISA);',
 		    '@ISA = qw(Qpsmtpd::Plugin);',
+		    ($self->{_test_mode} ? 'use Test::More;' : ''),
 		    "sub plugin_name { qq[$plugin] }",
 		    $line,
 		    $sub,
@@ -149,42 +169,43 @@ sub _compile {
 sub load_plugins {
   my $self = shift;
   
-  $self->{hooks} ||= {};
+  $self->log(LOGERROR, "Plugins already loaded") if $self->{hooks};
+  $self->{hooks} = {};
   
   my @plugins = $self->config('plugins');
 
-  my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
+  my $dir = $self->plugin_dir;
-  my $dir = "$name/plugins";
   $self->log(LOGNOTICE, "loading plugins from $dir");
 
-  $self->_load_plugins($dir, @plugins);
+  @plugins = $self->_load_plugins($dir, @plugins);
+  
+  return @plugins;
 }
 
 sub _load_plugins {
   my $self = shift;
   my ($dir, @plugins) = @_;
 
+  my @ret;  
   for my $plugin (@plugins) {
     $self->log(LOGINFO, "Loading $plugin");
     ($plugin, my @args) = split /\s+/, $plugin;
     
     if (lc($plugin) eq '$include') {
       my $inc = shift @args;
-      my $config_dir = ($ENV{QMAIL} || '/var/qmail') . '/control';
+      my $config_dir = $self->config_dir($inc);
-      my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
-      $config_dir = "$name/config" if (-e "$name/config/$inc");
       if (-d "$config_dir/$inc") {
         $self->log(LOGDEBUG, "Loading include dir: $config_dir/$inc");
         opendir(DIR, "$config_dir/$inc") || die "opendir($config_dir/$inc): $!";
         my @plugconf = sort grep { -f $_ } map { "$config_dir/$inc/$_" } grep { !/^\./ } readdir(DIR);
         closedir(DIR);
         foreach my $f (@plugconf) {
-            $self->_load_plugins($dir, $self->_config_from_file($f, "plugins"));
+            push @ret, $self->_load_plugins($dir, $self->_config_from_file($f, "plugins"));
         }
       }
       elsif (-f "$config_dir/$inc") {
         $self->log(LOGDEBUG, "Loading include file: $config_dir/$inc");
-        $self->_load_plugins($dir, $self->_config_from_file("$config_dir/$inc", "plugins"));
+        push @ret, $self->_load_plugins($dir, $self->_config_from_file("$config_dir/$inc", "plugins"));
       }
       else {
         $self->log(LOGCRIT, "CRITICAL PLUGIN CONFIG ERROR: Include $config_dir/$inc not found");
@@ -209,13 +230,16 @@ sub _load_plugins {
     my $package = "Qpsmtpd::Plugin::$plugin_name";
 
     # don't reload plugins if they are already loaded
-    _compile($plugin_name, $package, "$dir/$plugin") unless
+    $self->_compile($plugin_name, $package, "$dir/$plugin") unless
         defined &{"${package}::register"};
     
     my $plug = $package->new();
+    push @ret, $plug;
     $plug->_register($self, @args);
 
   }
+  
+  return @ret;
 }
 
 sub transaction {

t/Test/Qpsmtpd.pm

@@ -4,6 +4,7 @@ use Carp qw(croak);
 use base qw(Qpsmtpd::SMTP);
 use Test::More;
 use Qpsmtpd::Constants;
+use Test::Qpsmtpd::Plugin;
 
 sub new_conn {
   ok(my $smtpd = __PACKAGE__->new(), "new");
@@ -65,9 +66,46 @@ sub input {
   alarm $timeout;
 }
 
+sub config_dir {
+    './config';
+}
+
+sub plugin_dir {
+    './plugins';
+}
+
+sub log {
+    my ($self, $trace, @log) = @_;
+    my $level = Qpsmtpd::TRACE_LEVEL();
+    $level = $self->init_logger unless defined $level;
+    diag(join(" ", $$, @log)) if $trace <= $level;
+}
+
 # sub run
 # sub disconnect
 
+sub run_plugin_tests {
+    my $self = shift;
+    $self->{_test_mode} = 1;
+    my @plugins = $self->load_plugins();
+    # First count test number
+    my $num_tests = 0;
+    foreach my $plugin (@plugins) {
+        $plugin->register_tests();
+        $num_tests += $plugin->total_tests();
+    }
+    
+    require Test::Builder;
+    my $Test = Test::Builder->new();
+    
+    $Test->plan( tests => $num_tests );
+    
+    # Now run them
+    
+    foreach my $plugin (@plugins) {
+        $plugin->run_tests();
+    }
+}
 
 1;
 

t/Test/Qpsmtpd/Plugin.pm

@@ -0,0 +1,41 @@
+# $Id$
+
+package Test::Qpsmtpd::Plugin;
+1;
+
+# Additional plugin methods used during testing
+package Qpsmtpd::Plugin;
+
+use Test::More;
+use strict;
+
+sub register_tests {
+    # Virtual base method - implement in plugin
+}
+
+sub register_test {
+    my ($plugin, $test, $num_tests) = @_;
+    $num_tests = 1 unless defined($num_tests);
+    # print STDERR "Registering test $test ($num_tests)\n";
+    push @{$plugin->{_tests}}, { name => $test, num => $num_tests };
+}
+
+sub total_tests {
+    my ($plugin) = @_;
+    my $total = 0;
+    foreach my $t (@{$plugin->{_tests}}) {
+        $total += $t->{num};
+    }
+    return $total;
+}
+
+sub run_tests {
+    my ($plugin) = @_;
+    foreach my $t (@{$plugin->{_tests}}) {
+        my $method = $t->{name};
+        diag "Running $method tests for plugin " . $plugin->plugin_name;
+        $plugin->$method();
+    }
+}
+
+1;

t/plugin_tests.t

@@ -0,0 +1,10 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't';
+use Test::Qpsmtpd;
+
+my $qp = Test::Qpsmtpd->new();
+
+$qp->run_plugin_tests();
+

t/plugin_tests/check_badrcptto

@@ -0,0 +1,9 @@
+
+sub register_tests {
+    my $self = shift;
+    $self->register_test("foo", 1);
+}
+
+sub foo {
+    ok(1);
+}