line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Middleware::InteractiveDebugger; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
26876
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
82
|
|
4
|
1
|
|
|
1
|
|
32
|
use 5.008_001; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
130
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
1779
|
use parent qw( Plack::Middleware ); |
|
1
|
|
|
|
|
324
|
|
|
1
|
|
|
|
|
7
|
|
8
|
1
|
|
|
1
|
|
18786
|
use Plack::Util::Accessor qw( resource ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
858
|
use File::ShareDir; |
|
1
|
|
|
|
|
7112
|
|
|
1
|
|
|
|
|
50
|
|
11
|
1
|
|
|
1
|
|
1457
|
use Data::Dump::Streamer; |
|
1
|
|
|
|
|
90266
|
|
|
1
|
|
|
|
|
7
|
|
12
|
1
|
|
|
1
|
|
4212
|
use Devel::StackTrace; |
|
1
|
|
|
|
|
3355
|
|
|
1
|
|
|
|
|
28
|
|
13
|
1
|
|
|
1
|
|
1164
|
use Devel::StackTrace::WithLexicals; |
|
1
|
|
|
|
|
3901
|
|
|
1
|
|
|
|
|
35
|
|
14
|
1
|
|
|
1
|
|
973
|
use Eval::WithLexicals; |
|
1
|
|
|
|
|
71283
|
|
|
1
|
|
|
|
|
38
|
|
15
|
1
|
|
|
1
|
|
10
|
use Scalar::Util qw(refaddr); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
64
|
|
16
|
1
|
|
|
1
|
|
972
|
use Try::Tiny; |
|
1
|
|
|
|
|
1539
|
|
|
1
|
|
|
|
|
53
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
513
|
use Plack::Middleware::InteractiveDebugger::HTML; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
66
|
|
19
|
1
|
|
|
1
|
|
893
|
use Plack::App::File; |
|
1
|
|
|
|
|
10167
|
|
|
1
|
|
|
|
|
34
|
|
20
|
1
|
|
|
1
|
|
1672
|
use Plack::Request; |
|
1
|
|
|
|
|
66137
|
|
|
1
|
|
|
|
|
1058
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $share = try { File::ShareDir::dist_dir('Plack-Middleware-InteractiveDebugger') } || "share"; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
{ |
25
|
|
|
|
|
|
|
# Hide from stacktrace's own lexicals |
26
|
|
|
|
|
|
|
my %traces; |
27
|
|
|
|
|
|
|
sub _traces { |
28
|
0
|
0
|
|
0
|
|
|
if (@_ > 1) { |
29
|
0
|
|
|
|
|
|
$traces{$_[0]} = $_[1]; |
30
|
|
|
|
|
|
|
} else { |
31
|
0
|
|
|
|
|
|
$traces{$_[0]}; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub prepare_app { |
37
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
38
|
0
|
|
|
|
|
|
$self->resource( Plack::App::File->new(root => $share)->to_app ); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub debugger_callback { |
42
|
0
|
|
|
0
|
0
|
|
my($self, $env) = @_; |
43
|
|
|
|
|
|
|
|
44
|
0
|
0
|
|
|
|
|
if ($env->{PATH_INFO} =~ s!/res/!!) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
45
|
0
|
|
|
|
|
|
return $self->resource->($env); |
46
|
|
|
|
|
|
|
} elsif ($env->{PATH_INFO} eq "/source") { |
47
|
0
|
|
|
|
|
|
my $req = Plack::Request->new($env); |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my($trace_id, $idx) = split /-/, $req->query_parameters->{frame}; |
50
|
0
|
|
|
|
|
|
my $html = render_source( _traces($trace_id)->frame($idx) ); |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
return [ 200, [ "Content-Type", "text/html; charset=utf-8" ], [ utf8_safe($html) ] ]; |
53
|
|
|
|
|
|
|
} elsif ($env->{PATH_INFO} eq "/command") { |
54
|
0
|
|
|
|
|
|
my $req = Plack::Request->new($env); |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
my($trace_id, $idx) = split /-/, $req->query_parameters->{frame}; |
57
|
0
|
|
|
|
|
|
my $code = $req->query_parameters->{code}; |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
my $trace = _traces($trace_id); |
60
|
0
|
|
|
|
|
|
my $frame = $trace->frame($idx); |
61
|
|
|
|
|
|
|
|
62
|
0
|
|
0
|
|
|
|
my $lex = $frame->{__eval} ||= do { |
63
|
0
|
|
|
|
|
|
my $e = Eval::WithLexicals->new; |
64
|
0
|
|
|
|
|
|
$e->in_package("InteractiveDebugger::Pad"); |
65
|
0
|
|
0
|
|
|
|
$e->lexicals($frame->lexicals || {}); |
66
|
0
|
|
|
|
|
|
$e; |
67
|
|
|
|
|
|
|
}; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
local *InteractiveDebugger::Pad::D = sub { |
70
|
0
|
0
|
|
0
|
|
|
if (@_) { |
71
|
0
|
|
|
|
|
|
Dump(@_); |
72
|
|
|
|
|
|
|
} else { |
73
|
0
|
|
|
|
|
|
Dump($lex->lexicals); |
74
|
|
|
|
|
|
|
} |
75
|
0
|
|
|
|
|
|
}; |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
my @ret = eval { $lex->eval($code) }; |
|
0
|
|
|
|
|
|
|
78
|
0
|
0
|
|
|
|
|
if ($@) { |
79
|
0
|
|
|
|
|
|
@ret = ($@); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
return [ 200, [ 'Content-Type', 'text/html' ], [ "perl> $code\n", map encode_html($_), @ret ] ]; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub call { |
87
|
0
|
|
|
0
|
1
|
|
my($self, $env) = @_; |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
if ($env->{'psgi.multiprocess'}) { |
90
|
0
|
|
|
|
|
|
Carp::croak(__PACKAGE__, " only runs in a single-process mode."); |
91
|
0
|
|
|
|
|
|
return $self->app->($env); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
0
|
0
|
|
|
|
|
if ($env->{PATH_INFO} =~ s!^/__debugger__!!) { |
95
|
0
|
|
|
|
|
|
return $self->debugger_callback($env); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
my $trace; |
99
|
|
|
|
|
|
|
local $SIG{__DIE__} = sub { |
100
|
0
|
|
|
0
|
|
|
$trace = Devel::StackTrace::WithLexicals->new( |
101
|
|
|
|
|
|
|
indent => 1, message => munge_error($_[0], [ caller ]), |
102
|
|
|
|
|
|
|
); |
103
|
0
|
|
|
|
|
|
die @_; |
104
|
0
|
|
|
|
|
|
}; |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
my $caught; |
107
|
|
|
|
|
|
|
my $res = try { |
108
|
0
|
|
|
0
|
|
|
$self->app->($env); |
109
|
|
|
|
|
|
|
} catch { |
110
|
0
|
|
|
0
|
|
|
$caught = $_; |
111
|
0
|
|
|
|
|
|
[ 500, [ "Content-Type", "text/plain; charset=utf-8" ], [ no_trace_error(utf8_safe($caught)) ] ]; |
112
|
0
|
|
|
|
|
|
}; |
113
|
|
|
|
|
|
|
|
114
|
0
|
0
|
0
|
|
|
|
if ($trace && ($caught || (ref $res eq 'ARRAY' && $res->[0] == 500)) ) { |
|
|
|
0
|
|
|
|
|
115
|
0
|
|
|
|
|
|
$self->filter_frames($trace); |
116
|
0
|
|
|
|
|
|
my $html = render_full($env, $trace); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
$res = [500, ['Content-Type' => 'text/html; charset=utf-8'], [ utf8_safe($html) ]]; |
119
|
0
|
|
|
|
|
|
$env->{'psgi.errors'}->print($trace->as_string); |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
_traces( refaddr($trace), $trace ); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
undef $trace; |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
return $res; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub filter_frames { |
130
|
0
|
|
|
0
|
0
|
|
my($self, $trace) = @_; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my @new_frames; |
133
|
0
|
|
|
|
|
|
my @frames = $trace->frames; |
134
|
0
|
0
|
|
|
|
|
shift @frames if $frames[0]->filename eq __FILE__; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
for my $frame (@frames) { |
137
|
0
|
|
|
|
|
|
push @new_frames, $frame; |
138
|
0
|
0
|
|
|
|
|
last if $frame->filename eq __FILE__; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
$trace->{frames} = \@new_frames; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# below is a copy from StackTrace |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub no_trace_error { |
147
|
0
|
|
|
0
|
0
|
|
my $msg = shift; |
148
|
0
|
|
|
|
|
|
chomp($msg); |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
return <
|
151
|
|
|
|
|
|
|
The application raised the following error: |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$msg |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
and the middleware couldn't catch its stack trace, possibly because your application overrides \$SIG{__DIE__} by itself, preventing the middleware from working correctly. Remove the offending code or module that does it: known examples are CGI::Carp and Carp::Always. |
156
|
|
|
|
|
|
|
EOF |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub munge_error { |
160
|
0
|
|
|
0
|
0
|
|
my($err, $caller) = @_; |
161
|
0
|
0
|
|
|
|
|
return $err if ref $err; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Ugly hack to remove " at ... line ..." automatically appended by perl |
164
|
|
|
|
|
|
|
# If there's a proper way to do this, please let me know. |
165
|
0
|
|
|
|
|
|
$err =~ s/ at \Q$caller->[1]\E line $caller->[2]\.\n$//; |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
return $err; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub utf8_safe { |
171
|
0
|
|
|
0
|
0
|
|
my $str = shift; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# NOTE: I know messing with utf8:: in the code is WRONG, but |
174
|
|
|
|
|
|
|
# because we're running someone else's code that we can't |
175
|
|
|
|
|
|
|
# guarnatee which encoding an exception is encoded, there's no |
176
|
|
|
|
|
|
|
# better way than doing this. The latest Devel::StackTrace::AsHTML |
177
|
|
|
|
|
|
|
# (0.08 or later) encodes high-bit chars as HTML entities, so this |
178
|
|
|
|
|
|
|
# path won't be executed. |
179
|
0
|
0
|
|
|
|
|
if (utf8::is_utf8($str)) { |
180
|
0
|
|
|
|
|
|
utf8::encode($str); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
$str; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
1; |
187
|
|
|
|
|
|
|
__END__ |