e7f29d537a82fcea1d74183173d05da6c2c0a221
[catagits/Catalyst-Engine-STOMP.git] / lib / Catalyst / Test / MessageDriven.pm
1 package Catalyst::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 Catalyst::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 'Catalyst::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 $build_exports = sub {
44     my ($self, $meth, $args, $defaults) = @_;
45
46     my $request;
47     my $class = $args->{class};
48
49     if (!$class) {
50         $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test::MessageDriven 'TestApp'") };
51     }
52     else {
53         unless (Class::MOP::is_class_loaded($class)) {
54             Class::MOP::load_class($class);
55         }
56         $class->import;
57
58         my $app = $class->run();
59         $request = sub { message_driven_request( $app, @_ ) };
60     }
61
62     return {
63         request => $request,
64     };
65 };
66
67 {
68     my $import = Sub::Exporter::build_exporter({
69         groups => [ all => $build_exports ],
70         into_level => 1,
71     });
72
73     sub import {
74         my ($self, $class) = @_;
75         $import->($self, '-all' => { class => $class });
76         return 1;
77     }
78 }
79
80 sub message_driven_request {
81     my ($app, $path, $req_message) = @_;
82     my $url = "message://localhost:61613/$path";
83
84     my $request = HTTP::Request->new( POST => $url );
85     $request->content($req_message);
86     $request->content_length(length $req_message);
87     $request->content_type('application/octet-stream');
88
89     my $response;
90     $app->handle_request($request, \$response);
91
92     return $response;
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