oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added a simple smtpd for testing

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

2
lib/WebGUI/Asset/Wobject/Layout.pm
View file

@ -310,7 +310,7 @@ sub www_view {
$self->session->stow->delete("cacheFixOverride"); $self->session->stow->delete("cacheFixOverride");
} }
# keep those ads rotating # keep those ads rotating
while ($out =~ /(\[AD\:(\w+)\])/gs) { while ($out =~ /(\[AD\:([^\]]+)\])/gs) {
my $code = $1; my $code = $1;
my $adSpace = WebGUI::AdSpace->newByName($self->session, $2); my $adSpace = WebGUI::AdSpace->newByName($self->session, $2);
my $ad = $adSpace->displayImpression if (defined $adSpace); my $ad = $adSpace->displayImpression if (defined $adSpace);

1
lib/WebGUI/Asset/Wobject/Poll.pm
View file

@ -403,6 +403,7 @@ sub thawGraphConfig {
my $self = shift; my $self = shift;
my $string = shift; my $string = shift;
return unless $string;
return JSON::from_json($string); return JSON::from_json($string);
} }

229
lib/WebGUI/Operation/AdSpace.pm
View file

@ -94,12 +94,13 @@ sub www_deleteAdSpace {
=head2 www_editAd ( ) =head2 www_editAd ( )
Displays form for editing an ad. Displays form for editing an ad.
=cut =cut
sub www_editAd { sub www_editAd {
my $session = shift; my $session = shift;
my $params = shift;
return $session->privilege->insufficient unless canView($session); return $session->privilege->insufficient unless canView($session);
my $id = $session->form->param("adId") || "new"; my $id = $session->form->param("adId") || "new";
my $ac = WebGUI::AdminConsole->new($session,"adSpace"); my $ac = WebGUI::AdminConsole->new($session,"adSpace");
@ -109,6 +110,7 @@ sub www_editAd {
$ac->addSubmenuItem($session->url->page("op=editAdSpace"), $i18n->get("add ad space")); $ac->addSubmenuItem($session->url->page("op=editAdSpace"), $i18n->get("add ad space"));
$ac->addSubmenuItem($session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces")); $ac->addSubmenuItem($session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces"));
my $f = WebGUI::HTMLForm->new($session); my $f = WebGUI::HTMLForm->new($session);
$f->submit; $f->submit;
$f->hidden(name=>"adId", value=>$id); $f->hidden(name=>"adId", value=>$id);
$f->hidden(name=>"adSpaceId", value=> $session->form->param("adSpaceId")); $f->hidden(name=>"adSpaceId", value=> $session->form->param("adSpaceId"));
@ -240,6 +242,7 @@ The save method for www_editAd()
sub www_editAdSave { sub www_editAdSave {
my $session = shift; my $session = shift;
return $session->privilege->insufficient unless canView($session); return $session->privilege->insufficient unless canView($session);
my $i18n = WebGUI::International->new($session,"AdSpace");
my %properties = ( my %properties = (
type=>$session->form->process("type", "selectBox"), type=>$session->form->process("type", "selectBox"),
url=>$session->form->process("url", "url"), url=>$session->form->process("url", "url"),
@ -256,6 +259,7 @@ sub www_editAdSave {
); );
my $storageId = $session->form->process("image","image"); my $storageId = $session->form->process("image","image");
$properties{storageId} = $storageId if (defined $storageId); $properties{storageId} = $storageId if (defined $storageId);
if ($session->form->param("adId") eq "new") { if ($session->form->param("adId") eq "new") {
WebGUI::AdSpace::Ad->create($session, $session->form->param("adSpaceId"), \%properties); WebGUI::AdSpace::Ad->create($session, $session->form->param("adSpaceId"), \%properties);
} else { } else {
@ -271,83 +275,108 @@ sub www_editAdSave {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 www_editAdSpace ( ) =head2 www_editAdSpace ( [ adSpace, params ] )
Edit or add an ad space form. Edit or add an ad space form. C<adSpace> is an instantiated WebGUI::AdSpace
object. C<params> is a hash reference of parameters with the following keys:
errors -> An array reference of error messages to the user
=cut =cut
sub www_editAdSpace { sub www_editAdSpace {
my $session = shift; my $session = shift;
my $adSpace = shift; my $adSpace = shift;
return $session->privilege->insufficient unless canView($session); my $params = shift;
my $id;
my $i18n = WebGUI::International->new($session,"AdSpace"); return $session->privilege->insufficient unless canView($session);
my $ac = WebGUI::AdminConsole->new($session,"adSpace");
if (defined $adSpace) { my $i18n = WebGUI::International->new( $session, "AdSpace" );
$id = $adSpace->getId; my $ac = WebGUI::AdminConsole->new( $session, "adSpace" );
} else { my $f = WebGUI::HTMLForm->new($session);
$id = $session->form->param("adSpaceId") || "new";
$adSpace = WebGUI::AdSpace->new($session, $id); # Get the adspace we're working with
} my $id;
$ac->addSubmenuItem($session->url->page("op=editAd;adSpaceId=".$id), $i18n->get("add an ad")) if defined $adSpace; if ( $adSpace ) {
$ac->addSubmenuItem($session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces")); $id = $adSpace->getId;
my $f = WebGUI::HTMLForm->new($session); } else {
$f->submit; $id = $session->form->param("adSpaceId") || "new";
$f->hidden(name=>"adSpaceId", value=>$id); $adSpace = WebGUI::AdSpace->new($session, $id);
$f->readOnly(label=>$i18n->get("ad space id"), value=>$id); }
$f->hidden(name=>"op", value=>"editAdSpaceSave");
my $value = $adSpace->get("name") if defined $adSpace; if ( $adSpace ) {
$f->text( $ac->addSubmenuItem(
name=>"name", $session->url->page("op=editAd;adSpaceId=".$id), $i18n->get("add an ad")
value=>$value, );
hoverHelp => $i18n->get("name help"), }
label=>$i18n->get("name") $ac->addSubmenuItem(
); $session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces")
$value = $adSpace->get("title") if defined $adSpace; );
$f->text(
name=>"title", # Give the errors to the user
value=>$value, if ( $params->{errors} ) {
hoverHelp => $i18n->get("title help"), $f->raw( '<p>' . $i18n->get('error heading') . '</p>'
label=>$i18n->get("title") . '<ul>'
); . join( "", map { '<li>' . $_ . '</li>' } @{ $params->{errors} } )
$value = $adSpace->get("description") if defined $adSpace; . '</ul>'
$f->textarea( );
name=>"description", }
value=>$value,
hoverHelp => $i18n->get("description help"), # Build the form
label=>$i18n->get("description") $f->submit;
); $f->hidden( name => "adSpaceId", value => $id );
$value = $adSpace->get("width") if defined $adSpace; $f->readOnly( label => $i18n->get("ad space id"), value => $id );
$f->integer( $f->hidden( name => "op", value => "editAdSpaceSave" );
name=>"width", $f->text(
value=>$value, name => "name",
defaultValue=>468, value => $session->form->get('name') || $adSpace->get("name"),
hoverHelp => $i18n->get("width help"), hoverHelp => $i18n->get("name help"),
label=>$i18n->get("width") label => $i18n->get("name"),
); );
$value = $adSpace->get("height") if defined $adSpace; $f->text(
$f->integer( name => "title",
name=>"height", value => $session->form->get('title') || $adSpace->get('title'),
value=>$value, hoverHelp => $i18n->get("title help"),
defaultValue=>60, label => $i18n->get("title"),
hoverHelp => $i18n->get("height help"), );
label=>$i18n->get("height") $f->textarea(
); name => "description",
$f->submit; value => $session->form->get('description') || $adSpace->get('description'),
my $ads = ""; hoverHelp => $i18n->get("description help"),
my $code = ""; label => $i18n->get("description"),
if (defined $adSpace) { );
$code = '<p style="padding: 5px; line-height: 20px; text-align: center; border: 3px outset black; font-family: helvetica; font-size: 11px; width: 200px; float: right;">'.$i18n->get("macro code prompt").'<br /><b>&#94;AdSpace('.$adSpace->get("name").');</b></p>'; $f->integer(
my $rs = $session->db->read("select adId, title, renderedAd from advertisement where adSpaceId=?",[$id]); name => "width",
while (my ($adId, $title, $ad) = $rs->array) { value => $session->form->get('width') || $adSpace->get('width'),
$ads .= '<div style="margin: 15px; float: left;">'.$session->icon->delete("op=deleteAd;adSpaceId=".$id.";adId=".$adId, undef, $i18n->get("confirm ad delete")) defaultValue => 468,
.$session->icon->edit("op=editAd;adSpaceId=".$id.";adId=".$adId) hoverHelp => $i18n->get("width help"),
.' '.$title.'<br />'.$ad.'</div>'; label => $i18n->get("width"),
} );
$ads .= '<div style="clear: both;"></div>'; $f->integer(
} name => "height",
$ac->render($code.$f->print.$ads, $i18n->get("edit ad space")); value => $session->form->get('height') || $adSpace->get('height'),
defaultValue => 60,
hoverHelp => $i18n->get("height help"),
label => $i18n->get("height"),
);
$f->submit;
# Show the ads in this adspace.
my $ads = "";
my $code = "";
if ( $adSpace ) {
$code = '<p style="padding: 5px; line-height: 20px; text-align: center; border: 3px outset black; font-family: helvetica; font-size: 11px; width: 200px; float: right;">'.$i18n->get("macro code prompt").'<br /><b>&#94;AdSpace('.$adSpace->get("name").');</b></p>';
my $rs = $session->db->read("select adId, title, renderedAd from advertisement where adSpaceId=?",[$id]);
while (my ($adId, $title, $ad) = $rs->array) {
$ads .= '<div style="margin: 15px; float: left;">'.$session->icon->delete("op=deleteAd;adSpaceId=".$id.";adId=".$adId, undef, $i18n->get("confirm ad delete"))
. $session->icon->edit( "op=editAd;adSpaceId=" . $id . ";adId=" . $adId )
. ' ' . $title . '<br />' . $ad . '</div>'
;
}
$ads .= '<div style="clear: both;"></div>';
}
return $ac->render($code.$f->print.$ads, $i18n->get("edit ad space"));
} }
@ -360,23 +389,43 @@ Save the www_editAdSpace method.
=cut =cut
sub www_editAdSpaceSave { sub www_editAdSpaceSave {
my $session = shift; my $session = shift;
return $session->privilege->insufficient unless canView($session);
my %properties = ( return $session->privilege->insufficient unless canView($session);
name=>$session->form->process("name", "text"),
title=>$session->form->process("title", "text"), my $i18n = WebGUI::International->new( $session, "AdSpace" );
description=>$session->form->process("description", "textarea"),
width=>$session->form->process("width", "integer"), my %properties = (
height=>$session->form->process("height", "integer"), name => $session->form->process("name", "text"),
); title => $session->form->process("title", "text"),
if ($session->form->param("adSpaceId") eq "new") { description => $session->form->process("description", "textarea"),
my $adSpace = WebGUI::AdSpace->create($session, \%properties); width => $session->form->process("width", "integer"),
return www_editAdSpace($session, $adSpace); height => $session->form->process("height", "integer"),
} else { );
my $adSpace = WebGUI::AdSpace->new($session, $session->form->param("adSpaceId"));
$adSpace->set(\%properties); ### Validate form entry
} my @errors;
return www_manageAdSpaces($session); # Adspace titles cannot contain ] characters because of caching in the Layout asset
if ( $properties{name} =~ /[\]]/ ) {
push @errors, $i18n->get('error invalid characters');
}
if ( @errors ) {
return www_editAdSpace( $session, undef, { errors => \@errors } );
}
# Create the new Ad Space
if ($session->form->param("adSpaceId") eq "new") {
my $adSpace = WebGUI::AdSpace->create($session, \%properties);
return www_editAdSpace($session, $adSpace);
}
# Edit the existing Ad Space
else {
my $adSpace = WebGUI::AdSpace->new($session, $session->form->param("adSpaceId"));
$adSpace->set(\%properties);
}
return www_manageAdSpaces($session);
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------

10
lib/WebGUI/i18n/English/AdSpace.pm
View file

@ -294,6 +294,16 @@ our $I18N = {
lastUpdated => 0, lastUpdated => 0,
}, },
'error heading' => {
message => q{There was an error with your Ad Space:},
lastUpdated => 0,
},
'error invalid characters' => {
message => q{There are invalid characters in the title field. Please use only letters, numbers, and spaces.},
lastUpdated => 0,
},
}; };
1; 1;

96
t/Mail/Send.t
View file

@ -15,7 +15,9 @@
use FindBin; use FindBin;
use strict; use strict;
use lib "$FindBin::Bin/../lib"; use lib "$FindBin::Bin/../lib";
use JSON qw( from_json to_json );
use Test::More; use Test::More;
use File::Spec;
use WebGUI::Test; use WebGUI::Test;
use WebGUI::Mail::Send; use WebGUI::Mail::Send;
@ -27,10 +29,26 @@ my $session = WebGUI::Test->session;
my $mail; # The WebGUI::Mail::Send object my $mail; # The WebGUI::Mail::Send object
my $mime; # for getMimeEntity 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 # 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 # 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 # 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 # Cleanup
END { 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 );
}

28
t/lib/WebGUI/Test.pm
View file

@ -32,6 +32,7 @@ use IO::Handle qw[];
use File::Spec qw[]; use File::Spec qw[];
use Test::MockObject::Extends; use Test::MockObject::Extends;
use WebGUI::PseudoRequest; use WebGUI::PseudoRequest;
use Scalar::Util qw( blessed );
##Hack to get ALL test output onto STDOUT. ##Hack to get ALL test output onto STDOUT.
use Test::Builder; use Test::Builder;
@ -166,11 +167,13 @@ sub file {
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
=head2 getPage ( asset, pageName [, opts] ) =head2 getPage ( asset | sub, pageName [, opts] )
Get the entire response from a page request. asset is a WebGUI::Asset object. Get the entire response from a page request. C<asset> is a WebGUI::Asset
pageName is the name of the page subroutine to run. options is a hash reference object. C<sub> is a string containing a fully-qualified subroutine name.
of options with keys outlined below. C<pageName> is the name of the page subroutine to run (may be C<undef> for
sub strings. C<options> is a hash reference of options with keys outlined
below.
args => Array reference of arguments to the pageName sub args => Array reference of arguments to the pageName sub
user => A user object to set for this request user => A user object to set for this request
@ -183,7 +186,7 @@ of options with keys outlined below.
sub getPage { sub getPage {
my $class = shift; my $class = shift;
my $session = $SESSION; # The session object my $session = $SESSION; # The session object
my $asset = shift; # The asset object my $actor = shift; # The actor to work on
my $page = shift; # The page subroutine my $page = shift; # The page subroutine
my $optionsRef = shift; # A hashref of options my $optionsRef = shift; # A hashref of options
# args => Array ref of args to the page sub # args => Array ref of args to the page sub
@ -217,7 +220,20 @@ sub getPage {
$session->{_request} = $request; $session->{_request} = $request;
# Fill the buffer # Fill the buffer
my $returnedContent = $asset->$page(@{$optionsRef->{args}}); my $returnedContent;
if (blessed $actor) {
$returnedContent = $actor->$page(@{$optionsRef->{args}});
}
elsif ( ref $actor eq "CODE" ) {
$returnedContent = $actor->(@{$optionsRef->{args}});
}
else {
# Try using it as a subroutine
no strict 'refs';
$returnedContent = $actor->(@{$optionsRef->{args}});
use strict 'refs';
}
if ($returnedContent && $returnedContent ne "chunked") { if ($returnedContent && $returnedContent ne "chunked") {
print $output $returnedContent; print $output $returnedContent;
} }

48
t/smtpd.pl Normal file
View file

@ -0,0 +1,48 @@
my $HOST = shift;
my $PORT = shift;
die "HOST must be first argument"
unless $HOST;
die "PORT must be second argument"
unless $PORT;
use JSON qw( to_json );
use Net::SMTP::Server;
use Net::SMTP::Server::Client;
my $server = Net::SMTP::Server->new( $HOST, $PORT );
while ( my $conn = $server->accept ) {
my $client = Net::SMTP::Server::Client->new( $conn );
$client->process;
print to_json({
to => $client->{TO},
from => $client->{FROM},
contents => $client->{MSG},
});
exit(0);
}
=head1 NAME
t/smtpd.pl - A dumb SMTP server.
=head1 USAGE
perl smtpd.pl <hostname> <port>
=head1 DESCRIPTION
This program listens on the given hostname and port, then processes the
incoming SMTP client request.
Then it prints a JSON object of the data recieved and exits.
This program will only handle one request before exiting.
=head1 CAVEATS
You MUST C<sleep 1> after opening a pipe to this so that it can establish the
listening on the port.