Added a simple smtpd for testing

MERGE: Added ability for WebGUI::Test->getPage to work on Operations
MERGE: Fix for AdSpace and tests for Operation::AdSpace
Fixed Poll's use of JSON
Added tests for emailOverride
This commit is contained in:
Doug Bell 2008-02-05 19:34:09 +00:00
parent b27d14f2e5
commit 53ac4be8d1
7 changed files with 315 additions and 99 deletions

View file

@ -15,7 +15,9 @@
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use JSON qw( from_json to_json );
use Test::More;
use File::Spec;
use WebGUI::Test;
use WebGUI::Mail::Send;
@ -27,10 +29,26 @@ my $session = WebGUI::Test->session;
my $mail; # The WebGUI::Mail::Send object
my $mime; # for getMimeEntity
# Load Net::SMTP::Server
my $hasServer; # This is true if we have a Net::SMTP::Server module
BEGIN {
eval { require Net::SMTP::Server; require Net::SMTP::Server::Client; };
$hasServer = 1 unless $@;
}
# See if we have an SMTP server to use
my ( $smtpd, %oldSettings );
my $SMTP_HOST = 'localhost';
my $SMTP_PORT = '54921';
if ($hasServer) {
$oldSettings{ smtpServer } = $session->setting->get('smtpServer');
$session->setting->set( 'smtpServer', $SMTP_HOST . ':' . $SMTP_PORT );
}
#----------------------------------------------------------------------------
# Tests
plan tests => 5; # Increment this number for each test you create
plan tests => 6; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test create
@ -106,8 +124,82 @@ is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
# TODO: Test that addHtml creates a body with the right content type
#----------------------------------------------------------------------------
# Test emailOverride
SKIP: {
my $numtests = 1; # Number of tests in this block
# Must be able to write the config, or we'll die
if ( !-w File::Spec->catfile( WebGUI::Test::root, 'etc', WebGUI::Test::file() ) ) {
skip "Cannot test emailOverride: Can't write new configuration value", $numtests;
}
# Must have an SMTP server, or it's pointless
if ( !$hasServer ) {
skip "Cannot test emailOverride: Module Net::SMTP::Server not loaded!", $numtests;
}
# Override the emailOverride
my $oldEmailOverride = $session->config->get('emailOverride');
$session->config->set( 'emailOverride', 'dufresne@localhost' );
# Send the mail
my $mail
= WebGUI::Mail::Send->create( $session, {
to => 'norton@localhost',
} );
$mail->addText( 'His judgement cometh and that right soon.' );
my $received = sendToServer( $mail );
skip "Cannot test emailOverride: No response received from smtpd", $numtests;
# Test the mail
like( $received->{to}->[0], qr/dufresne\@localhost/,
"Email TO: address is overridden",
);
# Restore the emailOverride
$session->config->set( 'emailOverride', $oldEmailOverride );
}
#----------------------------------------------------------------------------
# Cleanup
END {
for my $name ( keys %oldSettings ) {
$session->setting->set( $name, $oldSettings{ $name } );
}
}
#----------------------------------------------------------------------------
# sendToServer ( mail )
# Spawns a server (using t/smtpd.pl), sends the mail, and grabs it from the
# child
# The child process builds a Net::SMTP::Server and listens for the parent to
# send the mail. The entire result is returned as a hash reference with the
# following keys:
#
# to - who the mail was to
# from - who the mail was from
# contents - The complete contents of the message, suitable to be parsed
# by a MIME::Entity parser
sub sendToServer {
my $mail = shift;
my $smtpd = File::Spec->catfile( WebGUI::Test->root, 't', 'smtpd.pl' );
open MAIL, "perl $smtpd $SMTP_HOST $SMTP_PORT |"
or die "Could not open pipe to SMTPD: $!";
sleep 1; # Give the smtpd time to establish itself
$mail->send;
my $json;
while ( my $line = <MAIL> ) {
$json .= $line;
}
close MAIL
or die "Could not close pipe to SMTPD: $!";
return from_json( $json );
}