| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Plack::Middleware::SlapbirdAPM; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
94276
|
use strict; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
32
|
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
49
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
407
|
use parent qw( Plack::Middleware ); |
|
|
1
|
|
|
|
|
282
|
|
|
|
1
|
|
|
|
|
5
|
|
|
7
|
1
|
|
|
1
|
|
14977
|
use Time::HiRes; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
11
|
|
|
8
|
1
|
|
|
1
|
|
538
|
use Try::Tiny; |
|
|
1
|
|
|
|
|
2044
|
|
|
|
1
|
|
|
|
|
96
|
|
|
9
|
1
|
|
|
1
|
|
567
|
use Plack::Request; |
|
|
1
|
|
|
|
|
93866
|
|
|
|
1
|
|
|
|
|
32
|
|
|
10
|
1
|
|
|
1
|
|
454
|
use Plack::Response; |
|
|
1
|
|
|
|
|
1262
|
|
|
|
1
|
|
|
|
|
27
|
|
|
11
|
1
|
|
|
1
|
|
518
|
use Const::Fast; |
|
|
1
|
|
|
|
|
2370
|
|
|
|
1
|
|
|
|
|
18
|
|
|
12
|
1
|
|
|
1
|
|
93
|
use JSON::MaybeXS; |
|
|
1
|
|
|
|
|
4
|
|
|
|
1
|
|
|
|
|
69
|
|
|
13
|
1
|
|
|
1
|
|
805
|
use LWP::UserAgent; |
|
|
1
|
|
|
|
|
46385
|
|
|
|
1
|
|
|
|
|
33
|
|
|
14
|
1
|
|
|
1
|
|
6
|
use Carp (); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
13
|
|
|
15
|
1
|
|
|
1
|
|
653
|
use System::Info; |
|
|
1
|
|
|
|
|
25014
|
|
|
|
1
|
|
|
|
|
60
|
|
|
16
|
1
|
|
|
1
|
|
6
|
use Time::HiRes qw(time); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
10
|
|
|
17
|
1
|
|
|
1
|
|
734
|
use SlapbirdAPM::Plack::DBIx::Tracer; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
29
|
|
|
18
|
1
|
|
|
1
|
|
5
|
use POSIX (); |
|
|
1
|
|
|
|
|
9
|
|
|
|
1
|
|
|
|
|
14
|
|
|
19
|
1
|
|
|
1
|
|
465
|
use namespace::clean; |
|
|
1
|
|
|
|
|
11608
|
|
|
|
1
|
|
|
|
|
6
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$Carp::Internal{__PACKAGE__} = 1; |
|
22
|
|
|
|
|
|
|
|
|
23
|
1
|
|
|
1
|
|
236
|
use Plack::Util::Accessor qw(key quiet ignored_headers); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
9
|
|
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
const my $SLAPBIRD_APM_URI => $ENV{SLAPBIRD_APM_DEV} |
|
26
|
|
|
|
|
|
|
? $ENV{SLAPBIRD_APM_URI} . '/apm' |
|
27
|
|
|
|
|
|
|
: 'https://slapbirdapm.com/apm'; |
|
28
|
|
|
|
|
|
|
const my $OS => System::Info->new->os; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub _unfold_headers { |
|
31
|
0
|
|
|
0
|
|
|
my ( $self, $headers ) = @_; |
|
32
|
0
|
|
|
|
|
|
my %headers = (@$headers); |
|
33
|
0
|
0
|
0
|
|
|
|
if ( $self->ignored_headers && ref( $self->ignored_headers ) eq 'ARRAY' ) { |
|
34
|
0
|
|
|
|
|
|
delete $headers{$_} for ( @{ $self->ignored_headers } ); |
|
|
0
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
} |
|
36
|
0
|
|
|
|
|
|
return \%headers; |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub _call_home { |
|
40
|
0
|
|
|
0
|
|
|
my ( $self, $request, $response, $env, $start_time, $end_time, $queries, |
|
41
|
|
|
|
|
|
|
$error ) |
|
42
|
|
|
|
|
|
|
= @_; |
|
43
|
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
my $pid = fork(); |
|
45
|
|
|
|
|
|
|
|
|
46
|
0
|
0
|
|
|
|
|
return if $pid; |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
try { |
|
49
|
|
|
|
|
|
|
|
|
50
|
0
|
|
|
0
|
|
|
my %response; |
|
51
|
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
$response{type} = 'plack'; |
|
53
|
0
|
|
|
|
|
|
$response{method} = $request->method; |
|
54
|
0
|
|
|
|
|
|
$response{end_point} = $request->uri->path; |
|
55
|
0
|
|
|
|
|
|
$response{start_time} = $start_time; |
|
56
|
0
|
|
|
|
|
|
$response{end_time} = $end_time; |
|
57
|
0
|
|
|
|
|
|
$response{response_code} = $response->status; |
|
58
|
|
|
|
|
|
|
$response{response_headers} = |
|
59
|
0
|
|
|
|
|
|
$self->_unfold_headers( |
|
60
|
|
|
|
|
|
|
$response->headers->psgi_flatten_without_sort() ); |
|
61
|
0
|
|
|
|
|
|
$response{response_size} = $response->content_length; |
|
62
|
0
|
|
|
|
|
|
$response{request_id} = undef; |
|
63
|
0
|
|
|
|
|
|
$response{request_size} = $request->content_length; |
|
64
|
|
|
|
|
|
|
$response{request_headers} = |
|
65
|
0
|
|
|
|
|
|
$self->_unfold_headers( |
|
66
|
|
|
|
|
|
|
$request->headers->psgi_flatten_without_sort() ); |
|
67
|
0
|
|
|
|
|
|
$response{error} = $error; |
|
68
|
0
|
|
|
|
|
|
$response{os} = $OS; |
|
69
|
0
|
|
|
|
|
|
$response{requestor} = $request->header('x-slapbird-name'); |
|
70
|
0
|
|
|
|
|
|
$response{num_queries} = scalar @$queries; |
|
71
|
0
|
|
|
|
|
|
$response{queries} = $queries; |
|
72
|
0
|
|
|
|
|
|
$response{handler} = undef; |
|
73
|
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
|
75
|
0
|
|
|
|
|
|
my $slapbird_response; |
|
76
|
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$slapbird_response = $ua->post( |
|
78
|
|
|
|
|
|
|
$SLAPBIRD_APM_URI, |
|
79
|
|
|
|
|
|
|
'Content-Type' => 'application/json', |
|
80
|
|
|
|
|
|
|
'x-slapbird-apm' => $self->key, |
|
81
|
|
|
|
|
|
|
Content => encode_json( \%response ) |
|
82
|
|
|
|
|
|
|
); |
|
83
|
|
|
|
|
|
|
|
|
84
|
0
|
0
|
|
|
|
|
if ( !$slapbird_response->is_success ) { |
|
85
|
0
|
0
|
|
|
|
|
if ( $slapbird_response->code eq 429 ) { |
|
86
|
0
|
0
|
|
|
|
|
Carp::carp( |
|
87
|
|
|
|
|
|
|
"You've hit your maximum number of requests for today. Please visit slapbirdapm.com to upgrade your plan." |
|
88
|
|
|
|
|
|
|
) unless $self->quiet; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
Carp::carp( |
|
91
|
0
|
|
|
|
|
|
'Unable to communicate with Slapbird, this request has not been tracked got status code ' |
|
92
|
|
|
|
|
|
|
. $slapbird_response->code ); |
|
93
|
|
|
|
|
|
|
} |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
catch { |
|
97
|
0
|
|
|
0
|
|
|
Carp::carp( |
|
98
|
|
|
|
|
|
|
'Unable to communicate with Slapbird, this request has not been tracked got error: ' |
|
99
|
|
|
|
|
|
|
. $_ ); |
|
100
|
0
|
|
|
|
|
|
POSIX::_exit(0); |
|
101
|
0
|
|
|
|
|
|
}; |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# We have to use POSIX::_exit(0) instead of exit(0) to not destroy database handles. |
|
104
|
0
|
|
|
|
|
|
return POSIX::_exit(0); |
|
105
|
|
|
|
|
|
|
} |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub call { |
|
108
|
0
|
|
|
0
|
1
|
|
my ( $self, $env ) = @_; |
|
109
|
|
|
|
|
|
|
|
|
110
|
0
|
|
0
|
|
|
|
$self->{key} //= $ENV{SLAPBIRDAPM_API_KEY}; |
|
111
|
|
|
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
|
if ( !$self->key ) { |
|
113
|
0
|
|
|
|
|
|
Carp::carp( |
|
114
|
|
|
|
|
|
|
'SlapbirdAPM key not set, cannot communicate with SlapbirdAPM. Pass key => "MY KEY", or set the SLAPBIRDAPM_API_KEY environment variable.' |
|
115
|
|
|
|
|
|
|
); |
|
116
|
0
|
|
|
|
|
|
return $self->app->($env); |
|
117
|
|
|
|
|
|
|
} |
|
118
|
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
my $request = Plack::Request->new($env); |
|
120
|
0
|
0
|
0
|
|
|
|
return [ 200, [ 'Content-Type' => 'text/plain' ], 'OK' ] |
|
121
|
|
|
|
|
|
|
if $request->uri->path eq '/slapbird/health_check/' |
|
122
|
|
|
|
|
|
|
|| $request->uri->path eq '/slapbird/health_check'; |
|
123
|
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $start_time = time * 1_000; |
|
125
|
0
|
|
|
|
|
|
my $error; |
|
126
|
|
|
|
|
|
|
my $response; |
|
127
|
0
|
|
|
|
|
|
my $plack_response; |
|
128
|
0
|
|
|
|
|
|
my $queries = []; |
|
129
|
|
|
|
|
|
|
my $dbi_tracer = SlapbirdAPM::Plack::DBIx::Tracer->new( |
|
130
|
|
|
|
|
|
|
sub { |
|
131
|
0
|
|
|
0
|
|
|
my %args = @_; |
|
132
|
0
|
|
|
|
|
|
push @$queries, { sql => $args{sql}, total_time => $args{time} }; |
|
133
|
|
|
|
|
|
|
} |
|
134
|
0
|
|
|
|
|
|
); |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
try { |
|
137
|
0
|
|
|
0
|
|
|
$plack_response = $self->app->($env) |
|
138
|
|
|
|
|
|
|
} |
|
139
|
|
|
|
|
|
|
catch { |
|
140
|
0
|
|
|
0
|
|
|
$error = $_; |
|
141
|
0
|
|
|
|
|
|
}; |
|
142
|
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
my $end_time = time * 1_000; |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
try { |
|
146
|
0
|
0
|
0
|
0
|
|
|
if ( ref($plack_response) && ref($plack_response) eq 'ARRAY' ) { |
|
147
|
0
|
|
|
|
|
|
$response = Plack::Response->new(@$plack_response); |
|
148
|
0
|
|
|
|
|
|
$self->_call_home( $request, $response, |
|
149
|
|
|
|
|
|
|
$env, $start_time, $end_time, $queries, $error ); |
|
150
|
0
|
|
|
|
|
|
return $response->finalize; |
|
151
|
|
|
|
|
|
|
} |
|
152
|
|
|
|
|
|
|
else { |
|
153
|
|
|
|
|
|
|
return $self->response_cb( |
|
154
|
|
|
|
|
|
|
$plack_response, |
|
155
|
|
|
|
|
|
|
sub { |
|
156
|
0
|
|
|
|
|
|
my $res = shift; |
|
157
|
0
|
|
|
|
|
|
$response = Plack::Response->new(@$res); |
|
158
|
0
|
|
|
|
|
|
$self->_call_home( $request, $response, |
|
159
|
|
|
|
|
|
|
$env, $start_time, $end_time, $queries, $error ); |
|
160
|
|
|
|
|
|
|
} |
|
161
|
0
|
|
|
|
|
|
); |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
0
|
0
|
|
|
|
|
if ($error) { |
|
165
|
0
|
|
|
|
|
|
Carp::croak($error); |
|
166
|
|
|
|
|
|
|
} |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
catch { |
|
169
|
0
|
|
|
0
|
|
|
Carp::croak($_); |
|
170
|
0
|
|
|
|
|
|
}; |
|
171
|
|
|
|
|
|
|
} |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
1; |