| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
################################################## |
|
2
|
|
|
|
|
|
|
################################################## |
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use 5.006; |
|
5
|
70
|
|
|
70
|
|
909
|
use strict; |
|
|
70
|
|
|
|
|
208
|
|
|
6
|
70
|
|
|
70
|
|
297
|
use warnings; |
|
|
70
|
|
|
|
|
130
|
|
|
|
70
|
|
|
|
|
1157
|
|
|
7
|
70
|
|
|
70
|
|
285
|
|
|
|
70
|
|
|
|
|
118
|
|
|
|
70
|
|
|
|
|
1555
|
|
|
8
|
|
|
|
|
|
|
use constant _INTERNAL_DEBUG => 0; |
|
9
|
70
|
|
|
70
|
|
311
|
|
|
|
70
|
|
|
|
|
125
|
|
|
|
70
|
|
|
|
|
3605
|
|
|
10
|
|
|
|
|
|
|
use Carp; |
|
11
|
70
|
|
|
70
|
|
360
|
use Log::Log4perl::Util; |
|
|
70
|
|
|
|
|
107
|
|
|
|
70
|
|
|
|
|
3888
|
|
|
12
|
70
|
|
|
70
|
|
401
|
use Log::Log4perl::Level; |
|
|
70
|
|
|
|
|
132
|
|
|
|
70
|
|
|
|
|
2035
|
|
|
13
|
70
|
|
|
70
|
|
334
|
use Log::Log4perl::DateFormat; |
|
|
70
|
|
|
|
|
145
|
|
|
|
70
|
|
|
|
|
333
|
|
|
14
|
70
|
|
|
70
|
|
24223
|
use Log::Log4perl::NDC; |
|
|
70
|
|
|
|
|
153
|
|
|
|
70
|
|
|
|
|
1876
|
|
|
15
|
70
|
|
|
70
|
|
22729
|
use Log::Log4perl::MDC; |
|
|
70
|
|
|
|
|
146
|
|
|
|
70
|
|
|
|
|
1661
|
|
|
16
|
70
|
|
|
70
|
|
20603
|
use Log::Log4perl::Util::TimeTracker; |
|
|
70
|
|
|
|
|
145
|
|
|
|
70
|
|
|
|
|
1691
|
|
|
17
|
70
|
|
|
70
|
|
22344
|
use File::Spec; |
|
|
70
|
|
|
|
|
146
|
|
|
|
70
|
|
|
|
|
1726
|
|
|
18
|
70
|
|
|
70
|
|
362
|
use File::Basename; |
|
|
70
|
|
|
|
|
132
|
|
|
|
70
|
|
|
|
|
1091
|
|
|
19
|
70
|
|
|
70
|
|
269
|
|
|
|
70
|
|
|
|
|
108
|
|
|
|
70
|
|
|
|
|
10067
|
|
|
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
|
|
224
|
if(Log::Log4perl::Util::module_available("Sys::Hostname")) { |
|
30
|
70
|
50
|
|
|
|
224
|
require Sys::Hostname; |
|
31
|
70
|
|
|
|
|
352
|
$HOSTNAME = Sys::Hostname::hostname(); |
|
32
|
70
|
|
|
|
|
210
|
} |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use base qw(Log::Log4perl::Layout); |
|
36
|
70
|
|
|
70
|
|
2491
|
|
|
|
70
|
|
|
|
|
122
|
|
|
|
70
|
|
|
|
|
6502
|
|
|
37
|
|
|
|
|
|
|
no strict qw(refs); |
|
38
|
70
|
|
|
70
|
|
359
|
|
|
|
70
|
|
|
|
|
120
|
|
|
|
70
|
|
|
|
|
100449
|
|
|
39
|
|
|
|
|
|
|
################################################## |
|
40
|
|
|
|
|
|
|
################################################## |
|
41
|
|
|
|
|
|
|
my $class = shift; |
|
42
|
|
|
|
|
|
|
$class = ref ($class) || $class; |
|
43
|
215
|
|
|
215
|
0
|
1109
|
|
|
44
|
215
|
|
33
|
|
|
919
|
my $options = ref $_[0] eq "HASH" ? shift : {}; |
|
45
|
|
|
|
|
|
|
my $layout_string = @_ ? shift : '%m%n'; |
|
46
|
215
|
100
|
|
|
|
729
|
|
|
47
|
215
|
100
|
|
|
|
554
|
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
|
|
|
|
1605
|
|
|
60
|
|
|
|
|
|
|
$self->{timer} = Log::Log4perl::Util::TimeTracker->new( |
|
61
|
|
|
|
|
|
|
time_function => $options->{time_function} |
|
62
|
|
|
|
|
|
|
); |
|
63
|
|
|
|
|
|
|
|
|
64
|
215
|
|
|
|
|
1490
|
if(exists $options->{ConversionPattern}->{value}) { |
|
65
|
|
|
|
|
|
|
$layout_string = $options->{ConversionPattern}->{value}; |
|
66
|
215
|
100
|
|
|
|
742
|
} |
|
67
|
99
|
|
|
|
|
190
|
|
|
68
|
|
|
|
|
|
|
if(exists $options->{message_chomp_before_newline}) { |
|
69
|
|
|
|
|
|
|
$self->{message_chomp_before_newline} = |
|
70
|
215
|
100
|
|
|
|
506
|
$options->{message_chomp_before_newline}->{value}; |
|
71
|
|
|
|
|
|
|
} else { |
|
72
|
1
|
|
|
|
|
3
|
$self->{message_chomp_before_newline} = 1; |
|
73
|
|
|
|
|
|
|
} |
|
74
|
214
|
|
|
|
|
406
|
|
|
75
|
|
|
|
|
|
|
bless $self, $class; |
|
76
|
|
|
|
|
|
|
|
|
77
|
215
|
|
|
|
|
378
|
#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
|
|
|
|
|
614
|
$self->{CSPECS} .= $f; |
|
81
|
|
|
|
|
|
|
#for globals, the coderef is already evaled, |
|
82
|
16
|
|
|
|
|
34
|
$self->{USER_DEFINED_CSPECS}{$f} = $GLOBAL_USER_DEFINED_CSPECS{$f}; |
|
83
|
|
|
|
|
|
|
} |
|
84
|
16
|
|
|
|
|
29
|
|
|
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
|
|
|
|
|
314
|
} |
|
|
215
|
|
|
|
|
711
|
|
|
89
|
11
|
|
|
|
|
25
|
|
|
90
|
|
|
|
|
|
|
# non-portable line breaks |
|
91
|
|
|
|
|
|
|
$layout_string =~ s/\\n/\n/g; |
|
92
|
|
|
|
|
|
|
$layout_string =~ s/\\r/\r/g; |
|
93
|
213
|
|
|
|
|
532
|
|
|
94
|
213
|
|
|
|
|
386
|
$self->define($layout_string); |
|
95
|
|
|
|
|
|
|
|
|
96
|
213
|
|
|
|
|
652
|
return $self; |
|
97
|
|
|
|
|
|
|
} |
|
98
|
213
|
|
|
|
|
969
|
|
|
99
|
|
|
|
|
|
|
################################################## |
|
100
|
|
|
|
|
|
|
################################################## |
|
101
|
|
|
|
|
|
|
my($self, $format) = @_; |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# If the message contains a %m followed by a newline, |
|
104
|
213
|
|
|
213
|
0
|
477
|
# 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
|
|
|
1403
|
$self->{message_chompable} = 0; |
|
110
|
55
|
|
|
|
|
158
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
158
|
|
|
|
|
363
|
# Parse the format |
|
113
|
|
|
|
|
|
|
$format =~ s/%(-?\d*(?:\.\d+)?) |
|
114
|
|
|
|
|
|
|
([$self->{CSPECS}]) |
|
115
|
|
|
|
|
|
|
(?:{(.*?)})*/ |
|
116
|
213
|
|
|
|
|
4092
|
rep($self, $1, $2, $3); |
|
117
|
|
|
|
|
|
|
/gex; |
|
118
|
|
|
|
|
|
|
|
|
119
|
560
|
|
|
|
|
1320
|
$self->{printformat} = $format; |
|
120
|
|
|
|
|
|
|
} |
|
121
|
|
|
|
|
|
|
|
|
122
|
213
|
|
|
|
|
639
|
################################################## |
|
123
|
|
|
|
|
|
|
################################################## |
|
124
|
|
|
|
|
|
|
my($self, $num, $op, $curlies) = @_; |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
return "%%" if $op eq "%"; |
|
127
|
|
|
|
|
|
|
|
|
128
|
560
|
|
|
560
|
0
|
1934
|
# If it's a %d{...} construct, initialize a simple date |
|
129
|
|
|
|
|
|
|
# format formatter, so that we can quickly render later on. |
|
130
|
560
|
100
|
|
|
|
1427
|
# 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
|
|
|
|
1370
|
$curlies = Log::Log4perl::DateFormat->new("yyyy/MM/dd HH:mm:ss"); |
|
|
|
100
|
|
|
|
|
|
|
136
|
49
|
100
|
|
|
|
111
|
} |
|
137
|
5
|
|
|
|
|
18
|
} elsif($op eq "m") { |
|
138
|
|
|
|
|
|
|
$curlies = $self->curlies_csv_parse($curlies); |
|
139
|
44
|
|
|
|
|
229
|
} |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
push @{$self->{stack}}, [$op, $curlies]; |
|
142
|
192
|
|
|
|
|
546
|
|
|
143
|
|
|
|
|
|
|
$self->{info_needed}->{$op}++; |
|
144
|
|
|
|
|
|
|
|
|
145
|
559
|
|
|
|
|
741
|
return "%${num}s"; |
|
|
559
|
|
|
|
|
1404
|
|
|
146
|
|
|
|
|
|
|
} |
|
147
|
559
|
|
|
|
|
1134
|
|
|
148
|
|
|
|
|
|
|
########################################### |
|
149
|
559
|
|
|
|
|
2044
|
########################################### |
|
150
|
|
|
|
|
|
|
my($self, $curlies) = @_; |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
my $data = {}; |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
if(defined $curlies and length $curlies) { |
|
155
|
192
|
|
|
192
|
0
|
409
|
$curlies =~ s/\s//g; |
|
156
|
|
|
|
|
|
|
|
|
157
|
192
|
|
|
|
|
343
|
for my $field (split /,/, $curlies) { |
|
158
|
|
|
|
|
|
|
my($key, $value) = split /=/, $field; |
|
159
|
192
|
100
|
66
|
|
|
583
|
$data->{$key} = $value; |
|
160
|
6
|
|
|
|
|
18
|
} |
|
161
|
|
|
|
|
|
|
} |
|
162
|
6
|
|
|
|
|
21
|
|
|
163
|
8
|
|
|
|
|
21
|
return $data; |
|
164
|
8
|
|
|
|
|
22
|
} |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
################################################## |
|
167
|
|
|
|
|
|
|
################################################## |
|
168
|
192
|
|
|
|
|
433
|
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
|
709
|
$info{m} = $message; |
|
175
|
|
|
|
|
|
|
# See 'define' |
|
176
|
338
|
50
|
|
|
|
591
|
chomp $info{m} if $self->{message_chompable}; |
|
177
|
|
|
|
|
|
|
|
|
178
|
338
|
|
|
|
|
492
|
my @results = (); |
|
179
|
|
|
|
|
|
|
|
|
180
|
338
|
|
|
|
|
579
|
my $caller_offset = Log::Log4perl::caller_depth_offset( $caller_level ); |
|
181
|
|
|
|
|
|
|
|
|
182
|
338
|
100
|
|
|
|
773
|
if($self->{info_needed}->{L} or |
|
183
|
|
|
|
|
|
|
$self->{info_needed}->{F} or |
|
184
|
338
|
|
|
|
|
470
|
$self->{info_needed}->{C} or |
|
185
|
|
|
|
|
|
|
$self->{info_needed}->{l} or |
|
186
|
338
|
|
|
|
|
898
|
$self->{info_needed}->{M} or |
|
187
|
|
|
|
|
|
|
$self->{info_needed}->{T} or |
|
188
|
338
|
100
|
66
|
|
|
2481
|
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
|
|
|
|
|
581
|
# 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
|
|
|
|
225
|
$_ = '[undef]' unless defined $_; |
|
206
|
19
|
|
|
|
|
41
|
} |
|
207
|
|
|
|
|
|
|
} |
|
208
|
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$info{L} = $line; |
|
210
|
|
|
|
|
|
|
$info{F} = $filename; |
|
211
|
190
|
100
|
|
|
|
280
|
$info{C} = $package; |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
if($self->{info_needed}->{M} or |
|
214
|
|
|
|
|
|
|
$self->{info_needed}->{l} or |
|
215
|
94
|
|
|
|
|
146
|
0) { |
|
216
|
94
|
|
|
|
|
133
|
# To obtain the name of the subroutine which triggered the |
|
217
|
94
|
|
|
|
|
138
|
# logger, we need to go one additional level up. |
|
218
|
|
|
|
|
|
|
my $levels_up = 1; |
|
219
|
94
|
100
|
100
|
|
|
384
|
{ |
|
|
|
|
100
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my @callinfo = caller($caller_offset+$levels_up); |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
if(_INTERNAL_DEBUG) { |
|
223
|
|
|
|
|
|
|
callinfo_dump( $caller_offset, \@callinfo ); |
|
224
|
36
|
|
|
|
|
49
|
} |
|
225
|
|
|
|
|
|
|
|
|
226
|
36
|
|
|
|
|
42
|
$subroutine = $callinfo[3]; |
|
|
43
|
|
|
|
|
116
|
|
|
227
|
|
|
|
|
|
|
# If we're inside an eval, go up one level further. |
|
228
|
43
|
|
|
|
|
69
|
if(defined $subroutine and |
|
229
|
|
|
|
|
|
|
$subroutine eq "(eval)") { |
|
230
|
|
|
|
|
|
|
print "Inside an eval, one up\n" if _INTERNAL_DEBUG; |
|
231
|
|
|
|
|
|
|
$levels_up++; |
|
232
|
43
|
|
|
|
|
67
|
redo; |
|
233
|
|
|
|
|
|
|
} |
|
234
|
43
|
100
|
100
|
|
|
129
|
} |
|
235
|
|
|
|
|
|
|
$subroutine = "main::" unless $subroutine; |
|
236
|
7
|
|
|
|
|
7
|
print "Subroutine is '$subroutine'\n" if _INTERNAL_DEBUG; |
|
237
|
7
|
|
|
|
|
20
|
$info{M} = $subroutine; |
|
238
|
7
|
|
|
|
|
15
|
$info{l} = "$subroutine $filename ($line)"; |
|
239
|
|
|
|
|
|
|
} |
|
240
|
|
|
|
|
|
|
} |
|
241
|
36
|
100
|
|
|
|
74
|
|
|
242
|
36
|
|
|
|
|
40
|
$info{X} = "[No curlies defined]"; |
|
243
|
36
|
|
|
|
|
69
|
$info{x} = Log::Log4perl::NDC->get() if $self->{info_needed}->{x}; |
|
244
|
36
|
|
|
|
|
121
|
$info{c} = $category; |
|
245
|
|
|
|
|
|
|
$info{d} = 1; # Dummy value, corrected later |
|
246
|
|
|
|
|
|
|
$info{n} = "\n"; |
|
247
|
|
|
|
|
|
|
$info{p} = $priority; |
|
248
|
338
|
|
|
|
|
582
|
$info{P} = $$; |
|
249
|
338
|
100
|
|
|
|
636
|
$info{H} = $HOSTNAME; |
|
250
|
338
|
|
|
|
|
538
|
|
|
251
|
338
|
|
|
|
|
501
|
my $current_time; |
|
252
|
338
|
|
|
|
|
507
|
|
|
253
|
338
|
|
|
|
|
487
|
if($self->{info_needed}->{r} or $self->{info_needed}->{R}) { |
|
254
|
338
|
|
|
|
|
741
|
if(!$TIME_HIRES_AVAILABLE_WARNED++ and |
|
255
|
338
|
|
|
|
|
575
|
!$self->{timer}->hires_available()) { |
|
256
|
|
|
|
|
|
|
warn "Requested %r/%R pattern without installed Time::HiRes\n"; |
|
257
|
338
|
|
|
|
|
421
|
} |
|
258
|
|
|
|
|
|
|
$current_time = [$self->{timer}->gettimeofday()]; |
|
259
|
338
|
100
|
66
|
|
|
1008
|
} |
|
260
|
53
|
50
|
66
|
|
|
111
|
|
|
261
|
|
|
|
|
|
|
if($self->{info_needed}->{r}) { |
|
262
|
0
|
|
|
|
|
0
|
$info{r} = $self->{timer}->milliseconds( $current_time ); |
|
263
|
|
|
|
|
|
|
} |
|
264
|
53
|
|
|
|
|
129
|
if($self->{info_needed}->{R}) { |
|
265
|
|
|
|
|
|
|
$info{R} = $self->{timer}->delta_milliseconds( $current_time ); |
|
266
|
|
|
|
|
|
|
} |
|
267
|
338
|
100
|
|
|
|
659
|
|
|
268
|
53
|
|
|
|
|
121
|
# Stack trace wanted? |
|
269
|
|
|
|
|
|
|
if($self->{info_needed}->{T}) { |
|
270
|
338
|
100
|
|
|
|
633
|
local $Carp::CarpLevel = |
|
271
|
8
|
|
|
|
|
16
|
$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
|
|
|
|
589
|
$mess =~ s/(?:\A\s*at.*\n|^\s*)//mg; |
|
276
|
3
|
|
|
|
|
11
|
$mess =~ s/\n/, /g; |
|
277
|
|
|
|
|
|
|
$info{T} = $mess; |
|
278
|
3
|
|
|
|
|
303
|
} |
|
279
|
3
|
|
|
|
|
205
|
|
|
280
|
|
|
|
|
|
|
# As long as they're not implemented yet .. |
|
281
|
3
|
|
|
|
|
30
|
$info{t} = "N/A"; |
|
282
|
3
|
|
|
|
|
9
|
|
|
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
|
|
|
|
|
532
|
my $result; |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
if(exists $self->{USER_DEFINED_CSPECS}->{$op}) { |
|
290
|
338
|
|
|
|
|
434
|
next unless $self->{info_needed}->{$op}; |
|
|
338
|
|
|
|
|
633
|
|
|
291
|
1140
|
|
|
|
|
1831
|
$self->{curlies} = $curlies; |
|
292
|
|
|
|
|
|
|
$result = $self->{USER_DEFINED_CSPECS}->{$op}->($self, |
|
293
|
1140
|
|
|
|
|
1300
|
$message, $category, $priority, |
|
294
|
|
|
|
|
|
|
$caller_offset+1); |
|
295
|
1140
|
100
|
|
|
|
2225
|
} elsif(exists $info{$op}) { |
|
|
|
50
|
|
|
|
|
|
|
296
|
35
|
50
|
|
|
|
55
|
$result = $info{$op}; |
|
297
|
35
|
|
|
|
|
40
|
if($curlies) { |
|
298
|
35
|
|
|
|
|
557
|
$result = $self->curly_action($op, $curlies, $info{$op}, |
|
299
|
|
|
|
|
|
|
$self->{printformat}, \@results); |
|
300
|
|
|
|
|
|
|
} else { |
|
301
|
|
|
|
|
|
|
# just for %d |
|
302
|
1105
|
|
|
|
|
1474
|
if($op eq 'd') { |
|
303
|
1105
|
100
|
|
|
|
1543
|
$result = $info{$op}->format($self->{timer}->gettimeofday()); |
|
304
|
|
|
|
|
|
|
} |
|
305
|
436
|
|
|
|
|
1111
|
} |
|
306
|
|
|
|
|
|
|
} else { |
|
307
|
|
|
|
|
|
|
warn "Format %'$op' not implemented (yet)"; |
|
308
|
669
|
50
|
|
|
|
1104
|
$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
|
|
|
|
1771
|
!defined $results[0] ) { |
|
318
|
1140
|
|
|
|
|
1933
|
return undef; |
|
319
|
|
|
|
|
|
|
} |
|
320
|
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
return (sprintf $self->{printformat}, @results); |
|
322
|
338
|
100
|
100
|
|
|
933
|
} |
|
323
|
|
|
|
|
|
|
|
|
324
|
2
|
|
|
|
|
6
|
################################################## |
|
325
|
|
|
|
|
|
|
################################################## |
|
326
|
|
|
|
|
|
|
my($self, $ops, $curlies, $data, $printformat, $results) = @_; |
|
327
|
336
|
|
|
|
|
1959
|
|
|
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
|
885
|
$data = Log::Log4perl::MDC->get($curlies); |
|
334
|
|
|
|
|
|
|
} elsif($ops eq "d") { |
|
335
|
436
|
100
|
|
|
|
2185
|
$data = $curlies->format( $self->{timer}->gettimeofday() ); |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
336
|
1
|
|
|
|
|
2
|
} elsif($ops eq "M") { |
|
337
|
|
|
|
|
|
|
$data = shrink_category($data, $curlies); |
|
338
|
0
|
|
|
|
|
0
|
} elsif($ops eq "m") { |
|
339
|
|
|
|
|
|
|
if(exists $curlies->{chomp}) { |
|
340
|
6
|
|
|
|
|
25
|
chomp $data; |
|
341
|
|
|
|
|
|
|
} |
|
342
|
109
|
|
|
|
|
289
|
if(exists $curlies->{indent}) { |
|
343
|
|
|
|
|
|
|
if(defined $curlies->{indent}) { |
|
344
|
2
|
|
|
|
|
5
|
# fixed indent |
|
345
|
|
|
|
|
|
|
$data =~ s/\n/ "\n" . (" " x $curlies->{indent})/ge; |
|
346
|
288
|
100
|
|
|
|
554
|
} else { |
|
347
|
4
|
|
|
|
|
12
|
# indent on the lead-in |
|
348
|
|
|
|
|
|
|
no warnings; # trailing array elements are undefined |
|
349
|
288
|
100
|
|
|
|
562
|
my $indent = length sprintf $printformat, @$results; |
|
350
|
5
|
100
|
|
|
|
10
|
$data =~ s/\n/ "\n" . (" " x $indent)/ge; |
|
351
|
|
|
|
|
|
|
} |
|
352
|
2
|
|
|
|
|
10
|
} |
|
|
5
|
|
|
|
|
19
|
|
|
353
|
|
|
|
|
|
|
} elsif($ops eq "F") { |
|
354
|
|
|
|
|
|
|
my @parts = File::Spec->splitdir($data); |
|
355
|
70
|
|
|
70
|
|
556
|
# Limit it to max curlies entries |
|
|
70
|
|
|
|
|
133
|
|
|
|
70
|
|
|
|
|
63717
|
|
|
356
|
3
|
|
|
|
|
12
|
if(@parts > $curlies) { |
|
357
|
3
|
|
|
|
|
13
|
splice @parts, 0, @parts - $curlies; |
|
|
7
|
|
|
|
|
24
|
|
|
358
|
|
|
|
|
|
|
} |
|
359
|
|
|
|
|
|
|
$data = File::Spec->catfile(@parts); |
|
360
|
|
|
|
|
|
|
} elsif($ops eq "p") { |
|
361
|
28
|
|
|
|
|
221
|
$data = substr $data, 0, $curlies; |
|
362
|
|
|
|
|
|
|
} |
|
363
|
28
|
100
|
|
|
|
79
|
|
|
364
|
27
|
|
|
|
|
63
|
return $data; |
|
365
|
|
|
|
|
|
|
} |
|
366
|
28
|
|
|
|
|
200
|
|
|
367
|
|
|
|
|
|
|
################################################## |
|
368
|
2
|
|
|
|
|
6
|
################################################## |
|
369
|
|
|
|
|
|
|
my($category, $len) = @_; |
|
370
|
|
|
|
|
|
|
|
|
371
|
436
|
|
|
|
|
863
|
my @components = split /\.|::/, $category; |
|
372
|
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
if(@components > $len) { |
|
374
|
|
|
|
|
|
|
splice @components, 0, @components - $len; |
|
375
|
|
|
|
|
|
|
$category = join '.', @components; |
|
376
|
|
|
|
|
|
|
} |
|
377
|
3
|
|
|
3
|
0
|
7
|
|
|
378
|
|
|
|
|
|
|
return $category; |
|
379
|
3
|
|
|
|
|
21
|
} |
|
380
|
|
|
|
|
|
|
|
|
381
|
3
|
50
|
|
|
|
9
|
################################################## |
|
382
|
3
|
|
|
|
|
6
|
################################################## |
|
383
|
3
|
|
|
|
|
9
|
# This is a Class method. |
|
384
|
|
|
|
|
|
|
# Accepts a coderef or text |
|
385
|
|
|
|
|
|
|
################################################## |
|
386
|
3
|
|
|
|
|
7
|
|
|
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
|
12
|
|
|
397
|
0
|
|
|
|
|
0
|
croak "Missing argument for perlcode for 'cspec.$letter' ". |
|
398
|
|
|
|
|
|
|
"in call to add_global_cspec()" |
|
399
|
|
|
|
|
|
|
unless $perlcode; |
|
400
|
|
|
|
|
|
|
|
|
401
|
4
|
|
|
|
|
7
|
croak "Please don't redefine built-in cspecs [$CSPECS]\n". |
|
402
|
|
|
|
|
|
|
"like you do for \"cspec.$letter\"\n " |
|
403
|
4
|
50
|
|
|
|
14
|
if ($CSPECS =~/$letter/); |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
if (ref $perlcode eq 'CODE') { |
|
406
|
4
|
50
|
|
|
|
9
|
$GLOBAL_USER_DEFINED_CSPECS{$letter} = $perlcode; |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
}elsif (! ref $perlcode){ |
|
409
|
|
|
|
|
|
|
|
|
410
|
4
|
50
|
|
|
|
49
|
$GLOBAL_USER_DEFINED_CSPECS{$letter} = |
|
411
|
|
|
|
|
|
|
Log::Log4perl::Config::compile_if_perl($perlcode); |
|
412
|
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
if ($@) { |
|
414
|
4
|
100
|
|
|
|
16
|
die qq{Compilation failed for your perl code for }. |
|
|
|
50
|
|
|
|
|
|
|
415
|
1
|
|
|
|
|
3
|
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
|
|
|
|
|
9
|
|
|
420
|
|
|
|
|
|
|
croak "eval'ing your perlcode for 'log4j.PatternLayout.cspec.$letter' ". |
|
421
|
|
|
|
|
|
|
"doesn't return a coderef \n". |
|
422
|
2
|
50
|
|
|
|
8
|
"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
|
|
|
|
11
|
################################################## |
|
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
|
22
|
croak "Missing argument for perlcode for 'cspec.$letter' ". |
|
447
|
|
|
|
|
|
|
"in call to add_layout_cspec()" |
|
448
|
11
|
100
|
|
|
|
19
|
unless $perlcode; |
|
449
|
1
|
|
|
|
|
9
|
|
|
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
|
|
|
|
28
|
|
|
454
|
|
|
|
|
|
|
if (ref $perlcode eq 'CODE') { |
|
455
|
|
|
|
|
|
|
|
|
456
|
10
|
50
|
|
|
|
15
|
$self->{USER_DEFINED_CSPECS}{$letter} = $perlcode; |
|
457
|
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
}elsif (! ref $perlcode){ |
|
459
|
|
|
|
|
|
|
|
|
460
|
10
|
50
|
|
|
|
61
|
$self->{USER_DEFINED_CSPECS}{$letter} = |
|
461
|
|
|
|
|
|
|
Log::Log4perl::Config::compile_if_perl($perlcode); |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
if ($@) { |
|
464
|
10
|
50
|
|
|
|
27
|
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
|
|
|
|
|
28
|
"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
|
|
|
|
19
|
|
|
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
|
|
|
|
24
|
|
|
483
|
|
|
|
|
|
|
########################################### |
|
484
|
|
|
|
|
|
|
########################################### |
|
485
|
|
|
|
|
|
|
my($level, $info) = @_; |
|
486
|
0
|
|
|
|
|
0
|
|
|
487
|
|
|
|
|
|
|
my @called_by = caller(0); |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# Just for internal debugging |
|
490
|
9
|
|
|
|
|
22
|
$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
|
|
|
|
|
|
|
|