File Coverage

blib/lib/Plack/Middleware/XRay.pm
Criterion Covered Total %
statement 51 55 92.7
branch 19 24 79.1
condition 2 2 100.0
subroutine 10 10 100.0
pod 1 2 50.0
total 83 93 89.2


line stmt bran cond sub pod time code
1             package Plack::Middleware::XRay;
2              
3 5     5   400701 use 5.012000;
  5         49  
4 5     5   27 use strict;
  5         11  
  5         102  
5 5     5   352 use warnings;
  5         10  
  5         133  
6 5     5   464 use parent "Plack::Middleware";
  5         339  
  5         26  
7              
8 5     5   14890 use AWS::XRay qw/ capture_from /;
  5         144523  
  5         282  
9 5     5   38 use Time::HiRes ();
  5         12  
  5         2726  
10              
11             our $VERSION = "0.07";
12             our $TRACE_HEADER_NAME = "X-Amzn-Trace-ID";
13             (my $trace_header_key = uc("HTTP_${TRACE_HEADER_NAME}")) =~ s/-/_/g;
14              
15             sub call {
16 1016     1016 1 1640696 my ($self, $env) = @_;
17              
18 1016         1908 local $AWS::XRay::SAMPLER = $AWS::XRay::SAMPLER;
19 1016 100       3149 if (ref $self->{sampler} eq "CODE") {
20 9     9   33 $AWS::XRay::SAMPLER = sub { $self->{sampler}->($env) };
  9         102  
21             }
22             else {
23 1007   100     5311 AWS::XRay->sampling_rate($self->{sampling_rate} // 1);
24             }
25              
26 1016 100       8278 if ($self->{response_filter}) {
27 4         12 AWS::XRay->auto_flush(0);
28             }
29              
30 1016 50       2463 if (ref $self->{plugins} eq "ARRAY") {
31 0         0 AWS::XRay->plugins(@{ $self->{plugins} });
  0         0  
32             }
33              
34 1016         3338 my $t0 = [ Time::HiRes::gettimeofday ];
35             my $res = capture_from $env->{$trace_header_key}, $self->{name}, sub {
36 1016     1016   68663 my $segment = shift;
37              
38             # fill annotations and metadata
39 1016         2113 for my $key (qw/ annotations metadata /) {
40 2032         4960 my $code = $self->{"${key}_builder"};
41 2032 100       5121 next unless ref $code eq "CODE";
42             $segment->{$key} = {
43 6 50       22 %{$self->{$key} || {}},
44 6         11 %{$code->($env)},
  6         15  
45             }
46             }
47              
48             # HTTP request info
49             $segment->{http} = {
50             request => {
51             method => $env->{REQUEST_METHOD},
52             url => url($env),
53             client_ip => $env->{REMOTE_ADDR},
54             user_agent => $env->{HTTP_USER_AGENT},
55             },
56 1016         2483 };
57              
58             # Run app
59 1016         2017 my $res = eval {
60 1016         2843 $self->app->($env);
61             };
62 1016         3057526 my $error = $@;
63 1016 50       2241 if ($error) {
64 0         0 warn $error;
65 0         0 $res = [
66             500,
67             ["Content-Type", "text/plain"],
68             ["Internal Server Error"],
69             ];
70             }
71              
72             # HTTP response info
73 1016         2882 $segment->{http}->{response}->{status} = $res->[0];
74 1016 50       3220 my $status_key =
    50          
    100          
75             $res->[0] >= 500 ? "fault"
76             : $res->[0] == 429 ? "throttle"
77             : $res->[0] >= 400 ? "error"
78             : undef;
79 1016 100       2014 $segment->{$status_key} = Types::Serialiser::true if $status_key;
80              
81 1016         4412 return $res;
82 1016         6815 };
83              
84 1016 100       22448 if (my $func = $self->{response_filter}) {
85 4         21 my $elapsed = Time::HiRes::tv_interval($t0);
86 4 100       82 $func->($env, $res, $elapsed) && AWS::XRay->sock->flush();
87 4         160 AWS::XRay->sock->close();
88             }
89 1016         5823 return $res;
90             }
91              
92             sub url {
93 1016     1016 0 1611 my $env = shift;
94             return sprintf(
95             "%s://%s%s",
96             $env->{"psgi.url_scheme"},
97             $env->{HTTP_HOST},
98             $env->{REQUEST_URI},
99 1016         7468 );
100             }
101              
102             1;
103             __END__