File Coverage

blib/lib/Log/Log4perl/Layout/PatternLayout.pm
Criterion Covered Total %
statement 217 243 89.3
branch 101 126 80.1
condition 36 43 83.7
subroutine 26 27 96.3
pod 0 10 0.0
total 380 449 84.6


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