line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Middleware::XRay; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
428873
|
use 5.012000; |
|
5
|
|
|
|
|
49
|
|
4
|
5
|
|
|
5
|
|
26
|
use strict; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
117
|
|
5
|
5
|
|
|
5
|
|
26
|
use warnings; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
155
|
|
6
|
5
|
|
|
5
|
|
470
|
use parent "Plack::Middleware"; |
|
5
|
|
|
|
|
329
|
|
|
5
|
|
|
|
|
28
|
|
7
|
|
|
|
|
|
|
|
8
|
5
|
|
|
5
|
|
15389
|
use AWS::XRay qw/ capture_from /; |
|
5
|
|
|
|
|
142394
|
|
|
5
|
|
|
|
|
333
|
|
9
|
5
|
|
|
5
|
|
42
|
use Time::HiRes (); |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
2769
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.06"; |
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
|
1614463
|
my ($self, $env) = @_; |
17
|
|
|
|
|
|
|
|
18
|
1016
|
|
|
|
|
1915
|
local $AWS::XRay::SAMPLER = $AWS::XRay::SAMPLER; |
19
|
1016
|
100
|
|
|
|
3287
|
if (ref $self->{sampler} eq "CODE") { |
20
|
9
|
|
|
9
|
|
35
|
$AWS::XRay::SAMPLER = sub { $self->{sampler}->($env) }; |
|
9
|
|
|
|
|
113
|
|
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
else { |
23
|
1007
|
|
100
|
|
|
5146
|
AWS::XRay->sampling_rate($self->{sampling_rate} // 1); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
1016
|
100
|
|
|
|
7629
|
if ($self->{response_filter}) { |
27
|
4
|
|
|
|
|
13
|
AWS::XRay->auto_flush(0); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
1016
|
|
|
|
|
3787
|
my $t0 = [ Time::HiRes::gettimeofday ]; |
31
|
|
|
|
|
|
|
my $res = capture_from $env->{$trace_header_key}, $self->{name}, sub { |
32
|
1016
|
|
|
1016
|
|
70289
|
my $segment = shift; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# fill annotations and metadata |
35
|
1016
|
|
|
|
|
2045
|
for my $key (qw/ annotations metadata /) { |
36
|
2032
|
|
|
|
|
4738
|
my $code = $self->{"${key}_builder"}; |
37
|
2032
|
100
|
|
|
|
5145
|
next unless ref $code eq "CODE"; |
38
|
|
|
|
|
|
|
$segment->{$key} = { |
39
|
6
|
50
|
|
|
|
22
|
%{$self->{$key} || {}}, |
40
|
6
|
|
|
|
|
20
|
%{$code->($env)}, |
|
6
|
|
|
|
|
18
|
|
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# HTTP request info |
45
|
|
|
|
|
|
|
$segment->{http} = { |
46
|
|
|
|
|
|
|
request => { |
47
|
|
|
|
|
|
|
method => $env->{REQUEST_METHOD}, |
48
|
|
|
|
|
|
|
url => url($env), |
49
|
|
|
|
|
|
|
client_ip => $env->{REMOTE_ADDR}, |
50
|
|
|
|
|
|
|
user_agent => $env->{HTTP_USER_AGENT}, |
51
|
|
|
|
|
|
|
}, |
52
|
1016
|
|
|
|
|
2439
|
}; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Run app |
55
|
1016
|
|
|
|
|
2040
|
my $res = eval { |
56
|
1016
|
|
|
|
|
2714
|
$self->app->($env); |
57
|
|
|
|
|
|
|
}; |
58
|
1016
|
|
|
|
|
3061443
|
my $error = $@; |
59
|
1016
|
50
|
|
|
|
2204
|
if ($error) { |
60
|
0
|
|
|
|
|
0
|
warn $error; |
61
|
0
|
|
|
|
|
0
|
$res = [ |
62
|
|
|
|
|
|
|
500, |
63
|
|
|
|
|
|
|
["Content-Type", "text/plain"], |
64
|
|
|
|
|
|
|
["Internal Server Error"], |
65
|
|
|
|
|
|
|
]; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# HTTP response info |
69
|
1016
|
|
|
|
|
2659
|
$segment->{http}->{response}->{status} = $res->[0]; |
70
|
1016
|
50
|
|
|
|
3168
|
my $status_key = |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$res->[0] >= 500 ? "fault" |
72
|
|
|
|
|
|
|
: $res->[0] == 429 ? "throttle" |
73
|
|
|
|
|
|
|
: $res->[0] >= 400 ? "error" |
74
|
|
|
|
|
|
|
: undef; |
75
|
1016
|
100
|
|
|
|
1867
|
$segment->{$status_key} = Types::Serialiser::true if $status_key; |
76
|
|
|
|
|
|
|
|
77
|
1016
|
|
|
|
|
4168
|
return $res; |
78
|
1016
|
|
|
|
|
6842
|
}; |
79
|
|
|
|
|
|
|
|
80
|
1016
|
100
|
|
|
|
24934
|
if (my $func = $self->{response_filter}) { |
81
|
4
|
|
|
|
|
25
|
my $elapsed = Time::HiRes::tv_interval($t0); |
82
|
4
|
100
|
|
|
|
96
|
$func->($env, $res, $elapsed) && AWS::XRay->sock->flush(); |
83
|
4
|
|
|
|
|
187
|
AWS::XRay->sock->close(); |
84
|
|
|
|
|
|
|
} |
85
|
1016
|
|
|
|
|
5399
|
return $res; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub url { |
89
|
1016
|
|
|
1016
|
0
|
1477
|
my $env = shift; |
90
|
|
|
|
|
|
|
return sprintf( |
91
|
|
|
|
|
|
|
"%s://%s%s", |
92
|
|
|
|
|
|
|
$env->{"psgi.url_scheme"}, |
93
|
|
|
|
|
|
|
$env->{HTTP_HOST}, |
94
|
|
|
|
|
|
|
$env->{REQUEST_URI}, |
95
|
1016
|
|
|
|
|
7604
|
); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
1; |
99
|
|
|
|
|
|
|
__END__ |