File Coverage

blib/lib/Plack/Test/AnyEvent.pm
Criterion Covered Total %
statement 100 105 95.2
branch 20 26 76.9
condition 2 3 66.6
subroutine 13 13 100.0
pod 2 2 100.0
total 137 149 91.9


line stmt bran cond sub pod time code
1             ## no critic (RequireUseStrict)
2             package Plack::Test::AnyEvent;
3             $Plack::Test::AnyEvent::VERSION = '0.06';
4             ## use critic (RequireUseStrict)
5 5     5   49116 use strict;
  5         9  
  5         192  
6 5     5   22 use warnings;
  5         6  
  5         152  
7 5     5   2497 use autodie qw(pipe);
  5         338181  
  5         42  
8              
9 5     5   5906 use AnyEvent::Handle;
  5         75128  
  5         247  
10 5     5   52 use Carp;
  5         9  
  5         368  
11 5     5   26 use HTTP::Request;
  5         9  
  5         127  
12 5     5   3127 use HTTP::Message::PSGI;
  5         83903  
  5         319  
13 5     5   43 use IO::Handle;
  5         6  
  5         157  
14              
15 5     5   2648 use Plack::Test::AnyEvent::Response;
  5         15  
  5         4803  
16              
17             # code adapted from Plack::Test::MockHTTP
18             sub test_psgi {
19 65     65 1 83013 my ( %args ) = @_;
20              
21 65 50       334 my $client = delete $args{client} or croak "client test code needed";
22 65 50       243 my $app = delete $args{app} or croak "app needed";
23              
24             my $cb = sub {
25 70     70   29124 my ( $req ) = @_;
26 70 50       231 $req->uri->scheme('http') unless defined $req->uri->scheme;
27 70 50       21171 $req->uri->host('localhost') unless defined $req->uri->host;
28 70         6842 my $env = $req->to_psgi;
29 70         43479 $env->{'psgi.streaming'} = 1;
30 70         121 $env->{'psgi.nonblocking'} = 1;
31              
32 70         303 my $res = $app->($env);
33              
34 66 100       765 if(ref($res) eq 'CODE') {
35 57         71 my ( $status, $headers, $body );
36 0         0 my ( $read, $write );
37              
38 57         2082 my $cond = AnyEvent->condvar;
39              
40             $res->(sub {
41 49         11366044 my ( $ref ) = @_;
42 49         153 ( $status, $headers, $body ) = @$ref;
43              
44 49         490 $cond->send;
45              
46 49 100       3049 unless(defined $body) {
47 25         161 pipe $read, $write;
48 25         9893 $write = IO::Handle->new_from_fd($write, 'w');
49 25         2594 $write->autoflush(1);
50 25         1724 return $write;
51             }
52 57         4592 });
53              
54 53 100       1682 unless(defined $status) {
55 28         156 local $SIG{__DIE__} = __PACKAGE__->exception_handler($cond);
56 28         235 my $ex = $cond->recv;
57 26 100       1230 die $ex if defined $ex;
58             }
59              
60 45 100       139 if(defined $body) {
61 20         255 $res = Plack::Test::AnyEvent::Response->from_psgi([ $status, $headers, $body ]);
62 20         930 $res->{'_cond'} = AnyEvent->condvar;
63 20         197 $res->{'_cond'}->send;
64             } else {
65 25         90 push @$headers, 'Transfer-Encoding', 'chunked';
66 25         248 $res = Plack::Test::AnyEvent::Response->from_psgi([ $status, $headers, [] ]);
67 25         49 my $h;
68             $res->{'_cond'} = AnyEvent->condvar(cb => sub {
69 24         283 undef $h;
70 24         569 close $read;
71 24         558 close $write;
72 25         837 });
73 25         358 $res->on_content_received(sub {});
  0         0  
74              
75             $h = AnyEvent::Handle->new(
76             fh => $read,
77             on_read => sub {
78 77         20920875 my $buf = $h->rbuf;
79 77         627 $h->rbuf = '';
80 77         734 $res->content($res->content . $buf);
81 77         3212 $res->on_content_received->($buf);
82             },
83             on_eof => sub {
84 9         5174 $res->send;
85             },
86             on_error => sub {
87 0         0 my ( undef, undef, $msg ) = @_;
88 0         0 warn $msg;
89 0         0 $res->send;
90             },
91 25         420 );
92             }
93             } else {
94 9 50       43 unless(ref($res) eq 'Plack::Test::AnyEvent::Response') {
95 9         79 $res = Plack::Test::AnyEvent::Response->from_psgi($res);
96             }
97 9         383 my $cond = AnyEvent->condvar;
98 9         60 $res->{'_cond'} = $cond;
99 9         54 $res->on_content_received(sub {});
  8         11  
100              
101             # make sure that the on_content_received callback is invoked inside
102             # of the event loop
103 9         13 my $faux_timer;
104             $faux_timer = AnyEvent->timer(
105             after => 0.001,
106             cb => sub {
107 9         8614 undef $faux_timer;
108 9         59 $res->on_content_received->($res->content);
109 9         607 $cond->send;
110             },
111 9         88 );
112 9         214 $res->request($req);
113             }
114              
115 54         4530 return $res;
116 65         462 };
117              
118 65         221 $client->($cb);
119             }
120              
121             sub exception_handler {
122 58     58 1 115 my ( $class, $cond ) = @_;
123              
124             return sub {
125 33     33   7965006 my $i = 0;
126              
127 33         54 my @last_eval_frame;
128              
129 33         202 while(my @info = caller($i)) {
130 171         11678 my ( $subroutine, $evaltext ) = @info[3, 6];
131              
132 171 100 66     563 if($subroutine eq '(eval)' && !defined($evaltext)) {
133 33         102 @last_eval_frame = caller($i + 1);
134 33         2021 last;
135             }
136             } continue {
137 138         455 $i++;
138             }
139              
140 33 50       174 if(@last_eval_frame) {
141 33         69 my ( $subroutine ) = $last_eval_frame[3];
142              
143 33 100       1530 if($subroutine =~ /^AnyEvent::Impl|AnyEvent::CondVar::Base/) {
144 9         93 $cond->send($_[0]);
145             }
146             }
147 58         567 };
148             }
149              
150             1;
151              
152             =pod
153              
154             =encoding UTF-8
155              
156             =head1 NAME
157              
158             Plack::Test::AnyEvent - Run Plack::Test on AnyEvent-based PSGI applications
159              
160             =head1 VERSION
161              
162             version 0.06
163              
164             =head1 SYNOPSIS
165              
166             use HTTP::Request::Common;
167             use Plack::Test;
168              
169             $Plack::Test::Impl = 'AnyEvent'; # or 'AE' for short
170              
171             test_psgi $app, sub {
172             my ( $cb ) = @_;
173              
174             my $res = $cb->(GET '/streaming-response');
175             is $res->header('Transfer-Encoding'), 'chunked';
176             $res->on_content_received(sub {
177             my ( $content ) = @_;
178              
179             # test chunk of streaming response
180             });
181             $res->recv;
182             }
183              
184             =head1 DESCRIPTION
185              
186             This L implementation allows you to easily test your
187             L-based PSGI applications. Normally, L
188             or L work fine for this, but this implementation comes
189             in handy when you'd like to test your streaming results as they come in, or
190             if your application uses long-polling. For non-streaming requests, you can
191             use this module exactly like Plack::Test::MockHTTP; otherwise, you can set
192             up a content handler and call C<$res-Erecv>. The event loop will then
193             run until the PSGI application closes its writer handle or until your test
194             client calls C on the response.
195              
196             =head1 FUNCTIONS
197              
198             =head2 test_psgi
199              
200             This function behaves almost identically to L; the
201             main difference is that the returned response object supports a few additional
202             methods on top of those normally found in an L object:
203              
204             =head3 $res->recv
205              
206             Calls C on an internal AnyEvent condition variable. Use this after you
207             get the response object to run the event loop.
208              
209             =head3 $res->send
210              
211             Calls C on an internal AnyEvent condition variable. Use this to stop
212             the event loop when you're done testing.
213              
214             =head3 $res->on_content_received($cb)
215              
216             Sets a callback to be called when a chunk is received from the application.
217             A single argument is passed to the callback; namely, the chunk itself.
218              
219             =head1 EXCEPTION HANDLING
220              
221             As of version 0.02, this module handles uncaught exceptions thrown by your code.
222             If the exception occurs before your PSGI application returns a response, or
223             directly in the response subroutine ref (if you return a subroutine as your
224             application's response), C<$cb> will propagate the exception. Otherwise,
225             the exception is propagated by C<$res-Erecv>. Here's an example:
226              
227             my $app = sub {
228             die 'thrown by $cb';
229              
230             return sub {
231             my ( $respond ) = @_;
232              
233             die 'still thrown by $cb';
234            
235             if($streaming) {
236             my $writer = $respond->([
237             200,
238             ['Content-Type' => 'text/plain'],
239             ]);
240              
241             die 'still thrown by $cb';
242              
243             my $timer;
244             $timer = AnyEvent->timer(
245             after => 2,
246             cb => sub {
247             die 'thrown by $res->recv';
248             $writer->write("Ok");
249             $writer->close;
250             undef $timer;
251             },
252             );
253             } else {
254             $respond->([
255             200,
256             ['Content-Type' => 'text/plain'],
257             ['Ok'],
258             ]);
259              
260             die 'still thrown by $cb';
261             }
262             };
263             };
264              
265             test_psgi $app, sub {
266             my ( $cb ) = @_;
267              
268             my $res = $cb->(GET '/');
269              
270             $res->on_content_received(sub {
271             ...
272             });
273              
274             $res->recv;
275             };
276              
277             Note: The exception handling code may or may not work with your event loop.
278             Please run the tests in this distribution with
279             L set to see if it works with your event loop
280             of choice. Patches will be accepted to accommodate loops, as long as it
281             doesn't break known good ones. The known good event loops are:
282              
283             =over
284              
285             =item Default
286              
287             =item Cocoa
288              
289             =item EV
290              
291             =item Event
292              
293             =item Glib
294              
295             =item Perl
296              
297             =back
298              
299             This list isn't exclusive; ie. just because your event loop isn't on this list
300             doesn't mean it doesn't work. Also, even if your event loop doesn't pass
301             the exception tests, the general usage of this module (testing requests,
302             handling streaming results and long polling) should work on any AnyEvent loop.
303             Just don't throw any uncaught exceptions =).
304              
305             =head1 SEE ALSO
306              
307             L, L, L
308              
309             =begin comment
310              
311             =over
312              
313             =item exception_handler
314              
315             =back
316              
317             =end comment
318              
319             =head1 AUTHOR
320              
321             Rob Hoelz
322              
323             =head1 COPYRIGHT AND LICENSE
324              
325             This software is copyright (c) 2015 by Rob Hoelz.
326              
327             This is free software; you can redistribute it and/or modify it under
328             the same terms as the Perl 5 programming language system itself.
329              
330             =head1 BUGS
331              
332             Please report any bugs or feature requests on the bugtracker website
333             https://github.com/hoelzro/plack-test-anyevent/issues
334              
335             When submitting a bug or request, please include a test-file or a
336             patch to an existing test-file that illustrates the bug or desired
337             feature.
338              
339             =cut
340              
341             __END__