File Coverage

blib/lib/Plack/Middleware/StackTrace/RethrowFriendly.pm
Criterion Covered Total %
statement 69 69 100.0
branch 17 18 94.4
condition 9 12 75.0
subroutine 18 18 100.0
pod 1 5 20.0
total 114 122 93.4


line stmt bran cond sub pod time code
1             package Plack::Middleware::StackTrace::RethrowFriendly;
2 8     8   18345 use strict;
  8         14  
  8         236  
3 8     8   28 use warnings;
  8         8  
  8         183  
4              
5             # core
6 8     8   36 use Scalar::Util 'refaddr';
  8         8  
  8         710  
7 8     8   3728 use MIME::Base64 qw(encode_base64);
  8         4695  
  8         517  
8              
9             # cpan
10 8     8   3398 use parent qw(Plack::Middleware::StackTrace);
  8         2068  
  8         37  
11 8     8   217728 use Try::Tiny;
  8         16  
  8         6180  
12              
13             our $VERSION = "0.03";
14              
15             sub call {
16 8     8 1 79716 my($self, $env) = @_;
17              
18 8         16 my ($last_key, %seen);
19             local $SIG{__DIE__} = sub {
20 12     12   877 my $key = _make_key($_[0]);
21 12   100     60 my $list = $seen{$key} || [];
22              
23             # If we get the same keys, the exception may be rethrown and
24             # we keep the original stacktrace.
25 12         51 push @$list, $Plack::Middleware::StackTrace::StackTraceClass->new(
26             indent => 1,
27             message => munge_error($_[0], [ caller ]),
28             ignore_package => __PACKAGE__,
29             no_refs => 1,
30             );
31 12         5099 $seen{$key} = $list;
32 12         16 $last_key = $key;
33              
34 12         64 die @_;
35 8         61 };
36              
37 8         10 my $caught;
38             my $res = try {
39 8     8   215 $self->app->($env);
40             } catch {
41 5     5   62 $caught = $_;
42 5         16 _error('text/plain', $caught, 'no_trace');
43 8         45 };
44              
45 8 100       118 my $trace = $self->force ? $seen{$last_key} : $seen{_make_key($caught)};
46 8   100     34 $trace ||= [];
47 8 100 66     48 if (scalar @$trace && $self->should_show_trace($caught, $res)) {
48 6         55 my $text = $trace->[0]->as_string;
49 6 100       6108 my $html = @$trace > 1
50             ? _multi_trace_html(@$trace) : $trace->[0]->as_html;
51 6         22343 $env->{'plack.stacktrace.text'} = $text;
52 6         15 $env->{'plack.stacktrace.html'} = $html;
53 6 50       45 $env->{'psgi.errors'}->print($text) unless $self->no_print_errors;
54 6 100 100     86 $res = ($env->{HTTP_ACCEPT} || '*/*') =~ /html/
55             ? _error('text/html', $html)
56             : _error('text/plain', $text);
57             }
58             # break %seen here since $SIG{__DIE__} holds the ref to it, and
59             # $trace has refs to Standalone.pm's args ($conn etc.) and
60             # prevents garbage collection to be happening.
61 8         107 undef %seen;
62              
63 8         317 return $res;
64             }
65              
66             sub should_show_trace {
67 6     6 0 9 my ($self, $err, $res) = @_;
68 6 100       21 return 1 if $err;
69 1   33     3 return $self->force && ref $res eq 'ARRAY' && $res->[0] == 500;
70             }
71              
72 5     5 0 13 sub no_trace_error { Plack::Middleware::StackTrace::no_trace_error(@_) }
73 12     12 0 40 sub munge_error { Plack::Middleware::StackTrace::munge_error(@_) }
74 11     11 0 35 sub utf8_safe { Plack::Middleware::StackTrace::utf8_safe(@_) }
75              
76             sub _make_key {
77 19     19   59 my ($val) = @_;
78 19 100       50 if (!defined($val)) {
    100          
79 2         4 return 'undef';
80             } elsif (ref($val)) {
81 6         17 return 'ref:' . refaddr($val);
82             } else {
83 11         26 return "str:$val";
84             }
85             }
86              
87             sub _error {
88 11     11   19 my ($type, $content, $no_trace) = @_;
89 11         22 $content = utf8_safe($content);
90 11 100       73 $content = no_trace_error($content) if $no_trace;
91 11         103 return [ 500, [ 'Content-Type' => "$type; charset=utf-8" ], [ $content ] ];
92             }
93              
94             sub _multi_trace_html {
95 2     2   21 my (@trace) = @_;
96              
97 2         13 require Devel::StackTrace::AsHTML;
98 2         6 my $msg = Devel::StackTrace::AsHTML::encode_html(
99             $trace[0]->frame(0)->as_string(1),
100             );
101              
102 2         58 my @data_uris = map { _trace_as_data_uri($_) } @trace;
  4         8  
103 4         57 my @links = map {
104 2         7 sprintf
105             '#%s',
106             $data_uris[$_],
107             $_;
108             } (0..$#data_uris);
109              
110 2         4 my $css = << '----';
111             body {
112             height: 100%;
113             margin: 0;
114             padding: 0;
115             }
116             div#links {
117             z-index: 100;
118             position: absolute;
119             top: 0;
120             height: 30px;
121             }
122             #content {
123             z-index: 50;
124             position: absolute;
125             top: 0;
126             height: 100%;
127             width: 100%;
128             margin: 0;
129             padding: 30px 0 4px 0;
130             box-sizing: border-box;
131             }
132             iframe#trace {
133             border: none;
134             padding: 0;
135             margin: 0;
136             height: 100%;
137             width: 100%;
138             }
139             a.selected {
140             color: #000;
141             font-weight: bold;
142             text-decoration: none;
143             }
144             ----
145              
146 2         178 sprintf << '----', $msg, $css, join(' ', @links), $data_uris[0];
147            
148            
149            
150             Error: %s
151            
154            
170            
171            
172            
173             Throws: %s
174            
175            
176            
177            
178            
179            
180             ----
181             }
182              
183             sub _trace_as_data_uri ($) {
184 4     4   11 my $html = $_[0]->as_html;
185 4         32444 return 'data:text/html;charset=utf-8;base64,'.encode_base64($html);
186             }
187              
188             1;
189             __END__