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

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 = <MAIL> ) {
+        $json   .= $line; 
+    }
+
+    close MAIL 
+        or die "Could not close pipe to SMTPD: $!";
+
+    return from_json( $json );
+}
+

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<asset> is a WebGUI::Asset 
+object. C<sub> is a string containing a fully-qualified subroutine name. 
+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
  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;
     }

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 <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.