cvs commit: qpsmtpd/t/plugin_tests check_badrcptto
[email protected] (Matt Sergeant)
| Newsgroups | perl.cvs.qpsmtpd |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/09/08 09:26:33
Modified: lib Qpsmtpd.pm
t/Test Qpsmtpd.pm
Added: t plugin_tests.t
t/Test/Qpsmtpd Plugin.pm
t/plugin_tests check_badrcptto
Log:
Plugin testing framework.
Revision Changes Path
1.43 +39 -15 qpsmtpd/lib/Qpsmtpd.pm
Index: Qpsmtpd.pm
===================================================================
RCS file: /cvs/public/qpsmtpd/lib/Qpsmtpd.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- Qpsmtpd.pm 7 Sep 2004 05:35:16 -0000 1.42
+++ Qpsmtpd.pm 8 Sep 2004 16:26:31 -0000 1.43
@@ -63,6 +63,18 @@
}
}
+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 @@
if ($self->{_config_cache}->{$config}) {
return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0];
}
- my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control';
- my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
- $configdir = "$name/config" if (-e "$name/config/$config");
+ my $configdir = $self->config_dir($config);
my $configfile = "$configdir/$config";
@@ -112,7 +122,7 @@
}
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 @@
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 @@
"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 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 = "$name/plugins";
+ my $dir = $self->plugin_dir;
$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 ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
- $config_dir = "$name/config" if (-e "$name/config/$inc");
+ my $config_dir = $self->config_dir($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 @@
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 {
1.1 qpsmtpd/t/plugin_tests.t
Index: plugin_tests.t
===================================================================
#!/usr/bin/perl -w
use strict;
use lib 't';
use Test::Qpsmtpd;
my $qp = Test::Qpsmtpd->new();
$qp->run_plugin_tests();
1.3 +38 -0 qpsmtpd/t/Test/Qpsmtpd.pm
Index: Qpsmtpd.pm
===================================================================
RCS file: /cvs/public/qpsmtpd/t/Test/Qpsmtpd.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Qpsmtpd.pm 5 Sep 2004 16:25:02 -0000 1.2
+++ Qpsmtpd.pm 8 Sep 2004 16:26:31 -0000 1.3
@@ -4,6 +4,7 @@
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 @@
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;
1.1 qpsmtpd/t/Test/Qpsmtpd/Plugin.pm
Index: Plugin.pm
===================================================================
# $Id: Plugin.pm,v 1.1 2004/09/08 16:26:32 msergeant Exp $
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;
1.1 qpsmtpd/t/plugin_tests/check_badrcptto
Index: check_badrcptto
===================================================================
sub register_tests {
my $self = shift;
$self->register_test("foo", 1);
}
sub foo {
ok(1);
}