From 53ac4be8d15bb68fc6923466709bb043b1bcdce0 Mon Sep 17 00:00:00 2001 From: Doug Bell Date: Tue, 5 Feb 2008 19:34:09 +0000 Subject: [PATCH] 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 --- lib/WebGUI/Asset/Wobject/Layout.pm | 2 +- lib/WebGUI/Asset/Wobject/Poll.pm | 1 + lib/WebGUI/Operation/AdSpace.pm | 229 +++++++++++++++++------------ lib/WebGUI/i18n/English/AdSpace.pm | 10 ++ t/Mail/Send.t | 96 +++++++++++- t/lib/WebGUI/Test.pm | 28 +++- t/smtpd.pl | 48 ++++++ 7 files changed, 315 insertions(+), 99 deletions(-) create mode 100644 t/smtpd.pl diff --git a/lib/WebGUI/Asset/Wobject/Layout.pm b/lib/WebGUI/Asset/Wobject/Layout.pm index a7627157f..87907f20c 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -310,7 +310,7 @@ sub www_view { $self->session->stow->delete("cacheFixOverride"); } # keep those ads rotating - while ($out =~ /(\[AD\:(\w+)\])/gs) { + while ($out =~ /(\[AD\:([^\]]+)\])/gs) { my $code = $1; my $adSpace = WebGUI::AdSpace->newByName($self->session, $2); my $ad = $adSpace->displayImpression if (defined $adSpace); diff --git a/lib/WebGUI/Asset/Wobject/Poll.pm b/lib/WebGUI/Asset/Wobject/Poll.pm index 1f30659e3..d75e33376 100644 --- a/lib/WebGUI/Asset/Wobject/Poll.pm +++ b/lib/WebGUI/Asset/Wobject/Poll.pm @@ -403,6 +403,7 @@ sub thawGraphConfig { my $self = shift; my $string = shift; + return unless $string; return JSON::from_json($string); } diff --git a/lib/WebGUI/Operation/AdSpace.pm b/lib/WebGUI/Operation/AdSpace.pm index 045d3e329..492ced07a 100644 --- a/lib/WebGUI/Operation/AdSpace.pm +++ b/lib/WebGUI/Operation/AdSpace.pm @@ -94,12 +94,13 @@ sub www_deleteAdSpace { =head2 www_editAd ( ) -Displays form for editing an ad. +Displays form for editing an ad. =cut sub www_editAd { my $session = shift; + my $params = shift; return $session->privilege->insufficient unless canView($session); my $id = $session->form->param("adId") || "new"; 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=manageAdSpaces"), $i18n->get("manage ad spaces")); my $f = WebGUI::HTMLForm->new($session); + $f->submit; $f->hidden(name=>"adId", value=>$id); $f->hidden(name=>"adSpaceId", value=> $session->form->param("adSpaceId")); @@ -240,6 +242,7 @@ The save method for www_editAd() sub www_editAdSave { my $session = shift; return $session->privilege->insufficient unless canView($session); + my $i18n = WebGUI::International->new($session,"AdSpace"); my %properties = ( type=>$session->form->process("type", "selectBox"), url=>$session->form->process("url", "url"), @@ -256,6 +259,7 @@ sub www_editAdSave { ); my $storageId = $session->form->process("image","image"); $properties{storageId} = $storageId if (defined $storageId); + if ($session->form->param("adId") eq "new") { WebGUI::AdSpace::Ad->create($session, $session->form->param("adSpaceId"), \%properties); } 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 is an instantiated WebGUI::AdSpace +object. C is a hash reference of parameters with the following keys: + + errors -> An array reference of error messages to the user =cut sub www_editAdSpace { - my $session = shift; - my $adSpace = shift; - return $session->privilege->insufficient unless canView($session); - my $id; - my $i18n = WebGUI::International->new($session,"AdSpace"); - my $ac = WebGUI::AdminConsole->new($session,"adSpace"); - if (defined $adSpace) { - $id = $adSpace->getId; - } else { - $id = $session->form->param("adSpaceId") || "new"; - $adSpace = WebGUI::AdSpace->new($session, $id); - } - $ac->addSubmenuItem($session->url->page("op=editAd;adSpaceId=".$id), $i18n->get("add an ad")) if defined $adSpace; - $ac->addSubmenuItem($session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces")); - my $f = WebGUI::HTMLForm->new($session); - $f->submit; - $f->hidden(name=>"adSpaceId", value=>$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; - $f->text( - name=>"name", - value=>$value, - hoverHelp => $i18n->get("name help"), - label=>$i18n->get("name") - ); - $value = $adSpace->get("title") if defined $adSpace; - $f->text( - name=>"title", - value=>$value, - hoverHelp => $i18n->get("title help"), - label=>$i18n->get("title") - ); - $value = $adSpace->get("description") if defined $adSpace; - $f->textarea( - name=>"description", - value=>$value, - hoverHelp => $i18n->get("description help"), - label=>$i18n->get("description") - ); - $value = $adSpace->get("width") if defined $adSpace; - $f->integer( - name=>"width", - value=>$value, - defaultValue=>468, - hoverHelp => $i18n->get("width help"), - label=>$i18n->get("width") - ); - $value = $adSpace->get("height") if defined $adSpace; - $f->integer( - name=>"height", - value=>$value, - defaultValue=>60, - hoverHelp => $i18n->get("height help"), - label=>$i18n->get("height") - ); - $f->submit; - my $ads = ""; - my $code = ""; - if (defined $adSpace) { - $code = '

