0.02 Sun May 17 00:00:00 2009
Rename TestApp
-0.03 Thu May 21 22:57:00 2009
+0.03 Thu May 21 22:57:00 2009
Depend on a less hateful Alien::ActiveMQ
+
+0.04 Mon Jun 01 09:21:00 2009
+ Remove dependency on Catalyst::Action::REST, use
+ Data::Serializer directly instead.
META.yml
README
t/00_use.t
-t/Catalyst-Engine-Stomp.t
+t/01-good-message.t
+t/02-bad-action.t
+t/03-json-message.t
+t/server.pl
testapp/lib/StompTestApp.pm
testapp/lib/StompTestApp/Controller/TestController.pm
+testapp/lib/StompTestApp/Controller/TestJsonController.pm
testapp/lib/StompTestApp/stomptestapp.yml
testapp/script/stomptestapp_stomp.pl
testapp/script/stomptestapp_stomp_workers.pl
all_from 'lib/Catalyst/Engine/Stomp.pm';
requires 'Catalyst::Engine::Embeddable' => '0.0.1';
-requires 'Catalyst::Action::REST' => undef;
requires 'Catalyst::Runtime' => '5.80004';
requires 'Moose' => undef;
requires 'MooseX::Workers' => '0.05';
requires 'Net::Stomp' => '0.34';
requires 'YAML::XS' => '0.32';
+requires 'Data::Serializer' => '0.49';
requires 'namespace::autoclean' => '0.05';
test_requires 'Alien::ActiveMQ' => '0.00003';
no_index package => 'StompTestApp';
no_index package => 'StompTestApp::Controller::TestController';
+no_index package => 'StompTestApp::Controller::TestJsonController';
my @force_build_requires_if_author = qw(
Test::NoTabs
Moose
Net::Stomp
YAML::XS
+ Data::Serializer
Catalyst::Engine::Embeddable
Catalyst::Runtime 5.80003
- Catalyst::Action::REST
namespace::autoclean
-The supplied workers script requires MooseX::Workers.
+The supplied workers script requires MooseX::Workers, and you'll need
+the relevant modules to support Data::Serializer if you choose
+something other than YAML as a message format.
COPYRIGHT AND LICENCE
package Catalyst::Controller::MessageDriven;
use Moose;
+use Data::Serializer;
BEGIN { extends 'Catalyst::Controller' }
use Moose;
BEGIN { extends 'Catalyst::Controller::MessageDriven' }
- sub some_action : Local {
- my ($self, $c) = @_;
+ sub some_action : Local {
+ my ($self, $c, $message) = @_;
+
+ # Handle message
+
# Reply with a minimal response message
my $response = { type => 'testaction_response' };
$c->stash->{response} = $response;
A Catalyst controller base class for use with Catalyst::Engine::Stomp,
which handles YAML-serialized messages. A top-level "type" key in the
-YAML determines the action dispatched to.
+YAML determines the action dispatched to.
=cut
-__PACKAGE__->config(
- 'default' => 'text/x-yaml',
- 'stash_key' => 'response',
- 'map' => { 'text/x-yaml' => 'YAML' },
- );
-
-sub begin :ActionClass('Deserialize') { }
-
-sub end :ActionClass('Serialize') {
- my ($self, $c) = @_;
-
- # Engine will send our reply based on the value of this header.
- $c->response->headers->header( 'X-Reply-Address' => $c->req->data->{reply_to} );
+__PACKAGE__->config( serializer => 'YAML' );
+
+sub begin : Private {
+ my ($self, $c) = @_;
+
+ # Deserialize the request message
+ my $message;
+ my $serializer = $self->config->{serializer};
+ my $s = Data::Serializer->new( serializer => $serializer );
+ eval {
+ my $body = $c->request->body;
+ open my $IN, "$body" or die "can't open temp file $body";
+ $message = $s->raw_deserialize(do { local $/; <$IN> });
+ };
+ if ($@) {
+ # can't reply - reply_to is embedded in the message
+ $c->error("exception in deserialize: $@");
+ }
+ else {
+ $c->stash->{request} = $message;
+ }
+}
- # Custom error handler - steal errors from catalyst and dump them into
- # the stash, to get them serialized out as the reply.
- if (scalar @{$c->error}) {
- my $error = join "\n", @{$c->error};
- $c->stash->{response} = { status => 'ERROR', error => $error };
- $c->error(0); # clear errors, so our response isn't clobbered
- }
+sub end : Private {
+ my ($self, $c) = @_;
+
+ # Engine will send our reply based on the value of this header.
+ $c->response->headers->header( 'X-Reply-Address' => $c->stash->{request}->{reply_to} );
+
+ # The wire response
+ my $output;
+
+ # Load a serializer
+ my $serializer = $self->config->{serializer};
+ my $s = Data::Serializer->new( serializer => $serializer );
+
+ # Custom error handler - steal errors from catalyst and dump them into
+ # the stash, to get them serialized out as the reply.
+ if (scalar @{$c->error}) {
+ my $error = join "\n", @{$c->error};
+ $c->stash->{response} = { status => 'ERROR', error => $error };
+ $output = $s->serialize( $c->stash->{response} );
+ $c->clear_errors;
+ $c->response->status(400);
+ }
+
+ # Serialize the response
+ eval {
+ $output = $s->raw_serialize( $c->stash->{response} );
+ };
+ if ($@) {
+ my $error = "exception in serialize: $@";
+ $c->stash->{response} = { status => 'ERROR', error => $error };
+ $output = $s->serialize( $c->stash->{response} );
+ $c->response->status(400);
+ }
+
+ $c->response->output( $output );
}
sub default : Private {
- my ($self, $c) = @_;
-
- # Forward the request to the appropriate action, based on the
- # message type.
- my $action = $c->req->data->{type};
- $c->forward($action, [$c->req->data]);
+ my ($self, $c) = @_;
+
+ # Forward the request to the appropriate action, based on the
+ # message type.
+ my $action = $c->stash->{request}->{type};
+ if (defined $action) {
+ $c->forward($action, [$c->stash->{request}]);
+ }
+ else {
+ $c->error('no message type specified');
+ }
}
__PACKAGE__->meta->make_immutable;
-=head1 METHODS
-
-=head2 default
-
-Forwards the request to the appropriate action based on the 'type' field
-within the message data.
-
-=head2 begin
-
-Uses L<Catalyst::Action::Deserialize> to unserialize the message.
-
-=head2 end
-
-Serializes the data stashed by the dispatched action, and
-arranges for the reply to be sent to the endpoint nominated in
-the request's 'reply_to' field.
-
-Supplies custom exception handling which returns
-throw exceptions as a serialized return message.
-
-=cut
-
+1;
use Moose;
extends 'Catalyst::Engine::Embeddable';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
use List::MoreUtils qw/ uniq /;
use HTTP::Request;
BEGIN {
$ENV{CATALYST_ENGINE} = 'Stomp';
require Catalyst::Engine::Stomp;
- }
+ }
MyApp->config->{Engine::Stomp} =
{
$c->stash->{response} = $response;
}
- # The default serialization is YAML, but this configuration
- # may be overridden in your controller:
- __PACKAGE__->config(
- 'default' => 'text/x-yaml',
- 'stash_key' => 'rest',
- 'map' => { 'text/x-yaml' => 'YAML' },
- );
-
=head1 DESCRIPTION
Write a Catalyst app connected to a Stomp messagebroker, not HTTP. You
-need a controller that understands messaging, as well as this engine.
+need a controller that understands messaging, as well as this engine.
This is single-threaded and single process - you need to run multiple
instances of this engine to get concurrency, and configure your broker
Controllers are mapped to Stomp queues, and a controller base class is
provided, Catalyst::Controller::MessageDriven, which implements
-YAML-serialized messages, mapping a top-level YAML "type" key to
-the action.
+YAML-serialized messages, mapping a top-level YAML "type" key to
+the action.
=head1 METHODS
my ($self, $app, $oneshot) = @_;
die 'No Engine::Stomp configuration found'
- unless ref $app->config->{'Engine::Stomp'} eq 'HASH';
+ unless ref $app->config->{'Engine::Stomp'} eq 'HASH';
# list the path namespaces that will be mapped as queues.
- #
- # this is known to use the deprecated
- # Dispatcher->action_hash() method, but there doesn't appear
- # to be another way to get the relevant strings out.
- #
- # http://github.com/rafl/catalyst-runtime/commit/5de163f4963d9dbb41d7311ca6f17314091b7af3#L2R644
- #
+ #
+ # this is known to use the deprecated
+ # Dispatcher->action_hash() method, but there doesn't appear
+ # to be another way to get the relevant strings out.
+ #
+ # http://github.com/rafl/catalyst-runtime/commit/5de163f4963d9dbb41d7311ca6f17314091b7af3#L2R644
+ #
my @queues =
- uniq
- grep { length $_ }
- map { $_->namespace }
- values %{$app->dispatcher->action_hash};
+ uniq
+ grep { length $_ }
+ map { $_->namespace }
+ values %{$app->dispatcher->action_hash};
- # connect up
+ # connect up
my %template = %{$app->config->{'Engine::Stomp'}};
- $self->connection(Net::Stomp->new(\%template));
- $self->connection->connect();
- $self->conn_desc($template{hostname}.':'.$template{port});
+ $self->connection(Net::Stomp->new(\%template));
+ $self->connection->connect();
+ $self->conn_desc($template{hostname}.':'.$template{port});
- # subscribe, with client ack.
+ # subscribe, with client ack.
foreach my $queue (@queues) {
- my $queue_name = "/queue/$queue";
- $self->connection->subscribe({
- destination => $queue_name,
- ack => 'client',
- });
+ my $queue_name = "/queue/$queue";
+ $self->connection->subscribe({
+ destination => $queue_name,
+ ack => 'client'
+ });
}
- # enter loop...
- while (1) {
- my $frame = $self->connection->receive_frame();
- $self->handle_stomp_frame($app, $frame);
- last if $ENV{ENGINE_ONESHOT};
- }
- exit 0;
+ # enter loop...
+ while (1) {
+ my $frame = $self->connection->receive_frame();
+ $self->handle_stomp_frame($app, $frame);
+ last if $ENV{ENGINE_ONESHOT};
+ }
+ exit 0;
}
=head2 prepare_request
sub prepare_request {
my ($self, $c, $req, $res_ref) = @_;
- shift @_;
- $self->next::method(@_);
- $c->req->address($self->conn_desc);
+ shift @_;
+ $self->next::method(@_);
+ $c->req->address($self->conn_desc);
}
=head2 finalize_headers
=cut
sub finalize_headers {
- my ($self, $c) = @_;
- my $error = join "\n", @{$c->error};
- if ($error) {
- $c->log->debug($error);
- }
- return $self->next::method($c);
+ my ($self, $c) = @_;
+ my $error = join "\n", @{$c->error};
+ if ($error) {
+ $c->log->debug($error);
+ }
+ return $self->next::method($c);
}
=head2 handle_stomp_frame
=cut
sub handle_stomp_frame {
- my ($self, $app, $frame) = @_;
-
- my $command = $frame->command();
- if ($command eq 'MESSAGE') {
- $self->handle_stomp_message($app, $frame);
- }
- elsif ($command eq 'ERROR') {
- $self->handle_stomp_error($app, $frame);
- }
- else {
- $app->log->debug("Got unknown Stomp command: $command");
- }
+ my ($self, $app, $frame) = @_;
+
+ my $command = $frame->command();
+ if ($command eq 'MESSAGE') {
+ $self->handle_stomp_message($app, $frame);
+ }
+ elsif ($command eq 'ERROR') {
+ $self->handle_stomp_error($app, $frame);
+ }
+ else {
+ $app->log->debug("Got unknown Stomp command: $command");
+ }
}
=head2 handle_stomp_message
=cut
sub handle_stomp_message {
- my ($self, $app, $frame) = @_;
+ my ($self, $app, $frame) = @_;
- # queue -> controller
- my $queue = $frame->headers->{destination};
- my ($controller) = $queue =~ m!^/queue/(.*)$!;
+ # queue -> controller
+ my $queue = $frame->headers->{destination};
+ my ($controller) = $queue =~ m!^/queue/(.*)$!;
- # set up request
+ # set up request
my $config = $app->config->{'Engine::Stomp'};
my $url = 'stomp://'.$config->{hostname}.':'.$config->{port}.'/'.$controller;
my $req = HTTP::Request->new(POST => $url);
$req->content($frame->body);
- $req->content_length(length $frame->body);
+ $req->content_length(length $frame->body);
- # dispatch
- my $response;
+ # dispatch
+ my $response;
$app->handle_request($req, \$response);
- # reply
- my $reply_queue = '/remote-temp-queue/' . ($response->headers->header('X-Reply-Address'));
- $self->connection->send({ destination => $reply_queue, body => $response->content });
+ # reply, if header set
+ if (my $reply_to = $response->headers->header('X-Reply-Address')) {
+ my $reply_queue = '/remote-temp-queue/' . $reply_to;
+ $self->connection->send({ destination => $reply_queue, body => $response->content });
+ }
- # ack the message off the queue now we've replied
- $self->connection->ack( { frame => $frame } );
+ # ack the message off the queue now we've replied / processed
+ $self->connection->ack( { frame => $frame } );
}
=head2 handle_stomp_error
=cut
sub handle_stomp_error {
- my ($self, $app, $frame) = @_;
-
- my $error = $frame->headers->{message};
- $app->log->debug("Got Stomp error: $error");
+ my ($self, $app, $frame) = @_;
+
+ my $error = $frame->headers->{message};
+ $app->log->debug("Got Stomp error: $error");
}
__PACKAGE__->meta->make_immutable;
--- /dev/null
+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;
--- /dev/null
+use Test::More;
+
+# Tests which expect a STOMP server like ActiveMQ to exist on
+# localhost:61613, which is what you get if you just get the ActiveMQ
+# distro and run its out-of-the-box config.
+
+use Net::Stomp;
+use YAML::XS qw/ Dump Load /;
+use Data::Dumper;
+
+use FindBin;
+use lib "$FindBin::Bin";
+require 'server.pl';
+
+plan tests => 11;
+
+my $frame = $stomp->connect();
+ok($frame, 'connect to MQ server ok');
+
+my $reply_to = sprintf '%s:1', $frame->headers->{session};
+ok($frame->headers->{session}, 'got a session');
+ok(length $reply_to > 2, 'valid-looking reply_to queue');
+
+ok($stomp->subscribe( { destination => '/temp-queue/reply' } ), 'subscribe to temp queue');
+
+my $message = {
+ payload => { foo => 1, bar => 2 },
+ reply_to => $reply_to,
+ type => 'testaction',
+ };
+my $text = Dump($message);
+ok($text, 'compose message');
+
+$stomp->send( { destination => '/queue/testcontroller', body => $text } );
+
+my $reply_frame = $stomp->receive_frame();
+ok($reply_frame, 'got a reply');
+ok($reply_frame->headers->{destination} eq "/remote-temp-queue/$reply_to", 'came to correct temp queue');
+ok($reply_frame->body, 'has a body');
+
+my $response = Load($reply_frame->body);
+ok($response, 'YAML response ok');
+ok($response->{type} eq 'testaction_response', 'correct type');
+
+ok($stomp->disconnect, 'disconnected');
+
--- /dev/null
+use Test::More;
+
+# Tests which expect a STOMP server like ActiveMQ to exist on
+# localhost:61613, which is what you get if you just get the ActiveMQ
+# distro and run its out-of-the-box config.
+
+use Net::Stomp;
+use YAML::XS qw/ Dump Load /;
+use Data::Dumper;
+
+use FindBin;
+use lib "$FindBin::Bin";
+require 'server.pl';
+
+plan tests => 12;
+
+my $frame = $stomp->connect();
+ok($frame, 'connect to MQ server ok');
+
+my $reply_to = sprintf '%s:1', $frame->headers->{session};
+ok($frame->headers->{session}, 'got a session');
+ok(length $reply_to > 2, 'valid-looking reply_to queue');
+
+ok($stomp->subscribe( { destination => '/temp-queue/reply' } ), 'subscribe to temp queue');
+
+# Test what happens when the action crashes
+my $message = {
+ payload => { foo => 1, bar => 2 },
+ reply_to => $reply_to,
+ type => 'badaction',
+ };
+my $text = Dump($message);
+ok($text, 'compose message for badaction');
+
+$stomp->send( { destination => '/queue/testcontroller', body => $text } );
+
+my $reply_frame = $stomp->receive_frame();
+ok($reply_frame, 'got a reply');
+ok($reply_frame->headers->{destination} eq "/remote-temp-queue/$reply_to", 'came to correct temp queue');
+ok($reply_frame->body, 'has a body');
+
+my $response = Load($reply_frame->body);
+ok($response, 'YAML response ok');
+ok($response->{status} eq 'ERROR', 'is an error');
+ok($response->{error} =~ /oh noes/);
+
+ok($stomp->disconnect, 'disconnected');
+
--- /dev/null
+use Test::More;
+
+# Tests which expect a STOMP server like ActiveMQ to exist on
+# localhost:61613, which is what you get if you just get the ActiveMQ
+# distro and run its out-of-the-box config.
+
+use Net::Stomp;
+
+eval {
+ use JSON;
+};
+if ($@) {
+ plan 'skip_all' => 'JSON not installed, skipping JSON-format test';
+}
+
+use FindBin;
+use lib "$FindBin::Bin";
+require 'server.pl';
+
+plan tests => 11;
+
+my $frame = $stomp->connect();
+ok($frame, 'connect to MQ server ok');
+
+my $reply_to = sprintf '%s:1', $frame->headers->{session};
+ok($frame->headers->{session}, 'got a session');
+ok(length $reply_to > 2, 'valid-looking reply_to queue');
+
+ok($stomp->subscribe( { destination => '/temp-queue/reply' } ), 'subscribe to temp queue');
+
+my $message = {
+ payload => { foo => 1, bar => 2 },
+ reply_to => $reply_to,
+ type => 'testaction',
+ };
+my $text = to_json($message);
+ok($text, 'compose message');
+
+$stomp->send( { destination => '/queue/testjsoncontroller', body => $text } );
+
+my $reply_frame = $stomp->receive_frame();
+ok($reply_frame, 'got a reply');
+ok($reply_frame->headers->{destination} eq "/remote-temp-queue/$reply_to", 'came to correct temp queue');
+ok($reply_frame->body, 'has a body');
+
+my $response = from_json($reply_frame->body);
+
+ok($response, 'JSON response ok');
+ok($response->{type} eq 'testaction_response', 'correct type');
+
+ok($stomp->disconnect, 'disconnected');
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+use FindBin;
+use lib "$FindBin::Bin/../testapp/lib";
+
+BEGIN { use_ok 'Catalyst::Test::MessageDriven', 'StompTestApp' };
+
+# successful request - type is minimum attributes
+my $req = "---\ntype: ping\n";
+my $res = request('testcontroller', $req);
+ok($res, 'response to ping message');
+ok($res->is_success, 'successful response');
+
+# unsuccessful empty request - no type
+$req = "--- ~\n";
+$res = request('testcontroller', $req);
+ok($res, 'response to empty message');
+ok($res->is_error, 'unsuccessful response');
+++ /dev/null
-use Test::More;
-
-# Tests which expect a STOMP server like ActiveMQ to exist on
-# localhost:61613, which is what you get if you just get the ActiveMQ
-# distro and run its out-of-the-box config.
-
-use Net::Stomp;
-use YAML::XS qw/ Dump Load /;
-use Data::Dumper;
-
-use Alien::ActiveMQ;
-my $ACTIVEMQ_VERSION = '5.2.0';
-
-my ($stomp, $mq);
-eval {
- $stomp = Net::Stomp->new( { hostname => 'localhost', port => 61613 } );
-};
-if ($@) {
-
- unless (Alien::ActiveMQ->is_version_installed($ACTIVEMQ_VERSION)) {
- plan 'skip_all' => 'No ActiveMQ server installed by Alien::ActiveMQ, try running the "install-activemq" command';
- exit;
- }
-
- $mq = Alien::ActiveMQ->run_server($ACTIVEMQ_VERSION);
-
- eval {
- $stomp = Net::Stomp->new( { hostname => 'localhost', port => 61613 } );
- };
- if ($@) {
- plan 'skip_all' => 'No ActiveMQ server listening on 61613: ' . $@;
- exit;
- }
-}
-
-plan tests => 12;
-
-# First fire off the server
-$SIG{CHLD} = 'IGNORE';
-unless (fork()) {
- system("$^X -Ilib -Itestapp/lib testapp/script/stomptestapp_stomp.pl --oneshot");
- exit 0;
-}
-print STDERR "server started, waiting for spinup...";
-sleep 20;
-
-# Now be a client to that server
-print STDERR "testing\n";
-ok($stomp, 'Net::Stomp object');
-
-my $frame = $stomp->connect();
-ok($frame, 'connect to MQ server ok');
-
-my $reply_to = sprintf '%s:1', $frame->headers->{session};
-ok($frame->headers->{session}, 'got a session');
-ok(length $reply_to > 2, 'valid-looking reply_to queue');
-
-ok($stomp->subscribe( { destination => '/temp-queue/reply' } ), 'subscribe to temp queue');
-
-my $message = {
- payload => { foo => 1, bar => 2 },
- reply_to => $reply_to,
- type => 'testaction',
- };
-my $text = Dump($message);
-ok($text, 'compose message');
-
-$stomp->send( { destination => '/queue/testcontroller', body => $text } );
-
-my $reply_frame = $stomp->receive_frame();
-ok($reply_frame, 'got a reply');
-ok($reply_frame->headers->{destination} eq "/remote-temp-queue/$reply_to", 'came to correct temp queue');
-ok($reply_frame->body, 'has a body');
-
-my $response = Load($reply_frame->body);
-ok($response, 'YAML response ok');
-ok($response->{type} eq 'testaction_response', 'correct type');
-
-ok($stomp->disconnect, 'disconnected');
-
--- /dev/null
+use Alien::ActiveMQ;
+my $ACTIVEMQ_VERSION = '5.2.0';
+
+eval {
+ $stomp = Net::Stomp->new( { hostname => 'localhost', port => 61613 } );
+};
+if ($@) {
+
+ unless (Alien::ActiveMQ->is_version_installed($ACTIVEMQ_VERSION)) {
+ plan 'skip_all' => 'No ActiveMQ server installed by Alien::ActiveMQ, try running the "install-activemq" command';
+ exit;
+ }
+
+ $mq = Alien::ActiveMQ->run_server($ACTIVEMQ_VERSION);
+
+ eval {
+ $stomp = Net::Stomp->new( { hostname => 'localhost', port => 61613 } );
+ };
+ if ($@) {
+ plan 'skip_all' => 'No ActiveMQ server listening on 61613: ' . $@;
+ exit;
+ }
+}
+
+$SIG{CHLD} = 'IGNORE';
+unless (fork()) {
+ system("$^X -Ilib -Itestapp/lib testapp/script/stomptestapp_stomp.pl --oneshot");
+ exit 0;
+}
+print STDERR "server started, waiting for spinup...";
+sleep 20;
+
BEGIN { extends 'Catalyst::Controller::MessageDriven' };
sub testaction : Local {
- my ($self, $c) = @_;
+ my ($self, $c, $request) = @_;
# Reply with a minimal response message
my $response = { type => 'testaction_response' };
$c->stash->{response} = $response;
}
+sub badaction : Local {
+ my ($self, $c, $request) = @_;
+ 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;
--- /dev/null
+package # Hide from PAUSE
+ StompTestApp::Controller::TestJsonController;
+use Moose;
+use namespace::autoclean;
+
+BEGIN { extends 'Catalyst::Controller::MessageDriven' };
+
+__PACKAGE__->config( serializer => 'JSON' );
+
+sub testaction : Local {
+ my ($self, $c, $request) = @_;
+
+ # Reply with a minimal response message
+ my $response = { type => 'testaction_response' };
+ $c->stash->{response} = $response;
+}
+
+1;
projects / catagits/Catalyst-Engine-STOMP.git / commitdiff