File Coverage

blib/lib/Plack/Middleware/SlapbirdAPM.pm
Criterion Covered Total %
statement 51 119 42.8
branch 0 18 0.0
condition 0 12 0.0
subroutine 17 27 62.9
pod 1 1 100.0
total 69 177 38.9


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;