Add Catalyst::Test::MessageDriven for in-process testing of messaging apps.

Add a simple test using it.

diff --git a/lib/Catalyst/Test/MessageDriven.pm b/lib/Catalyst/Test/MessageDriven.pm
new file mode 100644 (file)
index 0000000..75c0f3b
--- /dev/null
+++ b/lib/Catalyst/Test/MessageDriven.pm
@@ -0,0 +1,103 @@
+package Catalyst::Test::MessageDriven;
+use Class::MOP;
+use Sub::Exporter;
+use HTTP::Request;
+
+BEGIN {
+       $ENV{CATALYST_ENGINE} = 'Test::MessageDriven';
+};
+
+=head1 NAME
+
+Catalyst::Test::MessageDriven - test message-driven Catalyst apps
+
+=head1 DESCRIPTION
+
+Derived from Catalyst::Test, this module provides a way to run tests
+against message-driven Catalyst applications - those with
+Catalyst::Controller::MessageDriven-based controllers, and expect to
+run with Catalyst::Engine::Stomp. 
+
+=head1 SYNOPSIS
+
+  BEGIN { use_ok 'Catalyst::Test::MessageDriven', 'SomeApp' };
+
+  my $req = '... some message text ...';
+  my $queue = 'somequeue';
+  my $res = request($queue, $req);
+  ok($res);
+
+=head1 EXPORTS
+
+=head2 request(queue, message)
+
+This function accepts a queue and a message, and runs the request in
+that context. Returns a response object. 
+
+=head1 TODO
+
+Some test wrappers - successful / error message conditions?
+
+=cut
+
+my $build_exports = sub {
+       my ($self, $meth, $args, $defaults) = @_;
+
+       my $request;
+       my $class = $args->{class};
+
+       if (!$class) {
+               $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test::MessageDriven 'TestApp'") };
+       }
+       else {
+               unless (Class::MOP::is_class_loaded($class)) {
+                       Class::MOP::load_class($class);
+               }
+               $class->import;
+
+               my $app = $class->run();
+               $request = sub { message_driven_request( $app, @_ ) };
+       }
+       
+       return {
+               request => $request,
+       };
+};
+
+{
+       my $import = Sub::Exporter::build_exporter({
+               groups => [ all => $build_exports ],
+               into_level => 1,
+       });
+
+       sub import {
+               my ($self, $class) = @_;
+               $import->($self, '-all' => { class => $class });
+               return 1;
+       }
+}
+
+sub message_driven_request {
+       my ($app, $path, $req_message) = @_;
+       my $url = "message://localhost:61613/$path";
+
+       my $request = HTTP::Request->new( POST => $url );
+       $request->content($req_message);
+       $request->content_length(length $req_message);
+       $request->content_type('application/octet-stream');
+    
+       my $response;
+       $app->handle_request($request, \$response);
+
+       return $response;
+}
+
+package Catalyst::Engine::Test::MessageDriven;
+use base 'Catalyst::Engine::Embeddable';
+
+sub run {
+       my ($self, $app) = @_;
+       return $app;
+}
+
+1;

diff --git a/t/04-message-driven-request.t b/t/04-message-driven-request.t
new file mode 100644 (file)
index 0000000..7d169ed
--- /dev/null
+++ b/t/04-message-driven-request.t
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+use FindBin;
+use lib "$FindBin::Bin/../testapp/lib";
+
+BEGIN { use_ok 'Catalyst::Test::MessageDriven', 'StompTestApp' };
+
+my $req = "---\ntype: ping\n";
+my $res = request('testcontroller', $req);
+ok($res, 'response to ping message');
+ok($res->is_success, 'successful response');

diff --git a/testapp/lib/StompTestApp/Controller/TestController.pm b/testapp/lib/StompTestApp/Controller/TestController.pm
index d086637..9ae99d5 100644 (file)
--- a/testapp/lib/StompTestApp/Controller/TestController.pm
+++ b/testapp/lib/StompTestApp/Controller/TestController.pm
@@ -18,4 +18,13 @@ sub badaction : Local {
     die "oh noes";
 }
 
+sub ping : Local {
+    my ($self, $c, $request) = @_;
+    if ($request->{type} eq 'ping') {
+           $c->stash->{response} = { status => 'PONG' };
+           return;
+    }
+    die "not a ping request?";
+}
+
 1;