line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################## |
2
|
|
|
|
|
|
|
################################################## |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use 5.006; |
5
|
70
|
|
|
70
|
|
1145
|
use strict; |
|
70
|
|
|
|
|
241
|
|
6
|
70
|
|
|
70
|
|
363
|
use warnings; |
|
70
|
|
|
|
|
165
|
|
|
70
|
|
|
|
|
1572
|
|
7
|
70
|
|
|
70
|
|
345
|
|
|
70
|
|
|
|
|
149
|
|
|
70
|
|
|
|
|
2043
|
|
8
|
|
|
|
|
|
|
use constant _INTERNAL_DEBUG => 0; |
9
|
70
|
|
|
70
|
|
377
|
|
|
70
|
|
|
|
|
172
|
|
|
70
|
|
|
|
|
4306
|
|
10
|
|
|
|
|
|
|
use Carp; |
11
|
70
|
|
|
70
|
|
442
|
use Log::Log4perl::Util; |
|
70
|
|
|
|
|
145
|
|
|
70
|
|
|
|
|
4257
|
|
12
|
70
|
|
|
70
|
|
479
|
use Log::Log4perl::Level; |
|
70
|
|
|
|
|
211
|
|
|
70
|
|
|
|
|
2822
|
|
13
|
70
|
|
|
70
|
|
463
|
use Log::Log4perl::DateFormat; |
|
70
|
|
|
|
|
187
|
|
|
70
|
|
|
|
|
447
|
|
14
|
70
|
|
|
70
|
|
33065
|
use Log::Log4perl::NDC; |
|
70
|
|
|
|
|
234
|
|
|
70
|
|
|
|
|
2295
|
|
15
|
70
|
|
|
70
|
|
29712
|
use Log::Log4perl::MDC; |
|
70
|
|
|
|
|
188
|
|
|
70
|
|
|
|
|
2243
|
|
16
|
70
|
|
|
70
|
|
28557
|
use Log::Log4perl::Util::TimeTracker; |
|
70
|
|
|
|
|
187
|
|
|
70
|
|
|
|
|
2202
|
|
17
|
70
|
|
|
70
|
|
30283
|
use File::Spec; |
|
70
|
|
|
|
|
190
|
|
|
70
|
|
|
|
|
2171
|
|
18
|
70
|
|
|
70
|
|
498
|
use File::Basename; |
|
70
|
|
|
|
|
152
|
|
|
70
|
|
|
|
|
1383
|
|
19
|
70
|
|
|
70
|
|
378
|
|
|
70
|
|
|
|
|
146
|
|
|
70
|
|
|
|
|
13438
|
|
20
|
|
|
|
|
|
|
our $TIME_HIRES_AVAILABLE_WARNED = 0; |
21
|
|
|
|
|
|
|
our $HOSTNAME; |
22
|
|
|
|
|
|
|
our %GLOBAL_USER_DEFINED_CSPECS = (); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
our $CSPECS = 'cCdFHIlLmMnpPrRtTxX%'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
BEGIN { |
27
|
|
|
|
|
|
|
# Check if we've got Sys::Hostname. If not, just punt. |
28
|
|
|
|
|
|
|
$HOSTNAME = "unknown.host"; |
29
|
70
|
|
|
70
|
|
290
|
if(Log::Log4perl::Util::module_available("Sys::Hostname")) { |
30
|
70
|
50
|
|
|
|
333
|
require Sys::Hostname; |
31
|
70
|
|
|
|
|
444
|
$HOSTNAME = Sys::Hostname::hostname(); |
32
|
70
|
|
|
|
|
265
|
} |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use base qw(Log::Log4perl::Layout); |
36
|
70
|
|
|
70
|
|
3309
|
|
|
70
|
|
|
|
|
159
|
|
|
70
|
|
|
|
|
7269
|
|
37
|
|
|
|
|
|
|
no strict qw(refs); |
38
|
70
|
|
|
70
|
|
466
|
|
|
70
|
|
|
|
|
165
|
|
|
70
|
|
|
|
|
132125
|
|
39
|
|
|
|
|
|
|
################################################## |
40
|
|
|
|
|
|
|
################################################## |
41
|
|
|
|
|
|
|
my $class = shift; |
42
|
|
|
|
|
|
|
$class = ref ($class) || $class; |
43
|
215
|
|
|
215
|
0
|
1416
|
|
44
|
215
|
|
33
|
|
|
1167
|
my $options = ref $_[0] eq "HASH" ? shift : {}; |
45
|
|
|
|
|
|
|
my $layout_string = @_ ? shift : '%m%n'; |
46
|
215
|
100
|
|
|
|
956
|
|
47
|
215
|
100
|
|
|
|
743
|
my $self = { |
48
|
|
|
|
|
|
|
format => undef, |
49
|
|
|
|
|
|
|
info_needed => {}, |
50
|
|
|
|
|
|
|
stack => [], |
51
|
|
|
|
|
|
|
CSPECS => $CSPECS, |
52
|
|
|
|
|
|
|
dontCollapseArrayRefs => $options->{dontCollapseArrayRefs}{value}, |
53
|
|
|
|
|
|
|
last_time => undef, |
54
|
|
|
|
|
|
|
undef_column_value => |
55
|
|
|
|
|
|
|
(exists $options->{ undef_column_value } |
56
|
|
|
|
|
|
|
? $options->{ undef_column_value } |
57
|
|
|
|
|
|
|
: "[undef]"), |
58
|
|
|
|
|
|
|
}; |
59
|
215
|
100
|
|
|
|
2078
|
|
60
|
|
|
|
|
|
|
$self->{timer} = Log::Log4perl::Util::TimeTracker->new( |
61
|
|
|
|
|
|
|
time_function => $options->{time_function} |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
215
|
|
|
|
|
1866
|
if(exists $options->{ConversionPattern}->{value}) { |
65
|
|
|
|
|
|
|
$layout_string = $options->{ConversionPattern}->{value}; |
66
|
215
|
100
|
|
|
|
987
|
} |
67
|
99
|
|
|
|
|
246
|
|
68
|
|
|
|
|
|
|
if(exists $options->{message_chomp_before_newline}) { |
69
|
|
|
|
|
|
|
$self->{message_chomp_before_newline} = |
70
|
215
|
100
|
|
|
|
652
|
$options->{message_chomp_before_newline}->{value}; |
71
|
|
|
|
|
|
|
} else { |
72
|
1
|
|
|
|
|
3
|
$self->{message_chomp_before_newline} = 1; |
73
|
|
|
|
|
|
|
} |
74
|
214
|
|
|
|
|
529
|
|
75
|
|
|
|
|
|
|
bless $self, $class; |
76
|
|
|
|
|
|
|
|
77
|
215
|
|
|
|
|
462
|
#add the global user-defined cspecs |
78
|
|
|
|
|
|
|
foreach my $f (keys %GLOBAL_USER_DEFINED_CSPECS){ |
79
|
|
|
|
|
|
|
#add it to the list of letters |
80
|
215
|
|
|
|
|
797
|
$self->{CSPECS} .= $f; |
81
|
|
|
|
|
|
|
#for globals, the coderef is already evaled, |
82
|
16
|
|
|
|
|
38
|
$self->{USER_DEFINED_CSPECS}{$f} = $GLOBAL_USER_DEFINED_CSPECS{$f}; |
83
|
|
|
|
|
|
|
} |
84
|
16
|
|
|
|
|
44
|
|
85
|
|
|
|
|
|
|
#add the user-defined cspecs local to this appender |
86
|
|
|
|
|
|
|
foreach my $f (keys %{$options->{cspec}}){ |
87
|
|
|
|
|
|
|
$self->add_layout_cspec($f, $options->{cspec}{$f}{value}); |
88
|
215
|
|
|
|
|
403
|
} |
|
215
|
|
|
|
|
848
|
|
89
|
11
|
|
|
|
|
36
|
|
90
|
|
|
|
|
|
|
# non-portable line breaks |
91
|
|
|
|
|
|
|
$layout_string =~ s/\\n/\n/g; |
92
|
|
|
|
|
|
|
$layout_string =~ s/\\r/\r/g; |
93
|
213
|
|
|
|
|
674
|
|
94
|
213
|
|
|
|
|
526
|
$self->define($layout_string); |
95
|
|
|
|
|
|
|
|
96
|
213
|
|
|
|
|
794
|
return $self; |
97
|
|
|
|
|
|
|
} |
98
|
213
|
|
|
|
|
1198
|
|
99
|
|
|
|
|
|
|
################################################## |
100
|
|
|
|
|
|
|
################################################## |
101
|
|
|
|
|
|
|
my($self, $format) = @_; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# If the message contains a %m followed by a newline, |
104
|
213
|
|
|
213
|
0
|
599
|
# make a note of that so that we can cut a superfluous |
105
|
|
|
|
|
|
|
# \n off the message later on |
106
|
|
|
|
|
|
|
if($self->{message_chomp_before_newline} and $format =~ /%m%n/) { |
107
|
|
|
|
|
|
|
$self->{message_chompable} = 1; |
108
|
|
|
|
|
|
|
} else { |
109
|
213
|
100
|
100
|
|
|
2217
|
$self->{message_chompable} = 0; |
110
|
55
|
|
|
|
|
156
|
} |
111
|
|
|
|
|
|
|
|
112
|
158
|
|
|
|
|
441
|
# Parse the format |
113
|
|
|
|
|
|
|
$format =~ s/%(-?\d*(?:\.\d+)?) |
114
|
|
|
|
|
|
|
([$self->{CSPECS}]) |
115
|
|
|
|
|
|
|
(?:{(.*?)})*/ |
116
|
213
|
|
|
|
|
4825
|
rep($self, $1, $2, $3); |
117
|
|
|
|
|
|
|
/gex; |
118
|
|
|
|
|
|
|
|
119
|
560
|
|
|
|
|
1652
|
$self->{printformat} = $format; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
213
|
|
|
|
|
788
|
################################################## |
123
|
|
|
|
|
|
|
################################################## |
124
|
|
|
|
|
|
|
my($self, $num, $op, $curlies) = @_; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
return "%%" if $op eq "%"; |
127
|
|
|
|
|
|
|
|
128
|
560
|
|
|
560
|
0
|
2439
|
# If it's a %d{...} construct, initialize a simple date |
129
|
|
|
|
|
|
|
# format formatter, so that we can quickly render later on. |
130
|
560
|
100
|
|
|
|
1828
|
# If it's just %d, assume %d{yyyy/MM/dd HH:mm:ss} |
131
|
|
|
|
|
|
|
if($op eq "d") { |
132
|
|
|
|
|
|
|
if(defined $curlies) { |
133
|
|
|
|
|
|
|
$curlies = Log::Log4perl::DateFormat->new($curlies); |
134
|
|
|
|
|
|
|
} else { |
135
|
559
|
100
|
|
|
|
1799
|
$curlies = Log::Log4perl::DateFormat->new("yyyy/MM/dd HH:mm:ss"); |
|
|
100
|
|
|
|
|
|
136
|
49
|
100
|
|
|
|
135
|
} |
137
|
5
|
|
|
|
|
21
|
} elsif($op eq "m") { |
138
|
|
|
|
|
|
|
$curlies = $self->curlies_csv_parse($curlies); |
139
|
44
|
|
|
|
|
247
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
push @{$self->{stack}}, [$op, $curlies]; |
142
|
192
|
|
|
|
|
1063
|
|
143
|
|
|
|
|
|
|
$self->{info_needed}->{$op}++; |
144
|
|
|
|
|
|
|
|
145
|
559
|
|
|
|
|
936
|
return "%${num}s"; |
|
559
|
|
|
|
|
1710
|
|
146
|
|
|
|
|
|
|
} |
147
|
559
|
|
|
|
|
1428
|
|
148
|
|
|
|
|
|
|
########################################### |
149
|
559
|
|
|
|
|
2569
|
########################################### |
150
|
|
|
|
|
|
|
my($self, $curlies) = @_; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
my $data = {}; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
if(defined $curlies and length $curlies) { |
155
|
192
|
|
|
192
|
0
|
536
|
$curlies =~ s/\s//g; |
156
|
|
|
|
|
|
|
|
157
|
192
|
|
|
|
|
423
|
for my $field (split /,/, $curlies) { |
158
|
|
|
|
|
|
|
my($key, $value) = split /=/, $field; |
159
|
192
|
100
|
66
|
|
|
759
|
$data->{$key} = $value; |
160
|
6
|
|
|
|
|
16
|
} |
161
|
|
|
|
|
|
|
} |
162
|
6
|
|
|
|
|
22
|
|
163
|
8
|
|
|
|
|
24
|
return $data; |
164
|
8
|
|
|
|
|
37
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
################################################## |
167
|
|
|
|
|
|
|
################################################## |
168
|
192
|
|
|
|
|
520
|
my($self, $message, $category, $priority, $caller_level) = @_; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
$caller_level = 0 unless defined $caller_level; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my %info = (); |
173
|
|
|
|
|
|
|
|
174
|
338
|
|
|
338
|
0
|
895
|
$info{m} = $message; |
175
|
|
|
|
|
|
|
# See 'define' |
176
|
338
|
50
|
|
|
|
751
|
chomp $info{m} if $self->{message_chompable}; |
177
|
|
|
|
|
|
|
|
178
|
338
|
|
|
|
|
623
|
my @results = (); |
179
|
|
|
|
|
|
|
|
180
|
338
|
|
|
|
|
715
|
my $caller_offset = Log::Log4perl::caller_depth_offset( $caller_level ); |
181
|
|
|
|
|
|
|
|
182
|
338
|
100
|
|
|
|
920
|
if($self->{info_needed}->{L} or |
183
|
|
|
|
|
|
|
$self->{info_needed}->{F} or |
184
|
338
|
|
|
|
|
618
|
$self->{info_needed}->{C} or |
185
|
|
|
|
|
|
|
$self->{info_needed}->{l} or |
186
|
338
|
|
|
|
|
1215
|
$self->{info_needed}->{M} or |
187
|
|
|
|
|
|
|
$self->{info_needed}->{T} or |
188
|
338
|
100
|
66
|
|
|
3161
|
0 |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
189
|
|
|
|
|
|
|
) { |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
my ($package, $filename, $line, |
192
|
|
|
|
|
|
|
$subroutine, $hasargs, |
193
|
|
|
|
|
|
|
$wantarray, $evaltext, $is_require, |
194
|
|
|
|
|
|
|
$hints, $bitmask) = caller($caller_offset); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# If caller() choked because of a whacko caller level, |
197
|
94
|
|
|
|
|
693
|
# correct undefined values to '[undef]' in order to prevent |
198
|
|
|
|
|
|
|
# warning messages when interpolating later |
199
|
|
|
|
|
|
|
unless(defined $bitmask) { |
200
|
|
|
|
|
|
|
for($package, |
201
|
|
|
|
|
|
|
$filename, $line, |
202
|
|
|
|
|
|
|
$subroutine, $hasargs, |
203
|
|
|
|
|
|
|
$wantarray, $evaltext, $is_require, |
204
|
|
|
|
|
|
|
$hints, $bitmask) { |
205
|
94
|
100
|
|
|
|
303
|
$_ = '[undef]' unless defined $_; |
206
|
19
|
|
|
|
|
54
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$info{L} = $line; |
210
|
|
|
|
|
|
|
$info{F} = $filename; |
211
|
190
|
100
|
|
|
|
349
|
$info{C} = $package; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
if($self->{info_needed}->{M} or |
214
|
|
|
|
|
|
|
$self->{info_needed}->{l} or |
215
|
94
|
|
|
|
|
191
|
0) { |
216
|
94
|
|
|
|
|
171
|
# To obtain the name of the subroutine which triggered the |
217
|
94
|
|
|
|
|
207
|
# logger, we need to go one additional level up. |
218
|
|
|
|
|
|
|
my $levels_up = 1; |
219
|
94
|
100
|
100
|
|
|
502
|
{ |
|
|
|
100
|
|
|
|
|
220
|
|
|
|
|
|
|
my @callinfo = caller($caller_offset+$levels_up); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
if(_INTERNAL_DEBUG) { |
223
|
|
|
|
|
|
|
callinfo_dump( $caller_offset, \@callinfo ); |
224
|
36
|
|
|
|
|
68
|
} |
225
|
|
|
|
|
|
|
|
226
|
36
|
|
|
|
|
60
|
$subroutine = $callinfo[3]; |
|
43
|
|
|
|
|
163
|
|
227
|
|
|
|
|
|
|
# If we're inside an eval, go up one level further. |
228
|
43
|
|
|
|
|
73
|
if(defined $subroutine and |
229
|
|
|
|
|
|
|
$subroutine eq "(eval)") { |
230
|
|
|
|
|
|
|
print "Inside an eval, one up\n" if _INTERNAL_DEBUG; |
231
|
|
|
|
|
|
|
$levels_up++; |
232
|
43
|
|
|
|
|
84
|
redo; |
233
|
|
|
|
|
|
|
} |
234
|
43
|
100
|
100
|
|
|
184
|
} |
235
|
|
|
|
|
|
|
$subroutine = "main::" unless $subroutine; |
236
|
7
|
|
|
|
|
43
|
print "Subroutine is '$subroutine'\n" if _INTERNAL_DEBUG; |
237
|
7
|
|
|
|
|
12
|
$info{M} = $subroutine; |
238
|
7
|
|
|
|
|
18
|
$info{l} = "$subroutine $filename ($line)"; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
} |
241
|
36
|
100
|
|
|
|
94
|
|
242
|
36
|
|
|
|
|
61
|
$info{X} = "[No curlies defined]"; |
243
|
36
|
|
|
|
|
85
|
$info{x} = Log::Log4perl::NDC->get() if $self->{info_needed}->{x}; |
244
|
36
|
|
|
|
|
151
|
$info{c} = $category; |
245
|
|
|
|
|
|
|
$info{d} = 1; # Dummy value, corrected later |
246
|
|
|
|
|
|
|
$info{n} = "\n"; |
247
|
|
|
|
|
|
|
$info{p} = $priority; |
248
|
338
|
|
|
|
|
751
|
$info{P} = $$; |
249
|
338
|
100
|
|
|
|
775
|
$info{H} = $HOSTNAME; |
250
|
338
|
|
|
|
|
611
|
|
251
|
338
|
|
|
|
|
609
|
my $current_time; |
252
|
338
|
|
|
|
|
670
|
|
253
|
338
|
|
|
|
|
637
|
if($self->{info_needed}->{r} or $self->{info_needed}->{R}) { |
254
|
338
|
|
|
|
|
967
|
if(!$TIME_HIRES_AVAILABLE_WARNED++ and |
255
|
338
|
|
|
|
|
747
|
!$self->{timer}->hires_available()) { |
256
|
|
|
|
|
|
|
warn "Requested %r/%R pattern without installed Time::HiRes\n"; |
257
|
338
|
|
|
|
|
524
|
} |
258
|
|
|
|
|
|
|
$current_time = [$self->{timer}->gettimeofday()]; |
259
|
338
|
100
|
66
|
|
|
1288
|
} |
260
|
53
|
50
|
66
|
|
|
149
|
|
261
|
|
|
|
|
|
|
if($self->{info_needed}->{r}) { |
262
|
0
|
|
|
|
|
0
|
$info{r} = $self->{timer}->milliseconds( $current_time ); |
263
|
|
|
|
|
|
|
} |
264
|
53
|
|
|
|
|
153
|
if($self->{info_needed}->{R}) { |
265
|
|
|
|
|
|
|
$info{R} = $self->{timer}->delta_milliseconds( $current_time ); |
266
|
|
|
|
|
|
|
} |
267
|
338
|
100
|
|
|
|
801
|
|
268
|
53
|
|
|
|
|
180
|
# Stack trace wanted? |
269
|
|
|
|
|
|
|
if($self->{info_needed}->{T}) { |
270
|
338
|
100
|
|
|
|
749
|
local $Carp::CarpLevel = |
271
|
8
|
|
|
|
|
20
|
$Carp::CarpLevel + $caller_offset; |
272
|
|
|
|
|
|
|
my $mess = Carp::longmess(); |
273
|
|
|
|
|
|
|
chomp($mess); |
274
|
|
|
|
|
|
|
# $mess =~ s/(?:\A\s*at.*\n|^\s*Log::Log4perl.*\n|^\s*)//mg; |
275
|
338
|
100
|
|
|
|
792
|
$mess =~ s/(?:\A\s*at.*\n|^\s*)//mg; |
276
|
3
|
|
|
|
|
10
|
$mess =~ s/\n/, /g; |
277
|
|
|
|
|
|
|
$info{T} = $mess; |
278
|
3
|
|
|
|
|
363
|
} |
279
|
3
|
|
|
|
|
287
|
|
280
|
|
|
|
|
|
|
# As long as they're not implemented yet .. |
281
|
3
|
|
|
|
|
35
|
$info{t} = "N/A"; |
282
|
3
|
|
|
|
|
11
|
|
283
|
3
|
|
|
|
|
8
|
# Iterate over all info fields on the stack |
284
|
|
|
|
|
|
|
for my $e (@{$self->{stack}}) { |
285
|
|
|
|
|
|
|
my($op, $curlies) = @$e; |
286
|
|
|
|
|
|
|
|
287
|
338
|
|
|
|
|
652
|
my $result; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
if(exists $self->{USER_DEFINED_CSPECS}->{$op}) { |
290
|
338
|
|
|
|
|
546
|
next unless $self->{info_needed}->{$op}; |
|
338
|
|
|
|
|
819
|
|
291
|
1140
|
|
|
|
|
2179
|
$self->{curlies} = $curlies; |
292
|
|
|
|
|
|
|
$result = $self->{USER_DEFINED_CSPECS}->{$op}->($self, |
293
|
1140
|
|
|
|
|
1559
|
$message, $category, $priority, |
294
|
|
|
|
|
|
|
$caller_offset+1); |
295
|
1140
|
100
|
|
|
|
2694
|
} elsif(exists $info{$op}) { |
|
|
50
|
|
|
|
|
|
296
|
35
|
50
|
|
|
|
73
|
$result = $info{$op}; |
297
|
35
|
|
|
|
|
57
|
if($curlies) { |
298
|
35
|
|
|
|
|
825
|
$result = $self->curly_action($op, $curlies, $info{$op}, |
299
|
|
|
|
|
|
|
$self->{printformat}, \@results); |
300
|
|
|
|
|
|
|
} else { |
301
|
|
|
|
|
|
|
# just for %d |
302
|
1105
|
|
|
|
|
1784
|
if($op eq 'd') { |
303
|
1105
|
100
|
|
|
|
1957
|
$result = $info{$op}->format($self->{timer}->gettimeofday()); |
304
|
|
|
|
|
|
|
} |
305
|
436
|
|
|
|
|
1376
|
} |
306
|
|
|
|
|
|
|
} else { |
307
|
|
|
|
|
|
|
warn "Format %'$op' not implemented (yet)"; |
308
|
669
|
50
|
|
|
|
1341
|
$result = "FORMAT-ERROR"; |
309
|
0
|
|
|
|
|
0
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
$result = $self->{undef_column_value} unless defined $result; |
312
|
|
|
|
|
|
|
push @results, $result; |
313
|
0
|
|
|
|
|
0
|
} |
314
|
0
|
|
|
|
|
0
|
|
315
|
|
|
|
|
|
|
# dbi appender needs that |
316
|
|
|
|
|
|
|
if( scalar @results == 1 and |
317
|
1140
|
100
|
|
|
|
2311
|
!defined $results[0] ) { |
318
|
1140
|
|
|
|
|
2514
|
return undef; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
return (sprintf $self->{printformat}, @results); |
322
|
338
|
100
|
100
|
|
|
1102
|
} |
323
|
|
|
|
|
|
|
|
324
|
2
|
|
|
|
|
8
|
################################################## |
325
|
|
|
|
|
|
|
################################################## |
326
|
|
|
|
|
|
|
my($self, $ops, $curlies, $data, $printformat, $results) = @_; |
327
|
336
|
|
|
|
|
2477
|
|
328
|
|
|
|
|
|
|
if($ops eq "c") { |
329
|
|
|
|
|
|
|
$data = shrink_category($data, $curlies); |
330
|
|
|
|
|
|
|
} elsif($ops eq "C") { |
331
|
|
|
|
|
|
|
$data = shrink_category($data, $curlies); |
332
|
|
|
|
|
|
|
} elsif($ops eq "X") { |
333
|
436
|
|
|
436
|
0
|
1101
|
$data = Log::Log4perl::MDC->get($curlies); |
334
|
|
|
|
|
|
|
} elsif($ops eq "d") { |
335
|
436
|
100
|
|
|
|
2937
|
$data = $curlies->format( $self->{timer}->gettimeofday() ); |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
336
|
1
|
|
|
|
|
3
|
} elsif($ops eq "M") { |
337
|
|
|
|
|
|
|
$data = shrink_category($data, $curlies); |
338
|
0
|
|
|
|
|
0
|
} elsif($ops eq "m") { |
339
|
|
|
|
|
|
|
if(exists $curlies->{chomp}) { |
340
|
6
|
|
|
|
|
33
|
chomp $data; |
341
|
|
|
|
|
|
|
} |
342
|
109
|
|
|
|
|
358
|
if(exists $curlies->{indent}) { |
343
|
|
|
|
|
|
|
if(defined $curlies->{indent}) { |
344
|
2
|
|
|
|
|
7
|
# fixed indent |
345
|
|
|
|
|
|
|
$data =~ s/\n/ "\n" . (" " x $curlies->{indent})/ge; |
346
|
288
|
100
|
|
|
|
706
|
} else { |
347
|
4
|
|
|
|
|
10
|
# indent on the lead-in |
348
|
|
|
|
|
|
|
no warnings; # trailing array elements are undefined |
349
|
288
|
100
|
|
|
|
682
|
my $indent = length sprintf $printformat, @$results; |
350
|
5
|
100
|
|
|
|
10
|
$data =~ s/\n/ "\n" . (" " x $indent)/ge; |
351
|
|
|
|
|
|
|
} |
352
|
2
|
|
|
|
|
12
|
} |
|
5
|
|
|
|
|
22
|
|
353
|
|
|
|
|
|
|
} elsif($ops eq "F") { |
354
|
|
|
|
|
|
|
my @parts = File::Spec->splitdir($data); |
355
|
70
|
|
|
70
|
|
631
|
# Limit it to max curlies entries |
|
70
|
|
|
|
|
159
|
|
|
70
|
|
|
|
|
85105
|
|
356
|
3
|
|
|
|
|
15
|
if(@parts > $curlies) { |
357
|
3
|
|
|
|
|
16
|
splice @parts, 0, @parts - $curlies; |
|
7
|
|
|
|
|
28
|
|
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
$data = File::Spec->catfile(@parts); |
360
|
|
|
|
|
|
|
} elsif($ops eq "p") { |
361
|
28
|
|
|
|
|
259
|
$data = substr $data, 0, $curlies; |
362
|
|
|
|
|
|
|
} |
363
|
28
|
100
|
|
|
|
99
|
|
364
|
27
|
|
|
|
|
76
|
return $data; |
365
|
|
|
|
|
|
|
} |
366
|
28
|
|
|
|
|
243
|
|
367
|
|
|
|
|
|
|
################################################## |
368
|
2
|
|
|
|
|
6
|
################################################## |
369
|
|
|
|
|
|
|
my($category, $len) = @_; |
370
|
|
|
|
|
|
|
|
371
|
436
|
|
|
|
|
1048
|
my @components = split /\.|::/, $category; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
if(@components > $len) { |
374
|
|
|
|
|
|
|
splice @components, 0, @components - $len; |
375
|
|
|
|
|
|
|
$category = join '.', @components; |
376
|
|
|
|
|
|
|
} |
377
|
3
|
|
|
3
|
0
|
8
|
|
378
|
|
|
|
|
|
|
return $category; |
379
|
3
|
|
|
|
|
28
|
} |
380
|
|
|
|
|
|
|
|
381
|
3
|
50
|
|
|
|
12
|
################################################## |
382
|
3
|
|
|
|
|
8
|
################################################## |
383
|
3
|
|
|
|
|
12
|
# This is a Class method. |
384
|
|
|
|
|
|
|
# Accepts a coderef or text |
385
|
|
|
|
|
|
|
################################################## |
386
|
3
|
|
|
|
|
17
|
|
387
|
|
|
|
|
|
|
unless($Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE) { |
388
|
|
|
|
|
|
|
die "\$Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE setting " . |
389
|
|
|
|
|
|
|
"prohibits user defined cspecs"; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
my ($letter, $perlcode) = @_; |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
croak "Illegal value '$letter' in call to add_global_cspec()" |
395
|
|
|
|
|
|
|
unless ($letter =~ /^[a-zA-Z]$/); |
396
|
4
|
50
|
|
4
|
0
|
19
|
|
397
|
0
|
|
|
|
|
0
|
croak "Missing argument for perlcode for 'cspec.$letter' ". |
398
|
|
|
|
|
|
|
"in call to add_global_cspec()" |
399
|
|
|
|
|
|
|
unless $perlcode; |
400
|
|
|
|
|
|
|
|
401
|
4
|
|
|
|
|
10
|
croak "Please don't redefine built-in cspecs [$CSPECS]\n". |
402
|
|
|
|
|
|
|
"like you do for \"cspec.$letter\"\n " |
403
|
4
|
50
|
|
|
|
16
|
if ($CSPECS =~/$letter/); |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
if (ref $perlcode eq 'CODE') { |
406
|
4
|
50
|
|
|
|
11
|
$GLOBAL_USER_DEFINED_CSPECS{$letter} = $perlcode; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
}elsif (! ref $perlcode){ |
409
|
|
|
|
|
|
|
|
410
|
4
|
50
|
|
|
|
51
|
$GLOBAL_USER_DEFINED_CSPECS{$letter} = |
411
|
|
|
|
|
|
|
Log::Log4perl::Config::compile_if_perl($perlcode); |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
if ($@) { |
414
|
4
|
100
|
|
|
|
27
|
die qq{Compilation failed for your perl code for }. |
|
|
50
|
|
|
|
|
|
415
|
1
|
|
|
|
|
4
|
qq{"log4j.PatternLayout.cspec.$letter":\n}. |
416
|
|
|
|
|
|
|
qq{This is the error message: \t$@\n}. |
417
|
|
|
|
|
|
|
qq{This is the code that failed: \n$perlcode\n}; |
418
|
|
|
|
|
|
|
} |
419
|
3
|
|
|
|
|
13
|
|
420
|
|
|
|
|
|
|
croak "eval'ing your perlcode for 'log4j.PatternLayout.cspec.$letter' ". |
421
|
|
|
|
|
|
|
"doesn't return a coderef \n". |
422
|
2
|
50
|
|
|
|
10
|
"Here is the perl code: \n\t$perlcode\n " |
423
|
0
|
|
|
|
|
0
|
unless (ref $GLOBAL_USER_DEFINED_CSPECS{$letter} eq 'CODE'); |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
}else{ |
426
|
|
|
|
|
|
|
croak "I don't know how to handle perlcode=$perlcode ". |
427
|
|
|
|
|
|
|
"for 'cspec.$letter' in call to add_global_cspec()"; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
################################################## |
432
|
2
|
50
|
|
|
|
17
|
################################################## |
433
|
|
|
|
|
|
|
# object method |
434
|
|
|
|
|
|
|
# adds a cspec just for this layout |
435
|
0
|
|
|
|
|
0
|
################################################## |
436
|
|
|
|
|
|
|
my ($self, $letter, $perlcode) = @_; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
unless($Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE) { |
439
|
|
|
|
|
|
|
die "\$Log::Log4perl::ALLOW_CODE_IN_CONFIG_FILE setting " . |
440
|
|
|
|
|
|
|
"prohibits user defined cspecs"; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
croak "Illegal value '$letter' in call to add_layout_cspec()" |
444
|
|
|
|
|
|
|
unless ($letter =~ /^[a-zA-Z]$/); |
445
|
|
|
|
|
|
|
|
446
|
11
|
|
|
11
|
0
|
29
|
croak "Missing argument for perlcode for 'cspec.$letter' ". |
447
|
|
|
|
|
|
|
"in call to add_layout_cspec()" |
448
|
11
|
100
|
|
|
|
28
|
unless $perlcode; |
449
|
1
|
|
|
|
|
12
|
|
450
|
|
|
|
|
|
|
croak "Please don't redefine built-in cspecs [$CSPECS] \n". |
451
|
|
|
|
|
|
|
"like you do for 'cspec.$letter'" |
452
|
|
|
|
|
|
|
if ($CSPECS =~/$letter/); |
453
|
10
|
50
|
|
|
|
40
|
|
454
|
|
|
|
|
|
|
if (ref $perlcode eq 'CODE') { |
455
|
|
|
|
|
|
|
|
456
|
10
|
50
|
|
|
|
21
|
$self->{USER_DEFINED_CSPECS}{$letter} = $perlcode; |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
}elsif (! ref $perlcode){ |
459
|
|
|
|
|
|
|
|
460
|
10
|
50
|
|
|
|
80
|
$self->{USER_DEFINED_CSPECS}{$letter} = |
461
|
|
|
|
|
|
|
Log::Log4perl::Config::compile_if_perl($perlcode); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
if ($@) { |
464
|
10
|
50
|
|
|
|
51
|
die qq{Compilation failed for your perl code for }. |
|
|
50
|
|
|
|
|
|
465
|
|
|
|
|
|
|
qq{"cspec.$letter":\n}. |
466
|
0
|
|
|
|
|
0
|
qq{This is the error message: \t$@\n}. |
467
|
|
|
|
|
|
|
qq{This is the code that failed: \n$perlcode\n}; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
croak "eval'ing your perlcode for 'cspec.$letter' ". |
470
|
10
|
|
|
|
|
33
|
"doesn't return a coderef \n". |
471
|
|
|
|
|
|
|
"Here is the perl code: \n\t$perlcode\n " |
472
|
|
|
|
|
|
|
unless (ref $self->{USER_DEFINED_CSPECS}{$letter} eq 'CODE'); |
473
|
9
|
50
|
|
|
|
32
|
|
474
|
0
|
|
|
|
|
0
|
|
475
|
|
|
|
|
|
|
}else{ |
476
|
|
|
|
|
|
|
croak "I don't know how to handle perlcode=$perlcode ". |
477
|
|
|
|
|
|
|
"for 'cspec.$letter' in call to add_layout_cspec()"; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
$self->{CSPECS} .= $letter; |
481
|
|
|
|
|
|
|
} |
482
|
9
|
50
|
|
|
|
43
|
|
483
|
|
|
|
|
|
|
########################################### |
484
|
|
|
|
|
|
|
########################################### |
485
|
|
|
|
|
|
|
my($level, $info) = @_; |
486
|
0
|
|
|
|
|
0
|
|
487
|
|
|
|
|
|
|
my @called_by = caller(0); |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# Just for internal debugging |
490
|
9
|
|
|
|
|
30
|
$called_by[1] = basename $called_by[1]; |
491
|
|
|
|
|
|
|
print "caller($level) at $called_by[1]-$called_by[2] returned "; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
my @by_idx; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# $info->[1] = basename $info->[1] if defined $info->[1]; |
496
|
0
|
|
|
0
|
0
|
|
|
497
|
|
|
|
|
|
|
my $i = 0; |
498
|
0
|
|
|
|
|
|
for my $field (qw(package filename line subroutine hasargs |
499
|
|
|
|
|
|
|
wantarray evaltext is_require hints bitmask)) { |
500
|
|
|
|
|
|
|
$by_idx[$i] = $field; |
501
|
0
|
|
|
|
|
|
$i++; |
502
|
0
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
$i = 0; |
505
|
|
|
|
|
|
|
for my $value (@$info) { |
506
|
|
|
|
|
|
|
my $field = $by_idx[ $i ]; |
507
|
|
|
|
|
|
|
print "$field=", |
508
|
0
|
|
|
|
|
|
(defined $info->[$i] ? $info->[$i] : "[undef]"), |
509
|
0
|
|
|
|
|
|
" "; |
510
|
|
|
|
|
|
|
$i++; |
511
|
0
|
|
|
|
|
|
} |
512
|
0
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
print "\n"; |
514
|
|
|
|
|
|
|
} |
515
|
0
|
|
|
|
|
|
|
516
|
0
|
|
|
|
|
|
1; |
517
|
0
|
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=encoding utf8 |
520
|
|
|
|
|
|
|
|
521
|
0
|
|
|
|
|
|
=head1 NAME |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
Log::Log4perl::Layout::PatternLayout - Pattern Layout |
524
|
0
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=head1 SYNOPSIS |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
use Log::Log4perl::Layout::PatternLayout; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
my $layout = Log::Log4perl::Layout::PatternLayout->new( |
530
|
|
|
|
|
|
|
"%d (%F:%L)> %m"); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=head1 DESCRIPTION |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Creates a pattern layout according to |
535
|
|
|
|
|
|
|
http://jakarta.apache.org/log4j/docs/api/org/apache/log4j/PatternLayout.html |
536
|
|
|
|
|
|
|
and a couple of Log::Log4perl-specific extensions. |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
The C<new()> method creates a new PatternLayout, specifying its log |
539
|
|
|
|
|
|
|
format. The format |
540
|
|
|
|
|
|
|
string can contain a number of placeholders which will be |
541
|
|
|
|
|
|
|
replaced by the logging engine when it's time to log the message: |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
%c Category of the logging event. |
544
|
|
|
|
|
|
|
%C Fully qualified package (or class) name of the caller |
545
|
|
|
|
|
|
|
%d Current date in yyyy/MM/dd hh:mm:ss format |
546
|
|
|
|
|
|
|
%d{...} Current date in customized format (see below) |
547
|
|
|
|
|
|
|
%F File where the logging event occurred |
548
|
|
|
|
|
|
|
%H Hostname (if Sys::Hostname is available) |
549
|
|
|
|
|
|
|
%l Fully qualified name of the calling method followed by the |
550
|
|
|
|
|
|
|
callers source the file name and line number between |
551
|
|
|
|
|
|
|
parentheses. |
552
|
|
|
|
|
|
|
%L Line number within the file where the log statement was issued |
553
|
|
|
|
|
|
|
%m The message to be logged |
554
|
|
|
|
|
|
|
%m{chomp} Log message, stripped off a trailing newline |
555
|
|
|
|
|
|
|
%m{indent} Log message, multi-lines indented so they line up with first |
556
|
|
|
|
|
|
|
%m{indent=n} Log message, multi-lines indented by n spaces |
557
|
|
|
|
|
|
|
%M Method or function where the logging request was issued |
558
|
|
|
|
|
|
|
%n Newline (OS-independent) |
559
|
|
|
|
|
|
|
%p Priority/level of the logging event (%p{1} shows the first letter) |
560
|
|
|
|
|
|
|
%P pid of the current process |
561
|
|
|
|
|
|
|
%r Number of milliseconds elapsed from program start to logging |
562
|
|
|
|
|
|
|
event |
563
|
|
|
|
|
|
|
%R Number of milliseconds elapsed from last logging event to |
564
|
|
|
|
|
|
|
current logging event |
565
|
|
|
|
|
|
|
%T A stack trace of functions called |
566
|
|
|
|
|
|
|
%x The topmost NDC (see below) |
567
|
|
|
|
|
|
|
%X{key} The entry 'key' of the MDC (see below) |
568
|
|
|
|
|
|
|
%% A literal percent (%) sign |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
NDC and MDC are explained in L<Log::Log4perl/"Nested Diagnostic Context (NDC)"> |
571
|
|
|
|
|
|
|
and L<Log::Log4perl/"Mapped Diagnostic Context (MDC)">. |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
The granularity of time values is milliseconds if Time::HiRes is available. |
574
|
|
|
|
|
|
|
If not, only full seconds are used. |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Every once in a while, someone uses the "%m%n" pattern and |
577
|
|
|
|
|
|
|
additionally provides an extra newline in the log message (e.g. |
578
|
|
|
|
|
|
|
C<-E<gt>log("message\n")>. To avoid printing an extra newline in |
579
|
|
|
|
|
|
|
this case, the PatternLayout will chomp the message, printing only |
580
|
|
|
|
|
|
|
one newline. This option can be controlled by PatternLayout's |
581
|
|
|
|
|
|
|
C<message_chomp_before_newline> option. See L<Advanced options> |
582
|
|
|
|
|
|
|
for details. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=head2 Quantify placeholders |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
All placeholders can be extended with formatting instructions, |
587
|
|
|
|
|
|
|
just like in I<printf>: |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
%20c Reserve 20 chars for the category, right-justify and fill |
590
|
|
|
|
|
|
|
with blanks if it is shorter |
591
|
|
|
|
|
|
|
%-20c Same as %20c, but left-justify and fill the right side |
592
|
|
|
|
|
|
|
with blanks |
593
|
|
|
|
|
|
|
%09r Zero-pad the number of milliseconds to 9 digits |
594
|
|
|
|
|
|
|
%.8c Specify the maximum field with and have the formatter |
595
|
|
|
|
|
|
|
cut off the rest of the value |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head2 Fine-tuning with curlies |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
Some placeholders have special functions defined if you add curlies |
600
|
|
|
|
|
|
|
with content after them: |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
%c{1} Just show the right-most category compontent, useful in large |
603
|
|
|
|
|
|
|
class hierarchies (Foo::Baz::Bar -> Bar) |
604
|
|
|
|
|
|
|
%c{2} Just show the two right most category components |
605
|
|
|
|
|
|
|
(Foo::Baz::Bar -> Baz::Bar) |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
%F Display source file including full path |
608
|
|
|
|
|
|
|
%F{1} Just display filename |
609
|
|
|
|
|
|
|
%F{2} Display filename and last path component (dir/test.log) |
610
|
|
|
|
|
|
|
%F{3} Display filename and last two path components (d1/d2/test.log) |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
%M Display fully qualified method/function name |
613
|
|
|
|
|
|
|
%M{1} Just display method name (foo) |
614
|
|
|
|
|
|
|
%M{2} Display method name and last path component (main::foo) |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
In this way, you're able to shrink the displayed category or |
617
|
|
|
|
|
|
|
limit file/path components to save space in your logs. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=head2 Fine-tune the date |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
If you're not happy with the default %d format for the date which |
622
|
|
|
|
|
|
|
looks like |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
yyyy/MM/DD HH:mm:ss |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
(which is slightly different from Log4j which uses C<yyyy-MM-dd HH:mm:ss,SSS>) |
627
|
|
|
|
|
|
|
you're free to fine-tune it in order to display only certain characteristics |
628
|
|
|
|
|
|
|
of a date, according to the SimpleDateFormat in the Java World |
629
|
|
|
|
|
|
|
(http://docs.oracle.com/javase/8/docs/api/java/text/SimpleDateFormat.html): |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
%d{HH:mm} "23:45" -- Just display hours and minutes |
632
|
|
|
|
|
|
|
%d{yy, EEEE} "02, Monday" -- Just display two-digit year |
633
|
|
|
|
|
|
|
and spelled-out weekday |
634
|
|
|
|
|
|
|
%d{e} "1473741760" -- Epoch seconds |
635
|
|
|
|
|
|
|
%d{h a} "12 PM" -- Hour and am/pm marker |
636
|
|
|
|
|
|
|
... and many more |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
For an exhaustive list of all supported date features, look at |
639
|
|
|
|
|
|
|
L<Log::Log4perl::DateFormat>. |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=head2 Custom cspecs |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
First of all, "cspecs" is short for "conversion specifiers", which is |
644
|
|
|
|
|
|
|
the log4j and the printf(3) term for what Mike is calling "placeholders." |
645
|
|
|
|
|
|
|
I suggested "cspecs" for this part of the api before I saw that Mike was |
646
|
|
|
|
|
|
|
using "placeholders" consistently in the log4perl documentation. Ah, the |
647
|
|
|
|
|
|
|
joys of collaboration ;=) --kg |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
If the existing corpus of placeholders/cspecs isn't good enough for you, |
650
|
|
|
|
|
|
|
you can easily roll your own: |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
#'U' a global user-defined cspec |
653
|
|
|
|
|
|
|
log4j.PatternLayout.cspec.U = sub { return "UID: $< "} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
#'K' cspec local to appndr1 (pid in hex) |
656
|
|
|
|
|
|
|
log4j.appender.appndr1.layout.cspec.K = sub { return sprintf "%1x", $$} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
#and now you can use them |
659
|
|
|
|
|
|
|
log4j.appender.appndr1.layout.ConversionPattern = %K %U %m%n |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
The benefit of this approach is that you can define and use the cspecs |
662
|
|
|
|
|
|
|
right next to each other in the config file. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
If you're an API kind of person, there's also this call: |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
Log::Log4perl::Layout::PatternLayout:: |
667
|
|
|
|
|
|
|
add_global_cspec('Z', sub {'zzzzzzzz'}); #snooze? |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
When the log message is being put together, your anonymous sub |
670
|
|
|
|
|
|
|
will be called with these arguments: |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
($layout, $message, $category, $priority, $caller_level); |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
layout: the PatternLayout object that called it |
675
|
|
|
|
|
|
|
message: the logging message (%m) |
676
|
|
|
|
|
|
|
category: e.g. groceries.beverages.adult.beer.schlitz |
677
|
|
|
|
|
|
|
priority: e.g. DEBUG|WARN|INFO|ERROR|FATAL |
678
|
|
|
|
|
|
|
caller_level: how many levels back up the call stack you have |
679
|
|
|
|
|
|
|
to go to find the caller |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
Please note that the subroutines you're defining in this way are going |
682
|
|
|
|
|
|
|
to be run in the C<main> namespace, so be sure to fully qualify functions |
683
|
|
|
|
|
|
|
and variables if they're located in different packages. I<Also make sure |
684
|
|
|
|
|
|
|
these subroutines aren't using Log4perl, otherwise Log4perl will enter |
685
|
|
|
|
|
|
|
an infinite recursion.> |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
With Log4perl 1.20 and better, cspecs can be written with parameters in |
688
|
|
|
|
|
|
|
curly braces. Writing something like |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
log4perl.appender.Screen.layout.ConversionPattern = %U{user} %U{id} %m%n |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
will cause the cspec function defined for %U to be called twice, once |
693
|
|
|
|
|
|
|
with the parameter 'user' and then again with the parameter 'id', |
694
|
|
|
|
|
|
|
and the placeholders in the cspec string will be replaced with |
695
|
|
|
|
|
|
|
the respective return values. |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
The parameter value is available in the 'curlies' entry of the first |
698
|
|
|
|
|
|
|
parameter passed to the subroutine (the layout object reference). |
699
|
|
|
|
|
|
|
So, if you wanted to map %U{xxx} to entries in the POE session hash, |
700
|
|
|
|
|
|
|
you'd write something like: |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
log4perl.PatternLayout.cspec.U = sub { \ |
703
|
|
|
|
|
|
|
POE::Kernel->get_active_session->get_heap()->{ $_[0]->{curlies} } } |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
B<SECURITY NOTE> |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
This feature means arbitrary perl code can be embedded in the config file. |
708
|
|
|
|
|
|
|
In the rare case where the people who have access to your config file are |
709
|
|
|
|
|
|
|
different from the people who write your code and shouldn't have execute |
710
|
|
|
|
|
|
|
rights, you might want to set |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
$Log::Log4perl::Config->allow_code(0); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
before you call init(). Alternatively you can supply a restricted set of |
715
|
|
|
|
|
|
|
Perl opcodes that can be embedded in the config file as described in |
716
|
|
|
|
|
|
|
L<Log::Log4perl/"Restricting what Opcodes can be in a Perl Hook">. |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
=head2 Advanced Options |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
The constructor of the C<Log::Log4perl::Layout::PatternLayout> class |
721
|
|
|
|
|
|
|
takes an optional hash reference as a first argument to specify |
722
|
|
|
|
|
|
|
additional options in order to (ab)use it in creative ways: |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
my $layout = Log::Log4perl::Layout::PatternLayout->new( |
725
|
|
|
|
|
|
|
{ time_function => \&my_time_func, |
726
|
|
|
|
|
|
|
}, |
727
|
|
|
|
|
|
|
"%d (%F:%L)> %m"); |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Here's a list of parameters: |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=over 4 |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=item time_function |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Takes a reference to a function returning the time for the time/date |
736
|
|
|
|
|
|
|
fields, either in seconds |
737
|
|
|
|
|
|
|
since the epoch or as an array, carrying seconds and |
738
|
|
|
|
|
|
|
microseconds, just like C<Time::HiRes::gettimeofday> does. |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=item message_chomp_before_newline |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
If a layout contains the pattern "%m%n" and the message ends with a newline, |
743
|
|
|
|
|
|
|
PatternLayout will chomp the message, to prevent printing two newlines. |
744
|
|
|
|
|
|
|
If this is not desired, and you want two newlines in this case, |
745
|
|
|
|
|
|
|
the feature can be turned off by setting the |
746
|
|
|
|
|
|
|
C<message_chomp_before_newline> option to a false value: |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
my $layout = Log::Log4perl::Layout::PatternLayout->new( |
749
|
|
|
|
|
|
|
{ message_chomp_before_newline => 0 |
750
|
|
|
|
|
|
|
}, |
751
|
|
|
|
|
|
|
"%d (%F:%L)> %m%n"); |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
In a Log4perl configuration file, the feature can be turned off like this: |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
log4perl.appender.App.layout = PatternLayout |
756
|
|
|
|
|
|
|
log4perl.appender.App.layout.ConversionPattern = %d %m%n |
757
|
|
|
|
|
|
|
# Yes, I want two newlines |
758
|
|
|
|
|
|
|
log4perl.appender.App.layout.message_chomp_before_newline = 0 |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=back |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=head2 Getting rid of newlines |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
If your code contains logging statements like |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# WRONG, don't do that! |
767
|
|
|
|
|
|
|
$logger->debug("Some message\n"); |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
then it's usually best to strip the newlines from these calls. As explained |
770
|
|
|
|
|
|
|
in L<Log::Log4perl/Logging newlines>, logging statements should never contain |
771
|
|
|
|
|
|
|
newlines, but rely on appender layouts to add necessary newlines instead. |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
If changing the code is not an option, use the special PatternLayout |
774
|
|
|
|
|
|
|
placeholder %m{chomp} to refer to the message excluding a trailing |
775
|
|
|
|
|
|
|
newline: |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
log4perl.appender.App.layout.ConversionPattern = %d %m{chomp}%n |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
This will add a single newline to every message, regardless if it |
780
|
|
|
|
|
|
|
complies with the Log4perl newline guidelines or not (thanks to |
781
|
|
|
|
|
|
|
Tim Bunce for this idea). |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=head2 Multi Lines |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
If a log message consists of several lines, like |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
$logger->debug("line1\nline2\nline3"); |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
then by default, they get logged like this (assuming the the layout is |
790
|
|
|
|
|
|
|
set to "%d>%m%n"): |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# layout %d>%m%n |
793
|
|
|
|
|
|
|
2014/07/27 12:46:16>line1 |
794
|
|
|
|
|
|
|
line2 |
795
|
|
|
|
|
|
|
line3 |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
If you'd rather have the messages aligned like |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
# layout %d>%m{indent}%n |
800
|
|
|
|
|
|
|
2014/07/27 12:46:16>line1 |
801
|
|
|
|
|
|
|
line2 |
802
|
|
|
|
|
|
|
line3 |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
then use the C<%m{indent}> option for the %m specifier. This option |
805
|
|
|
|
|
|
|
can also take a fixed value, as in C<%m{indent=2}>, which indents |
806
|
|
|
|
|
|
|
subsequent lines by two spaces: |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
# layout %d>%m{indent=2}%n |
809
|
|
|
|
|
|
|
2014/07/27 12:46:16>line1 |
810
|
|
|
|
|
|
|
line2 |
811
|
|
|
|
|
|
|
line3 |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
Note that you can still add the C<chomp> option for the C<%m> specifier |
814
|
|
|
|
|
|
|
in this case (see above what it does), simply add it after a |
815
|
|
|
|
|
|
|
separating comma, like in C<%m{indent=2,chomp}>. |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=head1 LICENSE |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> |
820
|
|
|
|
|
|
|
and Kevin Goess E<lt>cpan@goess.orgE<gt>. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
823
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=head1 AUTHOR |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
Please contribute patches to the project on Github: |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
http://github.com/mschilli/log4perl |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Send bug reports or requests for enhancements to the authors via our |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
MAILING LIST (questions, bug reports, suggestions/patches): |
834
|
|
|
|
|
|
|
log4perl-devel@lists.sourceforge.net |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Authors (please contact them via the list above, not directly): |
837
|
|
|
|
|
|
|
Mike Schilli <m@perlmeister.com>, |
838
|
|
|
|
|
|
|
Kevin Goess <cpan@goess.org> |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Contributors (in alphabetical order): |
841
|
|
|
|
|
|
|
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton |
842
|
|
|
|
|
|
|
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony |
843
|
|
|
|
|
|
|
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy |
844
|
|
|
|
|
|
|
Grundman, Paul Harrington, Alexander Hartmaier David Hull, |
845
|
|
|
|
|
|
|
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, |
846
|
|
|
|
|
|
|
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, |
847
|
|
|
|
|
|
|
Lars Thegler, David Viner, Mac Yang. |
848
|
|
|
|
|
|
|
|