lib/CatalystX/Test/MessageDriven.pm

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