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