1use strict; 2use warnings; 3use Test::More; 4use HTTP::Request::Common; 5use Plack::Test; 6use Plack::Builder; 7use POSIX; 8 9my $log; 10 11my $test = sub { 12 my $format = shift; 13 return sub { 14 my $req = shift; 15 my $app = builder { 16 enable "Plack::Middleware::AccessLog", 17 char_handlers => { 18 z => sub { shift->{HTTP_X_FORWARDED_FOR}, } 19 }, 20 block_handlers => +{ 21 Z => sub { 22 my ($block,$env) = @_; 23 24 $env->{$block} || '-' 25 } 26 }, 27 logger => sub { $log = "@_" }, format => $format; 28 sub { [ 200, [ 'Content-Type' => 'text/plain', 'Content-Length', 2 ], [ 'OK' ] ] }; 29 }; 30 test_psgi $app, sub { $_[0]->($req) }; 31 }; 32}; 33 34{ 35 my $req = GET "http://example.com/"; 36 $req->header("Host" => "example.com", "X-Forwarded-For" => "192.0.2.1"); 37 38 my $fmt = "%P %{Host}i %p %{X-Forwarded-For}i %{Content-Type}o %{%m %y}t %v"; 39 $test->($fmt)->($req); 40 chomp $log; 41 my $month_year = POSIX::strftime('%m %y', localtime); 42 is $log, "$$ example.com 80 192.0.2.1 text/plain [$month_year] example.com"; 43} 44 45{ 46 $test->("%D")->(GET "/"); 47 chomp $log; 48 is $log, '-'; 49} 50 51{ 52 my $req = GET "http://example.com/"; 53 my $fmt = "%r == %m %U%q %H"; 54 $test->($fmt)->($req); 55 chomp $log; 56 my ($r, $rs) = split / == /, $log; 57 is $r, $rs; 58} 59 60{ 61 my $req = GET "http://example.com/foo?bar=baz"; 62 my $fmt = "%r == %m %U%q %H"; 63 $test->($fmt)->($req); 64 chomp $log; 65 my ($r, $rs) = split / == /, $log; 66 is $r, $rs; 67} 68 69{ 70 my $req = GET "http://example.com/foo?bar=baz", 71 x_forwarded_for => 'herp derp'; 72 my $fmt = "%m %z"; 73 $test->($fmt)->($req); 74 chomp $log; 75 is $log, 'GET herp derp'; 76} 77 78{ 79 my $req = GET "http://example.com/foo?bar=baz", 80 x_rand_r => 'station'; 81 my $fmt = "%m %{HTTP_X_RAND_R}Z"; 82 $test->($fmt)->($req); 83 chomp $log; 84 is $log, 'GET station'; 85} 86 87{ 88 my $req = POST "http://example.com/foo", [ "bar", "baz" ]; 89 my $fmt = "cti=%{Content-Type}i cli=%{Content-Length}i cto=%{Content-Type}o clo=%{Content-Length}o"; 90 $test->($fmt)->($req); 91 chomp $log; 92 93 my %vals = split /[= ]/, $log; 94 is_deeply \%vals, { cti => "application/x-www-form-urlencoded", cli => 7, 95 cto => 'text/plain', clo => 2 }; 96} 97 98done_testing; 99