File Coverage

blib/lib/Plack/Middleware/PrettyException.pm
Criterion Covered Total %
statement 98 104 94.2
branch 30 36 83.3
condition 22 28 78.5
subroutine 14 14 100.0
pod 1 2 50.0
total 165 184 89.6


line stmt bran cond sub pod time code
1             package Plack::Middleware::PrettyException;
2              
3             # ABSTRACT: Capture exceptions and present them as HTML or JSON
4              
5             our $VERSION = '1.008';
6              
7 1     1   720 use 5.010;
  1         4  
8 1     1   5 use strict;
  1         2  
  1         19  
9 1     1   5 use warnings;
  1         3  
  1         26  
10 1     1   6 use parent qw(Plack::Middleware);
  1         2  
  1         5  
11 1     1   79 use Plack::Util;
  1         2  
  1         33  
12 1     1   7 use Plack::Util::Accessor qw(force_json);
  1         2  
  1         6  
13 1     1   45 use HTTP::Headers;
  1         2  
  1         33  
14 1     1   7 use JSON::MaybeXS qw(encode_json);
  1         1  
  1         70  
15 1     1   471 use HTTP::Status qw(is_error);
  1         4589  
  1         110  
16 1     1   8 use Scalar::Util 'blessed';
  1         2  
  1         75  
17 1     1   454 use Log::Any qw($log);
  1         8227  
  1         5  
18              
19             sub call {
20 16     16 1 94540 my $self = shift;
21 16         28 my $env = shift;
22              
23 16         40 my $r;
24             my $error;
25 16         0 my $exception;
26 16         24 my $died = 0;
27             eval {
28 16         60 $r = $self->app->($env);
29 7         215 1;
30 16 100       28 } or do {
31 9         145155 my $e = $@;
32 9         18 $died = 1;
33 9 100       38 if ( blessed($e) ) {
34 7         17 $exception = $e;
35 7 50       67 if ( $e->can('message') ) {
36 7         23 $error = $e->message;
37             }
38             else {
39 0         0 $error = '' . $e;
40             }
41 7 50       93 $r->[0] =
    100          
42             $e->can('status_code') ? $e->status_code
43             : $e->can('http_status') ? $e->http_status
44             : 500;
45 7   100     38 $r->[0] ||= 500;
46              
47 7 100 66     35 if ( $r->[0] =~ /^3/ && $e->can('location') ) {
48 1         5 push( @{ $r->[1] }, Location => $e->location );
  1         9  
49 1 50       7 push( @{ $r->[2] }, $e->location ) unless $r->[2];
  1         4  
50             }
51              
52             }
53             else {
54 2         5 $r->[0] = 500;
55 2         4 $error = $e;
56             }
57             };
58              
59             return Plack::Util::response_cb(
60             $r,
61             sub {
62 16     16   237 my $r = shift;
63              
64 16 100 100     54 if ( !$died && !is_error( $r->[0] ) ) {
65              
66             # all is ok!
67 2         19 return;
68             }
69 14 100       82 if ( $r->[0] =~ /^3/ ) {
70              
71             # it's a redirect
72 1         3 return;
73             }
74              
75             # there was an error!
76              
77 13 100       30 unless ($error) {
78 6   100     23 my $body = $r->[2] || 'error not found in body';
79 6 100       26 $error = ref($body) eq 'ARRAY' ? join( '', @$body ) : $body;
80             }
81              
82             my $location = join( '',
83 13         60 map { $env->{$_} } qw(HTTP_HOST SCRIPT_NAME PATH_INFO) );
  39         108  
84 13         80 $log->error( $location . ': ' . $error );
85              
86 13         57 my $orig_headers = HTTP::Headers->new( @{ $r->[1] } );
  13         81  
87 13         369 my $err_headers = Plack::Util::headers( [] );
88 13         302 my $err_body;
89              
90             # it already is JSON, so return that
91 13 100       42 if ( $orig_headers->content_type =~ m{application/json}i ) {
92 2         59 return;
93             }
94              
95             # force json, or client requested JSON, so render errors as JSON
96 11 100 66     176 if ($self->force_json
      100        
97             || ( exists $env->{HTTP_ACCEPT}
98             && $env->{HTTP_ACCEPT} =~ m{application/json}i )
99             ) {
100 4         59 $err_headers->set( 'content-type' => 'application/json' );
101 4         86 my $err_payload = { status => 'error', message => "" . $error };
102 4 50 66     29 if ($exception && $exception->can('does')) {
103 0 0       0 if ($exception->does('Throwable::X')) {
104 0         0 my $payload = $exception->payload;
105 0         0 while (my ($k, $v) = each %$payload) {
106 0         0 $err_payload->{$k} = $v;
107             }
108 0         0 $err_payload->{ident} = $exception->ident;
109             }
110             }
111              
112 4         50 $err_body = encode_json( $err_payload );
113             }
114              
115             # return HTML as default
116             else {
117 7         108 $err_headers->set(
118             'content-type' => 'text/html;charset=utf-8' );
119 7         167 $err_body = $self->render_html_error( $r->[0], $error, $exception, $env );
120             }
121 11         51 $r->[1] = $err_headers->headers;
122 11         169 $r->[2] = [$err_body];
123 11         107 return;
124             }
125 16         143 );
126             }
127              
128             sub render_html_error {
129 7     7 0 22 my ( $self, $status, $error, $exception, $env ) = @_;
130              
131 7   50     16 $status ||= 'unknown HTTP status code';
132 7   50     15 $error ||= 'unknown error';
133              
134 7         14 my $more='';
135 7 100 100     43 if ($exception && $exception->can('does')) {
136 2         42 my @more;
137 2 100       7 if ($exception->does('Throwable::X')) {
138 1         10 push(@more, "
  • ".$exception->ident."
  • ");
    139 1         8 push(@more, "
  • ".$exception->message."
  • ");
    140 1         71 my $payload = $exception->payload;
    141 1         11 while (my ($k, $v) = each %$payload) {
    142 1   50     9 push(@more,sprintf("
  • %s: %s
  • ", $k, $v // ''));
    143             }
    144             }
    145 2 100       65 if (@more) {
    146 1         7 $more='
      '.join("\n",@more).'
    ';
    147             }
    148             }
    149              
    150 7         43 return <<"UGLYERROR";
    151            
    152             Error $status
    153            
    154            

    Error $status

    155            

    $error

    156             $more
    157            
    158            
    159             UGLYERROR
    160             }
    161              
    162             1;
    163              
    164             __END__