File Coverage

blib/lib/Toadfarm/Plugin/AccessLog.pm
Criterion Covered Total %
statement 26 26 100.0
branch 5 6 83.3
condition 3 5 60.0
subroutine 4 4 100.0
pod 1 1 100.0
total 39 42 92.8


line stmt bran cond sub pod time code
1             package Toadfarm::Plugin::AccessLog;
2 1     1   535 use Mojo::Base 'Mojolicious::Plugin';
  1         2  
  1         4  
3 1     1   125 use Time::HiRes qw(gettimeofday tv_interval);
  1         2  
  1         6  
4              
5             sub register {
6 1     1 1 31 my ($self, $app, $config) = @_;
7 1         3 my $log = $app->log;
8              
9             $app->hook(
10             before_dispatch => sub {
11 5     5   31131 my $tx = $_[0]->tx;
12 5         20 my ($req, $timeout, $url);
13              
14 5         34 $tx->req->env->{t0} = [gettimeofday];
15              
16 5 50       52 if (my $stream = Mojo::IOLoop->stream($tx->connection)) {
17 5         195 $stream->on(timeout => sub { $timeout = 1 });
  1         12221  
18             }
19              
20             $tx->on(
21             finish => sub {
22 5         92791 my $tx = shift;
23 5         15 my $code = $tx->res->code;
24              
25 5 100 50     137 $code ||= 504 if $timeout;
26 5 100       15 $code or return;
27 4         13 $req = $tx->req;
28 4         33 $url = $req->url->clone->to_abs->userinfo(undef);
29              
30 4         1148 unshift @{$url->path->parts}, @{$url->base->path->parts};
  4         11  
  4         55  
31              
32             $log->info(
33             sprintf '[%s] %s %s %s %s %.4fs',
34             $req->request_id, $req->env->{identity} || $tx->remote_address,
35 4   66     175 $req->method, $url, $code, tv_interval($req->env->{t0}),
36             );
37             }
38 5         49 );
39             }
40 1         8 );
41             }
42              
43             1;
44              
45             =encoding utf8
46              
47             =head1 NAME
48              
49             Toadfarm::Plugin::AccessLog - Log requests
50              
51             =head1 SYNOPSIS
52              
53             #!/usr/bin/env perl
54             use Toadfarm -init;
55             # mount applications, set up logging, ...
56             plugin "Toadfarm::Plugin::AccessLog";
57             start;
58              
59             =head1 DESCRIPTION
60              
61             This module will log the request with "info" log level. The log format
62             is subject for change. For now it is:
63              
64             $remote_address $http_method $url $status_code
65             1.2.3.4 GET http://localhost/favicon.ico 200
66              
67             See also L if you think this plugin is too
68             limiting.
69              
70             =head1 METHODS
71              
72             =head2 register
73              
74             Register an "around_dispatch" hook which will log the request.
75              
76             =head1 AUTHOR
77              
78             Jan Henning Thorsen - C
79              
80             =cut