File Coverage

blib/lib/Plack/Middleware/AccessLog/Timed.pm
Criterion Covered Total %
statement 43 45 95.5
branch 10 12 83.3
condition 1 3 33.3
subroutine 7 8 87.5
pod 1 1 100.0
total 62 69 89.8


line stmt bran cond sub pod time code
1             package Plack::Middleware::AccessLog::Timed;
2 2     2   501 use strict;
  2         3  
  2         58  
3 2     2   16 use warnings;
  2         4  
  2         92  
4 2     2   7 use parent qw( Plack::Middleware::AccessLog );
  2         3  
  2         10  
5              
6 2     2   77 use Time::HiRes;
  2         3  
  2         12  
7 2     2   75 use Plack::Util;
  2         3  
  2         630  
8              
9             sub call {
10 12     12 1 19 my $self = shift;
11 12         16 my($env) = @_;
12              
13 12         36 my $time = [Time::HiRes::gettimeofday];
14 12         17 my $length = 0;
15 12   33 0   43 my $logger = $self->logger || sub { $env->{'psgi.errors'}->print(@_) };
  0            
16              
17 12         32 my $res = $self->app->($env);
18              
19             return $self->response_cb($res, sub {
20 12     12   14 my $res = shift;
21 12         26 my($status, $header, $body) = @$res;
22              
23 12 100       34 if (!defined $body) {
24 3         4 my $length;
25              
26             return sub {
27 6         8 my $line = shift;
28            
29 6 100       8 $length += length $line if defined $line;
30              
31 6 100       12 unless( defined $line ) {
32 3         6 my $now = [Time::HiRes::gettimeofday];
33 3         9 $logger->( $self->log_line($status, $header, $env, { time => scalar Time::HiRes::tv_interval($time, $now) * 1_000_000, content_length => $length }) );
34             }
35              
36 6         345 return $line;
37 3         10 };
38             }
39              
40 9 50       45 my $getline = ref $body eq 'ARRAY' ? sub { shift @$body } : sub { $body->getline };
  17         26  
  0         0  
41              
42             my $timer_body = Plack::Util::inline_object(
43             getline => sub {
44 17         24 my $line = $getline->();
45 17 100       34 $length += length $line if defined $line;
46 17         45 return $line;
47             },
48             close => sub {
49 9 50       22 $body->close if ref $body ne 'ARRAY';
50              
51 9         26 my $now = [Time::HiRes::gettimeofday];
52 9         34 $logger->( $self->log_line($status, $header, $env, { time => scalar Time::HiRes::tv_interval($time, $now) * 1_000_000, content_length => $length }) );
53             },
54 9         75 );
55              
56 9         32 @$res = ($status, $header, $timer_body);
57 12         90 });
58             }
59              
60             1;
61              
62             __END__