'.$i18n->get("macro code prompt").'
^AdSpace('.$adSpace->get("name").');

'; - my $rs = $session->db->read("select adId, title, renderedAd from advertisement where adSpaceId=?",[$id]); - while (my ($adId, $title, $ad) = $rs->array) { - $ads .= '
'.$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.'
'.$ad.'
'; - } - $ads .= '
'; - } - $ac->render($code.$f->print.$ads, $i18n->get("edit ad space")); + my $session = shift; + my $adSpace = shift; + my $params = shift; + + return $session->privilege->insufficient unless canView($session); + + my $i18n = WebGUI::International->new( $session, "AdSpace" ); + my $ac = WebGUI::AdminConsole->new( $session, "adSpace" ); + my $f = WebGUI::HTMLForm->new($session); + + # Get the adspace we're working with + my $id; + if ( $adSpace ) { + $id = $adSpace->getId; + } else { + $id = $session->form->param("adSpaceId") || "new"; + $adSpace = WebGUI::AdSpace->new($session, $id); + } + + if ( $adSpace ) { + $ac->addSubmenuItem( + $session->url->page("op=editAd;adSpaceId=".$id), $i18n->get("add an ad") + ); + } + $ac->addSubmenuItem( + $session->url->page("op=manageAdSpaces"), $i18n->get("manage ad spaces") + ); + + # Give the errors to the user + if ( $params->{errors} ) { + $f->raw( '

' . $i18n->get('error heading') . '

' + . '
    ' + . join( "", map { '
  • ' . $_ . '
    • ' } @{ $params->{errors} } ) + . '
' + ); + } + + # Build the form + $f->submit; + $f->hidden( name => "adSpaceId", value => $id ); + $f->readOnly( label => $i18n->get("ad space id"), value => $id ); + $f->hidden( name => "op", value => "editAdSpaceSave" ); + $f->text( + name => "name", + value => $session->form->get('name') || $adSpace->get("name"), + hoverHelp => $i18n->get("name help"), + label => $i18n->get("name"), + ); + $f->text( + name => "title", + value => $session->form->get('title') || $adSpace->get('title'), + hoverHelp => $i18n->get("title help"), + label => $i18n->get("title"), + ); + $f->textarea( + name => "description", + value => $session->form->get('description') || $adSpace->get('description'), + hoverHelp => $i18n->get("description help"), + label => $i18n->get("description"), + ); + $f->integer( + name => "width", + value => $session->form->get('width') || $adSpace->get('width'), + defaultValue => 468, + hoverHelp => $i18n->get("width help"), + label => $i18n->get("width"), + ); + $f->integer( + name => "height", + 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 = '

