The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

YAPPO / HTTP-Engine-Middleware-0.22 / lib / HTTP / Engine / Middleware / AccessLog.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
—
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

              
package HTTP::Engine::Middleware::AccessLog;
use HTTP::Engine::Middleware;
use Carp ();
use DateTime;
with 'HTTP::Engine::Middleware::Role::Logger';
has format => (
    is      => 'ro',
    isa     => 'Str',
    default => '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-Agent}i"',
);
after_handle {
    my ( $c, $self, $req, $res ) = @_;
    if ($res) {
        my $msg = $self->format;
        $msg =~ s/\%\{([\w-]+)\}i/$req->header($1) || '-'/ge;                  # %{User-Agent}
        $msg =~ s/\%(?:[><])?([a-z])/handle_char($req, $res, $1) || '-'/ge;    # %r
        $msg =~ s/\%\%/%/g;                                                    # %%
        $self->log($msg);
    }
    return $res;
};
sub handle_char {
    my ($req, $res, $char) = @_;
    my $code = +{
        'h' => sub {
            $req->address, # remote host
        },
        'l' => sub {
            '-', # remote log name
        },
        'u' => sub {
            $req->user; # user name
        },
        't' => sub {
            my $dt = DateTime->now;
            $dt->strftime("[%d/%b/%y:%H:%M:%S %z]");
        },
        'r' => sub {
            join ' ', $req->method, $req->uri->path_query, ($req->protocol||'HTTP/1.0'); # ?
        },
        'b' => sub {
            $res->content_length || '-'; # size of response in bytes, excluding HTTP headers
        },
        's' => sub {
            $res->status
        },
    }->{$char};
    if ($code) {
        return $code->();
    } else {
        Carp::croak "unknown log char '$char'";
    }
}
__MIDDLEWARE__
__END__
=head1 NAME
HTTP::Engine::Middleware::AccessLog - write access log
=head1 SYNOPSIS
    my $mw = HTTP::Engine::Middleware->new;
    $mw->install( 'HTTP::Engine::Middleware::AccessLog' => {
        logger => sub {
            warn @_; # your own callback routine
        },
        format => '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-Agent}i"',
    });
    HTTP::Engine->new(
        interface => {
            module => 'YourFavoriteInterfaceHere',
            request_handler => $mw->handler( \&handler ),
        }
    )->run();
=head1 DESCRIPTION
This middleware prints access log like apache.
This module's log format string is a subset of Apache.
If you want to use more syntax, patches welcome :)
=head1 BUG
%r should contains query string.
=head1 AUTHOR
Tokuhiro Matsuno
=head1 SEE ALSO
L<HTTP::Engine::Middleware>
L<http://httpd.apache.org/docs/2.0/en/mod/mod_log_config.html>