Commit | Line | Data |
46fff667 |
1 | use warnings; |
2 | use strict; |
3 | use Test::More; |
4 | use HTTP::Request::Common; |
5 | use HTTP::Message::PSGI; |
6 | use Plack::Util; |
7 | use Devel::Dwarn; |
8 | |
9 | { |
10 | package MyApp::Controller::Root; |
11 | |
12 | use base 'Catalyst::Controller'; |
13 | |
14 | sub flat_response :Local { |
15 | my $response = 'Hello flat_response'; |
16 | pop->res->body($response); |
17 | } |
18 | |
19 | sub memory_stream :Local { |
20 | my $response = 'Hello memory_stream'; |
21 | open my $fh, '<', \$response || die "$!"; |
22 | |
23 | pop->res->body($fh); |
24 | } |
25 | |
26 | sub manual_write_fh :Local { |
27 | my ($self, $c) = @_; |
28 | my $response = 'Hello manual_write_fh'; |
29 | my $writer = $c->res->write_fh; |
30 | $writer->write($response); |
31 | $writer->close; |
32 | } |
33 | |
34 | sub manual_write :Local { |
35 | my ($self, $c) = @_; |
36 | $c->res->write('Hello'); |
37 | $c->res->body('manual_write'); |
38 | } |
39 | |
40 | package MyApp; |
41 | use Catalyst; |
42 | |
43 | } |
44 | |
45 | $INC{'MyApp/Controller/Root.pm'} = '1'; # sorry... |
46 | |
47 | ok(MyApp->setup); |
48 | ok(my $psgi = MyApp->psgi_app); |
49 | |
50 | { |
51 | ok(my $env = req_to_psgi(GET '/root/flat_response')); |
52 | ok(my $psgi_response = $psgi->($env)); |
53 | |
54 | $psgi_response->(sub { |
55 | my $response_tuple = shift; |
56 | my ($status, $headers, $body) = @$response_tuple; |
57 | |
58 | ok $status; |
59 | ok $headers; |
60 | is $body->[0], 'Hello flat_response'; |
61 | |
62 | }); |
63 | } |
64 | |
65 | { |
66 | ok(my $env = req_to_psgi(GET '/root/memory_stream')); |
67 | ok(my $psgi_response = $psgi->($env)); |
68 | |
69 | $psgi_response->(sub { |
70 | my $response_tuple = shift; |
71 | my ($status, $headers, $body) = @$response_tuple; |
72 | |
73 | ok $status; |
74 | ok $headers; |
75 | is ref($body), 'GLOB'; |
76 | |
77 | }); |
78 | } |
79 | |
80 | { |
81 | ok(my $env = req_to_psgi(GET '/root/manual_write_fh')); |
82 | ok(my $psgi_response = $psgi->($env)); |
83 | |
84 | $psgi_response->(sub { |
85 | my $response_tuple = shift; |
86 | my ($status, $headers, $body) = @$response_tuple; |
87 | |
88 | ok $status; |
89 | ok $headers; |
90 | ok !$body; |
91 | |
92 | return Plack::Util::inline_object( |
93 | write => sub { is shift, 'Hello manual_write_fh' }, |
94 | close => sub { ok 1, 'closed' }, |
95 | ); |
96 | }); |
97 | } |
98 | |
99 | { |
100 | ok(my $env = req_to_psgi(GET '/root/manual_write')); |
101 | ok(my $psgi_response = $psgi->($env)); |
102 | |
103 | $psgi_response->(sub { |
104 | my $response_tuple = shift; |
105 | my ($status, $headers, $body) = @$response_tuple; |
106 | |
107 | ok $status; |
108 | ok $headers; |
109 | ok !$body; |
110 | |
111 | my @expected = (qw/Hello manual_write/); |
112 | return Plack::Util::inline_object( |
113 | close => sub { ok 1, 'closed'; is scalar(@expected), 0; }, |
114 | write => sub { is shift, shift(@expected) }, |
115 | ); |
116 | }); |
117 | } |
118 | |
119 | ## We need to specify the number of expected tests because tests that live |
120 | ## in the callbacks might never get run (thus all ran tests pass but not all |
121 | ## required tests run). |
122 | |
123 | done_testing(28); |