File Coverage

blib/lib/Plack/Middleware/StatsPerRequest.pm
Criterion Covered Total %
statement 79 80 98.7
branch 21 22 95.4
condition 10 14 71.4
subroutine 14 14 100.0
pod 3 3 100.0
total 127 133 95.4


line stmt bran cond sub pod time code
1             package Plack::Middleware::StatsPerRequest;
2              
3             # ABSTRACT: Measure HTTP stats on each request
4              
5             our $VERSION = '0.901';
6              
7 3     3   56426 use strict;
  3         11  
  3         68  
8 3     3   13 use warnings;
  3         6  
  3         62  
9 3     3   46 use 5.010;
  3         10  
10 3     3   817 use Time::HiRes qw();
  3         2061  
  3         62  
11              
12 3     3   707 use parent 'Plack::Middleware';
  3         486  
  3         13  
13             use Plack::Util::Accessor
14 3     3   21332 qw( app_name metric_name path_cleanups add_headers has_headers long_request );
  3         5  
  3         13  
15 3     3   1341 use Plack::Request;
  3         147578  
  3         80  
16 3     3   743 use Log::Any qw($log);
  3         13149  
  3         14  
17 3     3   4302 use Measure::Everything 1.002 qw($stats);
  3         4168  
  3         15  
18 3     3   2111 use HTTP::Headers::Fast;
  3         6  
  3         1837  
19              
20             sub prepare_app {
21 9     9 1 67235 my $self = shift;
22              
23 9 100       22 $self->app_name('unknown') unless $self->app_name;
24 9 100       114 $self->metric_name('http_request') unless $self->metric_name;
25 9 100       67 $self->path_cleanups( [ \&replace_idish ] ) unless $self->path_cleanups;
26 9 100       72 $self->long_request(5) unless defined $self->long_request;
27 9         66 foreach my $check (qw(add_headers has_headers)) {
28 18         42 my $val = $self->$check;
29 18 100 100     83 if ( $val && ref($val) ne 'ARRAY' ) {
30 2         12 $log->warn(
31             "Plack::Middleware::StatsPerRequest $check has to be an ARRAYREF, ignoring $val"
32             );
33 2         80 $self->$check(undef);
34             }
35             }
36             }
37              
38             sub call {
39 17     17 1 35630 my $self = shift;
40 17         24 my $env = shift;
41              
42 17         49 my $t0 = [Time::HiRes::gettimeofday];
43              
44 17         69 my $res = $self->app->($env);
45              
46             return Plack::Util::response_cb(
47             $res,
48             sub {
49 17     17   202 my $res = shift;
50 17         25 my $req;
51              
52 17         48 my $elapsed = Time::HiRes::tv_interval($t0);
53 17 100       292 $elapsed = sprintf( '%5f', $elapsed ) if $elapsed < .0001;
54              
55 17         35 my $path = $env->{PATH_INFO};
56 17         25 foreach my $callback ( @{ $self->path_cleanups } ) {
  17         44  
57 16         81 $path = $callback->($path);
58             }
59              
60             my %tags = (
61             status => $res->[0],
62             method => $env->{REQUEST_METHOD},
63 17         60 app => $self->app_name,
64             path => $path,
65             );
66 17 100       116 if ( my $headers_to_add = $self->add_headers ) {
67 4         27 $req = Plack::Request->new($env);
68 4         30 foreach my $header (@$headers_to_add) {
69 8   100     735 $tags{ 'header_' . lc($header) } = $req->header($header)
70             // 'not_set';
71             }
72             }
73 17 100       168 if ( my $has_headers = $self->has_headers ) {
74 4   33     32 $req ||= Plack::Request->new($env);
75 4         34 foreach my $header (@$has_headers) {
76 8 100       669 $tags{ 'has_header_' . lc($header) } =
77             $req->header($header) ? 1 : 0;
78             }
79             }
80              
81 17         155 eval {
82 17         40 $stats->write( $self->metric_name,
83             { request_time => $elapsed, hit => 1 }, \%tags );
84 17 100 100     190 if ( $self->long_request && $elapsed > $self->long_request ) {
85 1   33     25 $req ||= Plack::Request->new($env);
86 1         16 $log->warnf( "Long request, took %f: %s %s",
87             $elapsed, $req->method, $req->request_uri );
88             }
89             };
90 17 50       327 if ($@) {
91 0         0 $log->errorf( "Could not write stats: %s", $@ );
92             }
93             }
94 17         3000710 );
95             }
96              
97              
98             sub replace_idish {
99 37     37 1 12693 my $path = shift;
100 37         90 $path = lc( $path . '/' );
101              
102 37         78 $path =~ s{/[a-f0-9\-.]+\@[a-z0-9\-.]+/}{/:msgid/}g;
103 37         121 $path =~ s{/[a-f0-9]+\/[a-f0-9\/]+/}{/:hexpath/}g;
104              
105 37         88 $path =~ s([a-f0-9]{40})(:sha1)g;
106 37         54 $path =~
107             s([a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12})(:uuid)g;
108 37         70 $path =~ s(\d{6,})(:int)g;
109 37         55 $path =~ s{\d+x\d+}{:imgdim}g;
110              
111 37         68 $path =~ s{/\d+/}{/:int/}g;
112 37         54 $path =~ s(/[^/]{55,}/)(/:long/)g;
113 37         68 $path =~ s(/[a-f0-9\-]{8,}/)(/:hex/)g;
114              
115 37         145 return substr( $path, 0, -1 );
116             }
117              
118             "42nd birthday release";
119              
120             __END__