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::Controller::Root;
  35
  36   use base 'Catalyst::Controller';
  37
  38   my $psgi_app = sub {
  39     my $env = shift;
  40     die MyApp::Exception->new(
  41       404, ['content-type'=>'text/plain'], ['Not Found']);
  42   };
  43
  44   sub from_psgi_app :Local {
  45     my ($self, $c) = @_;
  46     $c->res->from_psgi_response(
  47       $psgi_app->(
  48         $c->req->env));
  49   }
  50
  51   sub from_catalyst :Local {
  52     my ($self, $c) = @_;
  53     MyApp::Exception->throw(
  54       403, ['content-type'=>'text/plain'], ['Forbidden']);
  55   }
  56
  57   sub classic_error :Local {
  58     my ($self, $c) = @_;
  59     Catalyst::Exception->throw("Ex Parrot");
  60   }
  61
  62   sub just_die :Local {
  63     my ($self, $c) = @_;
  64     die "I'm not dead yet";
  65   }
  66
  67   package MyApp;
  68   use Catalyst;
  69
  70   sub debug { 1 }
  71
  72   MyApp->setup_log('fatal');
  73 }
  74
  75 $INC{'MyApp/Controller/Root.pm'} = '1'; # sorry...
  76 MyApp->setup_log('error');
  77
  78 Test::More::ok(MyApp->setup);
  79
  80 ok my $psgi = MyApp->psgi_app;
  81
  82 test_psgi $psgi, sub {
  83     my $cb = shift;
  84     my $res = $cb->(GET "/root/from_psgi_app");
  85     is $res->code, 404;
  86     is $res->content, 'Not Found', 'NOT FOUND';
  87 };
  88
  89 test_psgi $psgi, sub {
  90     my $cb = shift;
  91     my $res = $cb->(GET "/root/from_catalyst");
  92     is $res->code, 403;
  93     is $res->content, 'Forbidden', 'Forbidden';
  94 };
  95
  96 test_psgi $psgi, sub {
  97     my $cb = shift;
  98     my $res = $cb->(GET "/root/classic_error");
  99     is $res->code, 500;
 100     like $res->content, qr'Ex Parrot', 'Ex Parrot';
 101 };
 102
 103 test_psgi $psgi, sub {
 104     my $cb = shift;
 105     my $res = $cb->(GET "/root/just_die");
 106     is $res->code, 500;
 107     like $res->content, qr'not dead yet', 'not dead yet';
 108 };
 109
 110
 111
 112 # We need to specify the number of expected tests because tests that live
 113 # in the callbacks might never get run (thus all ran tests pass but not all
 114 # required tests run).
 115
 116 done_testing(10);
 117