'.$i18n->get("macro code prompt").'
^AdSpace('.$adSpace->get("name").');

'; + my $rs = $session->db->read("select adId, title, renderedAd from advertisement where adSpaceId=?",[$id]); + while (my ($adId, $title, $ad) = $rs->array) { + $ads .= '
'.$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 . '
' . $ad . '
' + ; + } + $ads .= '
'; + } + + return $ac->render($code.$f->print.$ads, $i18n->get("edit ad space")); } @@ -360,23 +389,43 @@ Save the www_editAdSpace method. =cut sub www_editAdSpaceSave { - my $session = shift; - return $session->privilege->insufficient unless canView($session); - my %properties = ( - name=>$session->form->process("name", "text"), - title=>$session->form->process("title", "text"), - description=>$session->form->process("description", "textarea"), - width=>$session->form->process("width", "integer"), - height=>$session->form->process("height", "integer"), - ); - if ($session->form->param("adSpaceId") eq "new") { - my $adSpace = WebGUI::AdSpace->create($session, \%properties); - return www_editAdSpace($session, $adSpace); - } else { - my $adSpace = WebGUI::AdSpace->new($session, $session->form->param("adSpaceId")); - $adSpace->set(\%properties); - } - return www_manageAdSpaces($session); + my $session = shift; + + return $session->privilege->insufficient unless canView($session); + + my $i18n = WebGUI::International->new( $session, "AdSpace" ); + + my %properties = ( + name => $session->form->process("name", "text"), + title => $session->form->process("title", "text"), + description => $session->form->process("description", "textarea"), + width => $session->form->process("width", "integer"), + height => $session->form->process("height", "integer"), + ); + + ### Validate form entry + my @errors; + # 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); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/i18n/English/AdSpace.pm b/lib/WebGUI/i18n/English/AdSpace.pm index a5589defc..cc2d22f1a 100644 --- a/lib/WebGUI/i18n/English/AdSpace.pm +++ b/lib/WebGUI/i18n/English/AdSpace.pm @@ -294,6 +294,16 @@ our $I18N = { 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; diff --git a/t/Mail/Send.t b/t/Mail/Send.t index 1dddc21bf..3a356d253 100644 --- a/t/Mail/Send.t +++ b/t/Mail/Send.t @@ -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 = ) { + $json .= $line; + } + + close MAIL + or die "Could not close pipe to SMTPD: $!"; + + return from_json( $json ); +} + diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index b074dc07d..bfd98c45d 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -32,6 +32,7 @@ use IO::Handle qw[]; use File::Spec qw[]; use Test::MockObject::Extends; use WebGUI::PseudoRequest; +use Scalar::Util qw( blessed ); ##Hack to get ALL test output onto STDOUT. 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. -pageName is the name of the page subroutine to run. options is a hash reference -of options with keys outlined below. +Get the entire response from a page request. C is a WebGUI::Asset +object. C is a string containing a fully-qualified subroutine name. +C is the name of the page subroutine to run (may be C for +sub strings. C is a hash reference of options with keys outlined +below. args => Array reference of arguments to the pageName sub user => A user object to set for this request @@ -183,7 +186,7 @@ of options with keys outlined below. sub getPage { my $class = shift; 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 $optionsRef = shift; # A hashref of options # args => Array ref of args to the page sub @@ -217,7 +220,20 @@ sub getPage { $session->{_request} = $request; # 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") { print $output $returnedContent; } diff --git a/t/smtpd.pl b/t/smtpd.pl new file mode 100644 index 000000000..88ea75c3a --- /dev/null +++ b/t/smtpd.pl @@ -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 + +=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 after opening a pipe to this so that it can establish the +listening on the port.