| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Devel::KYTProf::Logger::XRay; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 109452 | use 5.012000; | 
|  | 2 |  |  |  |  | 15 |  | 
| 4 | 2 |  |  | 2 |  | 12 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 39 |  | 
| 5 | 2 |  |  | 2 |  | 10 | use warnings; | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 70 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 2 |  |  | 2 |  | 516 | use AWS::XRay; | 
|  | 2 |  |  |  |  | 36834 |  | 
|  | 2 |  |  |  |  | 108 |  | 
| 8 | 2 |  |  | 2 |  | 15 | use Time::HiRes(); | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 497 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | our $VERSION = "0.04"; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | sub log { | 
| 13 | 1 |  |  | 1 | 0 | 1006122 | my ($class, %args) = @_; | 
| 14 |  |  |  |  |  |  |  | 
| 15 | 1 | 50 |  |  |  | 10 | return if !$AWS::XRay::ENABLED; | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | AWS::XRay::capture $args{module}, sub { | 
| 18 | 1 |  |  | 1 |  | 246 | my $segment = shift; | 
| 19 | 1 |  |  |  |  | 7 | my $elapsed = $args{time} / 1000; # msec -> sec | 
| 20 | 1 |  |  |  |  | 5 | my $end     = Time::HiRes::time(); | 
| 21 | 1 |  |  |  |  | 4 | my $start   = $end - $elapsed; | 
| 22 | 1 |  |  |  |  | 4 | $segment->{start_time} = $start; | 
| 23 | 1 |  |  |  |  | 5 | $segment->{end_time}   = $end; | 
| 24 |  |  |  |  |  |  |  | 
| 25 | 1 |  |  |  |  | 4 | my $data = $args{data}; | 
| 26 | 1 |  |  |  |  | 4 | $segment->{metadata} = $data; | 
| 27 | 1 | 50 |  |  |  | 10 | if (exists $data->{http_method}) { | 
|  |  | 50 |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | $segment->{http} = { | 
| 29 |  |  |  |  |  |  | request => { | 
| 30 |  |  |  |  |  |  | method => $data->{http_method}, | 
| 31 |  |  |  |  |  |  | url    => $data->{http_url}, | 
| 32 |  |  |  |  |  |  | }, | 
| 33 | 0 |  |  |  |  | 0 | }; | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  | elsif (exists $data->{sql}) { | 
| 36 |  |  |  |  |  |  | $segment->{sql} = { | 
| 37 |  |  |  |  |  |  | sanitized_query => delete $data->{sql}, | 
| 38 | 0 |  |  |  |  | 0 | }; | 
| 39 |  |  |  |  |  |  | } | 
| 40 | 1 |  |  |  |  | 23 | for my $n (qw/method package file line/) { | 
| 41 | 4 |  |  |  |  | 21 | $segment->{metadata}->{$n} = $args{$n}; | 
| 42 |  |  |  |  |  |  | } | 
| 43 |  |  |  |  |  |  | } | 
| 44 | 1 |  |  |  |  | 21 | } | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | 1; | 
| 47 |  |  |  |  |  |  | __END__ |