t/http_exceptions.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 Plack::Test;
   8
   9 # Test to make sure we let HTTP style exceptions bubble up to the middleware
  10 # rather than catching them outselves.
  11
  12 {
  13   package MyApp::Exception;
  14
  15   sub new {
  16     my ($class, $code, $headers, $body) = @_;
  17     return bless +{res => [$code, $headers, $body]}, $class;
  18   }
  19
  20   sub throw { die shift->new(@_) }
  21
  22   sub as_psgi {
  23     my ($self, $env) = @_;
  24     my ($code, $headers, $body) = @{$self->{res}};
  25
  26     return [$code, $headers, $body]; # for now
  27
  28     return sub {
  29       my $responder = shift;
  30       $responder->([$code, $headers, $body]);
  31     };
  32   }
  33
  34   package MyApp::AnotherException;
  35
  36   sub new { bless +{}, shift }
  37
  38   sub code { 400 }
  39
  40   sub as_string { 'bad stringy bad' }
  41
  42   package MyApp::Controller::Root;
  43
  44   use base 'Catalyst::Controller';
  45
  46   my $psgi_app = sub {
  47     my $env = shift;
  48     die MyApp::Exception->new(
  49       404, ['content-type'=>'text/plain'], ['Not Found']);
  50   };
  51
  52   sub from_psgi_app :Local {
  53     my ($self, $c) = @_;
  54     $c->res->from_psgi_response(
  55       $psgi_app->(
  56         $c->req->env));
  57   }
  58
  59   sub from_catalyst :Local {
  60     my ($self, $c) = @_;
  61     MyApp::Exception->throw(
  62       403, ['content-type'=>'text/plain'], ['Forbidden']);
  63   }
  64
  65   sub from_code_type :Local {
  66     my $e = MyApp::AnotherException->new;
  67     die $e;
  68   }
  69
  70   sub classic_error :Local {
  71     my ($self, $c) = @_;
  72     Catalyst::Exception->throw("Ex Parrot");
  73   }
  74
  75   sub just_die :Local {
  76     my ($self, $c) = @_;
  77     die "I'm not dead yet";
  78   }
  79
  80   sub end :Private { die "We should never hit end for HTTPExceptions" }
  81
  82   package MyApp;
  83   use Catalyst;
  84
  85   MyApp->config(abort_chain_on_error_fix=>1);
  86
  87   sub debug { 1 }
  88
  89   MyApp->setup_log('fatal');
  90 }
  91
  92 $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry...
  93 MyApp->setup_log('error');
  94
  95 Test::More::ok(MyApp->setup);
  96
  97 ok my $psgi = MyApp->psgi_app;
  98
  99 test_psgi $psgi, sub {
 100     my $cb = shift;
 101     my $res = $cb->(GET "/root/from_psgi_app");
 102     is $res->code, 404;
 103     is $res->content, 'Not Found', 'NOT FOUND';
 104     unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions';
 105 };
 106
 107 test_psgi $psgi, sub {
 108     my $cb = shift;
 109     my $res = $cb->(GET "/root/from_catalyst");
 110     is $res->code, 403;
 111     is $res->content, 'Forbidden', 'Forbidden';
 112     unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions';
 113 };
 114
 115 test_psgi $psgi, sub {
 116     my $cb = shift;
 117     my $res = $cb->(GET "/root/from_code_type");
 118     is $res->code, 400;
 119     is $res->content, 'bad stringy bad', 'bad stringy bad';
 120     unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions';
 121 };
 122
 123 test_psgi $psgi, sub {
 124     my $cb = shift;
 125     my $res = $cb->(GET "/root/classic_error");
 126     is $res->code, 500;
 127     like $res->content, qr'Ex Parrot', 'Ex Parrot';
 128     like $res->content, qr'HTTPExceptions', 'HTTPExceptions';
 129 };
 130
 131 test_psgi $psgi, sub {
 132     my $cb = shift;
 133     my $res = $cb->(GET "/root/just_die");
 134     is $res->code, 500;
 135     like $res->content, qr'not dead yet', 'not dead yet';
 136     like $res->content, qr'HTTPExceptions', 'HTTPExceptions';
 137 };
 138
 139
 140
 141 # We need to specify the number of expected tests because tests that live
 142 # in the callbacks might never get run (thus all ran tests pass but not all
 143 # required tests run).
 144
 145 done_testing(17);
 146