t/lib/Catalyst/Test/MessageDriven.pm

   1 package # PAUSE hide
   2     Catalyst::Test::MessageDriven;
   3 use Class::MOP;
   4 use Sub::Exporter;
   5 use HTTP::Request;
   6
   7 BEGIN {
   8     $ENV{CATALYST_ENGINE} = 'Test::MessageDriven';
   9 };
  10
  11 =head1 NAME
  12
  13 Catalyst::Test::MessageDriven - test message-driven Catalyst apps
  14
  15 =head1 DESCRIPTION
  16
  17 Derived from Catalyst::Test, this module provides a way to run tests
  18 against message-driven Catalyst applications - those with
  19 Catalyst::Controller::MessageDriven-based controllers, and expect to
  20 run with Catalyst::Engine::Stomp.
  21
  22 =head1 SYNOPSIS
  23
  24   BEGIN { use_ok 'Catalyst::Test::MessageDriven', 'SomeApp' };
  25
  26   my $req = '... some message text ...';
  27   my $queue = 'somequeue';
  28   my $res = request($queue, $req);
  29   ok($res);
  30
  31 =head1 EXPORTS
  32
  33 =head2 request(queue, message)
  34
  35 This function accepts a queue and a message, and runs the request in
  36 that context. Returns a response object.
  37
  38 =head1 TODO
  39
  40 Some test wrappers - successful / error message conditions?
  41
  42 =cut
  43
  44 my $message_driven_request = sub {
  45     my ($app, $path, $req_message) = @_;
  46     my $url = "message://localhost:61613/$path";
  47
  48     my $request = HTTP::Request->new( POST => $url );
  49     $request->content($req_message);
  50     $request->content_length(length $req_message);
  51     $request->content_type('application/octet-stream');
  52
  53     my $response;
  54     $app->handle_request($request, \$response);
  55
  56     return $response;
  57 };
  58
  59 my $build_exports = sub {
  60     my ($self, $meth, $args, $defaults) = @_;
  61
  62     my $request;
  63     my $class = $args->{class};
  64
  65     if (!$class) {
  66         $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test::MessageDriven 'TestApp'") };
  67     }
  68     else {
  69         unless (Class::MOP::is_class_loaded($class)) {
  70             Class::MOP::load_class($class);
  71         }
  72         $class->import;
  73
  74         my $app = $class->run();
  75         $request = sub { $message_driven_request->( $app, @_ ) };
  76     }
  77
  78     return {
  79         request => $request,
  80     };
  81 };
  82
  83 {
  84     my $import = Sub::Exporter::build_exporter({
  85         groups => [ all => $build_exports ],
  86         into_level => 1,
  87     });
  88
  89     sub import {
  90         my ($self, $class) = @_;
  91         $import->($self, '-all' => { class => $class });
  92         return 1;
  93     }
  94 }
  95
  96 package # Hide from PAUSE
  97     Catalyst::Engine::Test::MessageDriven;
  98 use base 'Catalyst::Engine::Embeddable';
  99
 100 sub run {
 101     my ($self, $app) = @_;
 102     return $app;
 103 }
 104
 105 1;
 106