Commit | Line | Data |
40e96678 |
1 | package Catalyst::Test::MessageDriven; |
2 | use Class::MOP; |
3 | use Sub::Exporter; |
4 | use HTTP::Request; |
5 | |
6 | BEGIN { |
9f1c9f42 |
7 | $ENV{CATALYST_ENGINE} = 'Test::MessageDriven'; |
40e96678 |
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 |
8edb2b46 |
19 | run with Catalyst::Engine::Stomp. |
40e96678 |
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 |
8edb2b46 |
35 | that context. Returns a response object. |
40e96678 |
36 | |
37 | =head1 TODO |
38 | |
39 | Some test wrappers - successful / error message conditions? |
40 | |
41 | =cut |
42 | |
0ffa11ae |
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 | |
40e96678 |
58 | my $build_exports = sub { |
9f1c9f42 |
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 Catalyst::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(); |
0ffa11ae |
74 | $request = sub { $message_driven_request->( $app, @_ ) }; |
9f1c9f42 |
75 | } |
76 | |
77 | return { |
78 | request => $request, |
79 | }; |
40e96678 |
80 | }; |
81 | |
82 | { |
9f1c9f42 |
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 | } |
40e96678 |
93 | } |
94 | |
9f1c9f42 |
95 | package # Hide from PAUSE |
96 | Catalyst::Engine::Test::MessageDriven; |
40e96678 |
97 | use base 'Catalyst::Engine::Embeddable'; |
98 | |
99 | sub run { |
9f1c9f42 |
100 | my ($self, $app) = @_; |
101 | return $app; |
40e96678 |
102 | } |
103 | |
104 | 1; |
8edb2b46 |
105 | |