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