tests for Qpsmtpd/SMTP

* order the ‘use’  pragmas
* compact the new() method
* move fault() tests into t/qpsmtpd-smtp.t
This commit is contained in:
Matt Simerson 2014-09-10 16:53:28 -07:00
parent 78425a0897
commit fabbdae960
4 changed files with 64 additions and 38 deletions

View File

@ -7,7 +7,6 @@ WriteMakefile(
NAME => 'qpsmtpd',
VERSION_FROM => 'lib/Qpsmtpd.pm',
PREREQ_PM => {
'Test::Output' => 0,
'Data::Dumper' => 0,
'Date::Parse' => 0,
'File::Temp' => 0,
@ -17,6 +16,9 @@ WriteMakefile(
'Net::IP' => 0,
'Time::HiRes' => 0,
'IO::Socket::SSL' => 0,
# Dev/Test modules
'Test::More' => 0,
'Test::Output' => 0,
# modules for specific features
'Mail::DKIM' => 0,
'File::Tail' => 0, # log/summarize, log/watch

View File

@ -1,12 +1,15 @@
package Qpsmtpd::SMTP;
use Qpsmtpd;
@ISA = qw(Qpsmtpd);
my %auth_mechanisms = ();
package Qpsmtpd::SMTP;
use strict;
use Carp;
use base 'Qpsmtpd';
use Carp;
#use Data::Dumper;
use POSIX qw(strftime);
use Mail::Header;
use Net::DNS;
use Qpsmtpd;
use Qpsmtpd::Connection;
use Qpsmtpd::Transaction;
use Qpsmtpd::Plugin;
@ -15,11 +18,7 @@ use Qpsmtpd::Auth;
use Qpsmtpd::Address ();
use Qpsmtpd::Command;
use Mail::Header ();
#use Data::Dumper;
use POSIX qw(strftime);
use Net::DNS;
my %auth_mechanisms = ();
# this is only good for forkserver
# can't set these here, cause forkserver resets them
@ -27,19 +26,16 @@ use Net::DNS;
#$SIG{ALRM} = sub { warn "Connection Timed Out\n"; exit; };
sub new {
my $proto = shift;
my ($proto, %args) = @_;
my $class = ref($proto) || $proto;
my %args = @_;
my $self = bless({args => \%args}, $class);
my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit);
my (%commands);
@commands{@commands} = ('') x @commands;
# this list of valid commands should probably be a method or a set of methods
$self->{_commands} = {
map { $_ => '' } qw(ehlo helo rset mail rcpt data help vrfy noop quit)
};
# this list of valid commands should probably be a method or a set of methods
$self->{_commands} = \%commands;
$self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart()
$self;
}

View File

@ -1,4 +1,4 @@
use Test::More tests => 14;
use Test::More tests => 10;
use Test::Output;
use strict;
use lib 't';
@ -6,23 +6,6 @@ use_ok('Test::Qpsmtpd');
ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
# fault method
{
my $fault;
stderr_like { $fault = $smtpd->fault }
qr/program fault - command not performed.*Last system error:/ms,
'fault outputs proper warning to STDOUT';
is($fault->[0], 451, 'fault returns 451');
};
{
my $fault;
stderr_like { $fault = $smtpd->fault('test message') }
qr/test message.*Last system error/ms,
'fault outputs proper custom warning to STDOUT';
is($fault->[1], 'Internal error - try again later - test message',
'returns the input message');
};
# vrfy command
is(($smtpd->command('VRFY <foo@bar>'))[0], 252, 'VRFY command');

45
t/qpsmtpd-smtp.t Normal file
View File

@ -0,0 +1,45 @@
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Test::More;
use Test::Output;
use lib 't';
use lib 'lib'; # test lib/Qpsmtpd/SMTP (vs site_perl)
use_ok('Test::Qpsmtpd');
use_ok('Qpsmtpd::SMTP');
ok(my $smtp = Qpsmtpd::SMTP->new(), "new smtp");
ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
__new();
__fault();
done_testing();
sub __new {
isa_ok( $smtp, 'Qpsmtpd::SMTP' );
ok( $smtp->{_commands}, "valid commands populated");
$smtp = Qpsmtpd::SMTP->new( key => 'val' );
cmp_ok( $smtp->{args}{key}, 'eq', 'val', "new with args");
}
sub __fault {
my $fault;
stderr_like { $fault = $smtpd->fault }
qr/program fault - command not performed \(/,
'fault outputs proper warning to STDOUT';
is($fault->[0], 451, 'fault returns 451');
stderr_like { $fault = $smtpd->fault('test message') }
qr/test message \(/,
'fault outputs proper custom warning to STDOUT';
is($fault->[1], 'Internal error - try again later - test message',
'returns the input message');
}