← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 13:50:58 2016
Reported on Fri Jan 8 13:51:26 2016

Filename/usr/share/perl5/Apache/LogFormat/Compiler.pm
StatementsExecuted 1 statements in 4.16ms
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Apache::LogFormat::Compiler;
2
3use strict;
4use warnings;
5use 5.008004;
6use Carp;
7use POSIX::strftime::Compiler qw//;
8use constant {
9 ENVS => 0,
10 RES => 1,
11 LENGTH => 2,
12 REQTIME => 3,
13 TIME => 4,
14};
15
16our $VERSION = '0.30';
17
18# copy from Plack::Middleware::AccessLog
19our %formats = (
20 common => '%h %l %u %t "%r" %>s %b',
21 combined => '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-agent}i"',
22);
23
24sub _safe {
25 my $string = shift;
26 return unless defined $string;
27 $string =~ s/([^[:print:]])/"\\x" . unpack("H*", $1)/eg;
28 return $string;
29}
30
31sub _string {
32 my $string = shift;
33 return '-' if ! defined $string;
34 return '-' if ! length $string;
35 $string =~ s/([^[:print:]])/"\\x" . unpack("H*", $1)/eg;
36 return $string;
37}
38
39sub header_get {
40 my ($headers, $key) = @_;
41 $key = lc $key;
42 my @headers = @$headers; # copy
43 my $value;
44 while (my($hdr, $val) = splice @headers, 0, 2) {
45 if ( lc $hdr eq $key ) {
46 $value = $val;
47 last;
48 }
49 }
50 return $value;
51}
52
53my $psgi_reserved = { CONTENT_LENGTH => 1, CONTENT_TYPE => 1 };
54
55my $block_handler = sub {
56 my($block, $type, $extra) = @_;
57 my $cb;
58 if ($type eq 'i') {
59 $block =~ s/-/_/g;
60 $block = uc($block);
61 $block = "HTTP_${block}" unless $psgi_reserved->{$block};
62 $cb = q!_string($_[ENVS]->{'!.$block.q!'})!;
63 } elsif ($type eq 'o') {
64 $cb = q!_string(header_get($_[RES]->[1],'!.$block.q!'))!;
65 } elsif ($type eq 't') {
66 $cb = q!"[" . POSIX::strftime::Compiler::strftime('!.$block.q!', @lt) . "]"!;
67 } elsif (exists $extra->{$type}) {
68 $cb = q!_string($extra_block_handlers->{'!.$type.q!'}->('!.$block.q!',$_[ENVS],$_[RES],$_[LENGTH],$_[REQTIME]))!;
69 } else {
70 Carp::croak("{$block}$type not supported");
71 $cb = "-";
72 }
73 return q|! . | . $cb . q|
74 . q!|;
75};
76
77our %char_handler = (
78 '%' => q!'%'!,
79 h => q!($_[ENVS]->{REMOTE_ADDR} || '-')!,
80 l => q!'-'!,
81 u => q!($_[ENVS]->{REMOTE_USER} || '-')!,
82 t => q!'[' . $t . ']'!,
83 r => q!_safe($_[ENVS]->{REQUEST_METHOD}) . " " . _safe($_[ENVS]->{REQUEST_URI}) .
84 " " . $_[ENVS]->{SERVER_PROTOCOL}!,
85 s => q!$_[RES]->[0]!,
86 b => q!(defined $_[LENGTH] ? $_[LENGTH] : '-')!,
87 T => q!(defined $_[REQTIME] ? int($_[REQTIME]*1_000_000) : '-')!,
88 D => q!(defined $_[REQTIME] ? $_[REQTIME] : '-')!,
89 v => q!($_[ENVS]->{SERVER_NAME} || '-')!,
90 V => q!($_[ENVS]->{HTTP_HOST} || $_[ENVS]->{SERVER_NAME} || '-')!,
91 p => q!$_[ENVS]->{SERVER_PORT}!,
92 P => q!$$!,
93 m => q!_safe($_[ENVS]->{REQUEST_METHOD})!,
94 U => q!_safe($_[ENVS]->{PATH_INFO})!,
95 q => q!(($_[ENVS]->{QUERY_STRING} ne '') ? '?' . _safe($_[ENVS]->{QUERY_STRING}) : '' )!,
96 H => q!$_[ENVS]->{SERVER_PROTOCOL}!,
97
98);
99
100my $char_handler = sub {
101 my ($char, $extra) = @_;
102 my $cb = $char_handler{$char};
103 if (!$cb && exists $extra->{$char}) {
104 $cb = q!_string($extra_char_handlers->{'!.$char.q!'}->($_[ENVS],$_[RES],$_[LENGTH],$_[REQTIME]))!;
105 }
106 unless ($cb) {
107 Carp::croak "\%$char not supported.";
108 return "-";
109 }
110 q|! . | . $cb . q|
111 . q!|;
112};
113
114sub new {
115 my $class = shift;
116
117 my $fmt = shift || "combined";
118 $fmt = $formats{$fmt} if exists $formats{$fmt};
119
120 my %opts = @_;
121
122 my ($code_ref, $code) = compile($fmt, $opts{block_handlers} || {}, $opts{char_handlers} || {});
123 bless [$code_ref, $code], $class;
124}
125
126sub compile {
127 my $fmt = shift;
128 my $extra_block_handlers = shift;
129 my $extra_char_handlers = shift;
130 $fmt =~ s/!/\\!/g;
131 $fmt =~ s!
132 (?:
133 \%\{(.+?)\}([a-zA-Z]) |
134 \%(?:[<>])?([a-zA-Z\%])
135 )
136 ! $1 ? $block_handler->($1, $2, $extra_block_handlers) : $char_handler->($3, $extra_char_handlers) !egx;
137
138 my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
139 my $c = {};
140 $fmt = q~sub {
141 $_[TIME] = time() if ! defined $_[TIME];
142 my @lt = localtime($_[TIME]);
143 if ( ! exists $c->{tz_cache} || ! exists $c->{isdst_cache} || $lt[8] != $c->{isdst_cache} ) {
144 $c->{tz_cache} = POSIX::strftime::Compiler::strftime('%z',@lt);
145 $c->{isdst_cache} = $lt[8];
146 }
147 my $t = sprintf '%02d/%s/%04d:%02d:%02d:%02d %s', $lt[3], $abbr[$lt[4]], $lt[5]+1900,
148 $lt[2], $lt[1], $lt[0], $c->{tz_cache};
149 q!~ . $fmt . q~!
150 }~;
15114.16ms my $code_ref = eval $fmt; ## no critic
152 die $@ . "\n===\n" . $fmt if $@;
153 wantarray ? ($code_ref, $fmt) : $code_ref;
154}
155
156sub log_line {
157 my $self = shift;
158 $self->[0]->(@_) . "\n";
159}
160
161sub code {
162 my $self = shift;
163 $self->[1];
164}
165
166sub code_ref {
167 my $self = shift;
168 $self->[0];
169}
170
1711;
172__END__
173
174=encoding utf8
175
176=head1 NAME
177
178Apache::LogFormat::Compiler - Compile a log format string to perl-code
179
180=head1 SYNOPSIS
181
182 use Apache::LogFormat::Compiler;
183
184 my $log_handler = Apache::LogFormat::Compiler->new("combined");
185 my $log = $log_handler->log_line(
186 $env,
187 $res,
188 $length,
189 $reqtime,
190 $time
191 );
192
193=head1 DESCRIPTION
194
195Compile a log format string to perl-code. For faster generation of access_log lines.
196
197=head1 METHOD
198
199=over 4
200
201=item new($fmt:String)
202
203Takes a format string (or a preset template C<combined> or C<custom>)
204to specify the log format. This module implements a subset of
205L<Apache's LogFormat templates|http://httpd.apache.org/docs/2.0/mod/mod_log_config.html>:
206
207 %% a percent sign
208 %h REMOTE_ADDR from the PSGI environment, or -
209 %l remote logname not implemented (currently always -)
210 %u REMOTE_USER from the PSGI environment, or -
211 %t [local timestamp, in default format]
212 %r REQUEST_METHOD, REQUEST_URI and SERVER_PROTOCOL from the PSGI environment
213 %s the HTTP status code of the response
214 %b content length of the response
215 %T custom field for handling times in subclasses
216 %D custom field for handling sub-second times in subclasses
217 %v SERVER_NAME from the PSGI environment, or -
218 %V HTTP_HOST or SERVER_NAME from the PSGI environment, or -
219 %p SERVER_PORT from the PSGI environment
220 %P the worker's process id
221 %m REQUEST_METHOD from the PSGI environment
222 %U PATH_INFO from the PSGI environment
223 %q QUERY_STRING from the PSGI environment
224 %H SERVER_PROTOCOL from the PSGI environment
225
226In addition, custom values can be referenced, using C<%{name}>,
227with one of the mandatory modifier flags C<i>, C<o> or C<t>:
228
229 %{variable-name}i HTTP_VARIABLE_NAME value from the PSGI environment
230 %{header-name}o header-name header in the response
231 %{time-format]t localtime in the specified strftime format
232
233=item log_line($env:HashRef, $res:ArrayRef, $length:Integer, $reqtime:Integer, $time:Integer): $log:String
234
235Generates log line.
236
237 $env PSGI env request HashRef
238 $res PSGI response ArrayRef
239 $length Content-Length
240 $reqtime The time taken to serve request in microseconds. optional
241 $time Time the request was received. optional. If $time is undefined. current timestamp is used.
242
243Sample psgi
244
245 use Plack::Builder;
246 use Time::HiRes;
247 use Apache::LogFormat::Compiler;
248
249 my $log_handler = Apache::LogFormat::Compiler->new(
250 '%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-agent}i" %D'
251 );
252 my $compile_log_app = builder {
253 enable sub {
254 my $app = shift;
255 sub {
256 my $env = shift;
257 my $t0 = [gettimeofday];
258 my $res = $app->();
259 my $reqtime = int(Time::HiRes::tv_interval($t0) * 1_000_000);
260 $env->{psgi.error}->print($log_handler->log_line(
261 $env,$res,6,$reqtime, $t0->[0]));
262 }
263 };
264 $app
265 };
266
267=back
268
269=head1 ABOUT POSIX::strftime::Compiler
270
271This module uses L<POSIX::strftime::Compiler> for generate datetime string. POSIX::strftime::Compiler provides GNU C library compatible strftime(3). But this module will not affected by the system locale. This feature is useful when you want to write loggers, servers and portable applications.
272
273=head1 ADD CUSTOM FORMAT STRING
274
275Apache::LogFormat::Compiler allows one to add a custom format string
276
277 my $log_handler = Apache::LogFormat::Compiler->new(
278 '%z %{HTTP_X_FORWARDED_FOR|REMOTE_ADDR}Z',
279 char_handlers => +{
280 'z' => sub {
281 my ($env,$req) = @_;
282 return $env->{HTTP_X_FORWARDED_FOR};
283 }
284 },
285 block_handlers => +{
286 'Z' => sub {
287 my ($block,$env,$req) = @_;
288 # block eq 'HTTP_X_FORWARDED_FOR|REMOTE_ADDR'
289 my ($main, $alt) = split('\|', $args);
290 return exists $env->{$main} ? $env->{$main} : $env->{$alt};
291 }
292 },
293 );
294
295Any single letter can be used, other than those already defined by Apache::LogFormat::Compiler.
296Your sub is called with two or three arguments: the content inside the C<{}>
297from the format (block_handlers only), the PSGI environment (C<$env>),
298and the ArrayRef of the response. It should return the string to be logged.
299
300=head1 AUTHOR
301
302Masahiro Nagano E<lt>kazeburo@gmail.comE<gt>
303
304=head1 SEE ALSO
305
306L<Plack::Middleware::AccessLog>, L<http://httpd.apache.org/docs/2.2/mod/mod_log_config.html>
307
308=head1 LICENSE
309
310Copyright (C) Masahiro Nagano
311
312This library is free software; you can redistribute it and/or modify
313it under the same terms as Perl itself.
314
315=cut