Commit | Line | Data |
5998e9ca |
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 HTTP style exceptions do NOT bubble up to the middleware |
10 | # if the backcompat setting 'always_catch_http_exceptions' is enabled. |
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 | |
5998e9ca |
80 | package MyApp; |
81 | use Catalyst; |
82 | |
83 | MyApp->config( |
84 | abort_chain_on_error_fix=>1, |
85 | always_catch_http_exceptions=>1, |
86 | ); |
87 | |
88 | sub debug { 1 } |
89 | |
90 | MyApp->setup_log('fatal'); |
91 | } |
92 | |
93 | $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry... |
94 | MyApp->setup_log('error'); |
95 | |
96 | Test::More::ok(MyApp->setup); |
97 | |
98 | ok my $psgi = MyApp->psgi_app; |
99 | test_psgi $psgi, sub { |
100 | my $cb = shift; |
101 | my $res = $cb->(GET "/root/from_psgi_app"); |
102 | is $res->code, 500; |
103 | like $res->content, qr/MyApp::Exception=HASH/; |
104 | }; |
105 | |
106 | test_psgi $psgi, sub { |
107 | my $cb = shift; |
108 | my $res = $cb->(GET "/root/from_catalyst"); |
109 | is $res->code, 500; |
110 | like $res->content, qr/MyApp::Exception=HASH/; |
111 | }; |
112 | |
113 | test_psgi $psgi, sub { |
114 | my $cb = shift; |
115 | my $res = $cb->(GET "/root/from_code_type"); |
116 | is $res->code, 500; |
117 | like $res->content, qr/MyApp::AnotherException=HASH/; |
118 | }; |
119 | |
120 | test_psgi $psgi, sub { |
121 | my $cb = shift; |
122 | my $res = $cb->(GET "/root/classic_error"); |
123 | is $res->code, 500; |
124 | like $res->content, qr'Ex Parrot', 'Ex Parrot'; |
125 | }; |
126 | |
127 | test_psgi $psgi, sub { |
128 | my $cb = shift; |
129 | my $res = $cb->(GET "/root/just_die"); |
130 | is $res->code, 500; |
131 | like $res->content, qr'not dead yet', 'not dead yet'; |
132 | }; |
133 | |
134 | # We need to specify the number of expected tests because tests that live |
135 | # in the callbacks might never get run (thus all ran tests pass but not all |
136 | # required tests run). |
137 | |
138 | done_testing(12); |