t/body_fh.t

   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);