File Coverage

blib/lib/Plack/Middleware/AccessLog/Timed.pm
Criterion Covered Total %
statement 43 45 95.5
branch 10 12 83.3
condition 1 2 50.0
subroutine 7 8 87.5
pod 1 1 100.0
total 62 68 91.1


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