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   985 use strict;
  70         197  
6 70     70   302 use warnings;
  70         127  
  70         1276  
7 70     70   295  
  70         138  
  70         1655  
8             use constant _INTERNAL_DEBUG => 0;
9 70     70   304  
  70         155  
  70         3898  
10             use Carp;
11 70     70   394 use Log::Log4perl::Util;
  70         115  
  70         3800  
12 70     70   412 use Log::Log4perl::Level;
  70         174  
  70         2322  
13 70     70   405 use Log::Log4perl::DateFormat;
  70         143  
  70         391  
14 70     70   28049 use Log::Log4perl::NDC;
  70         159  
  70         2005  
15 70     70   26256 use Log::Log4perl::MDC;
  70         162  
  70         1775  
16 70     70   23637 use Log::Log4perl::Util::TimeTracker;
  70         163  
  70         1843  
17 70     70   25512 use File::Spec;
  70         160  
  70         1835  
18 70     70   422 use File::Basename;
  70         137  
  70         1112  
19 70     70   322  
  70         118  
  70         11143  
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   248 if(Log::Log4perl::Util::module_available("Sys::Hostname")) {
30 70 50       237 require Sys::Hostname;
31 70         369 $HOSTNAME = Sys::Hostname::hostname();
32 70         237 }
33             }
34              
35             use base qw(Log::Log4perl::Layout);
36 70     70   2753  
  70         145  
  70         6739  
37             no strict qw(refs);
38 70     70   377  
  70         128  
  70         107280  
39             ##################################################
40             ##################################################
41             my $class = shift;
42             $class = ref ($class) || $class;
43 215     215 0 1067  
44 215   33     977 my $options = ref $_[0] eq "HASH" ? shift : {};
45             my $layout_string = @_ ? shift : '%m%n';
46 215 100       722
47 215 100       625 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       1845  
60             $self->{timer} = Log::Log4perl::Util::TimeTracker->new(
61             time_function => $options->{time_function}
62             );
63              
64 215         1645 if(exists $options->{ConversionPattern}->{value}) {
65             $layout_string = $options->{ConversionPattern}->{value};
66 215 100       861 }
67 99         214  
68             if(exists $options->{message_chomp_before_newline}) {
69             $self->{message_chomp_before_newline} =
70 215 100       545 $options->{message_chomp_before_newline}->{value};
71             } else {
72 1         4 $self->{message_chomp_before_newline} = 1;
73             }
74 214         436  
75             bless $self, $class;
76              
77 215         394 #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         647 $self->{CSPECS} .= $f;
81             #for globals, the coderef is already evaled,
82 16         39 $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         331 }
  215         684  
89 11         29  
90             # non-portable line breaks
91             $layout_string =~ s/\\n/\n/g;
92             $layout_string =~ s/\\r/\r/g;
93 213         565  
94 213         423 $self->define($layout_string);
95              
96 213         675 return $self;
97             }
98 213         1010  
99             ##################################################
100             ##################################################
101             my($self, $format) = @_;
102              
103             # If the message contains a %m followed by a newline,
104 213     213 0 492 # 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     1585 $self->{message_chompable} = 0;
110 55         130 }
111              
112 158         386 # Parse the format
113             $format =~ s/%(-?\d*(?:\.\d+)?)
114             ([$self->{CSPECS}])
115             (?:{(.*?)})*/
116 213         4259 rep($self, $1, $2, $3);
117             /gex;
118              
119 560         1346 $self->{printformat} = $format;
120             }
121              
122 213         690 ##################################################
123             ##################################################
124             my($self, $num, $op, $curlies) = @_;
125              
126             return "%%" if $op eq "%";
127              
128 560     560 0 2018 # If it's a %d{...} construct, initialize a simple date
129             # format formatter, so that we can quickly render later on.
130 560 100       1542 # 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       1476 $curlies = Log::Log4perl::DateFormat->new("yyyy/MM/dd HH:mm:ss");
    100          
136 49 100       113 }
137 5         20 } elsif($op eq "m") {
138             $curlies = $self->curlies_csv_parse($curlies);
139 44         238 }
140              
141             push @{$self->{stack}}, [$op, $curlies];
142 192         598  
143             $self->{info_needed}->{$op}++;
144              
145 559         782 return "%${num}s";
  559         1420  
146             }
147 559         1197  
148             ###########################################
149 559         2097 ###########################################
150             my($self, $curlies) = @_;
151              
152             my $data = {};
153              
154             if(defined $curlies and length $curlies) {
155 192     192 0 444 $curlies =~ s/\s//g;
156              
157 192         381 for my $field (split /,/, $curlies) {
158             my($key, $value) = split /=/, $field;
159 192 100 66     639 $data->{$key} = $value;
160 6         16 }
161             }
162 6         20  
163 8         18 return $data;
164 8         32 }
165              
166             ##################################################
167             ##################################################
168 192         440 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 769 $info{m} = $message;
175             # See 'define'
176 338 50       662 chomp $info{m} if $self->{message_chompable};
177              
178 338         533 my @results = ();
179              
180 338         597 my $caller_offset = Log::Log4perl::caller_depth_offset( $caller_level );
181              
182 338 100       776 if($self->{info_needed}->{L} or
183             $self->{info_needed}->{F} or
184 338         518 $self->{info_needed}->{C} or
185             $self->{info_needed}->{l} or
186 338         1032 $self->{info_needed}->{M} or
187             $self->{info_needed}->{T} or
188 338 100 66     2659 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         643 # 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       273 $_ = '[undef]' unless defined $_;
206 19         45 }
207             }
208              
209             $info{L} = $line;
210             $info{F} = $filename;
211 190 100       283 $info{C} = $package;
212              
213             if($self->{info_needed}->{M} or
214             $self->{info_needed}->{l} or
215 94         172 0) {
216 94         141 # To obtain the name of the subroutine which triggered the
217 94         169 # logger, we need to go one additional level up.
218             my $levels_up = 1;
219 94 100 100     420 {
      100        
220             my @callinfo = caller($caller_offset+$levels_up);
221              
222             if(_INTERNAL_DEBUG) {
223             callinfo_dump( $caller_offset, \@callinfo );
224 36         64 }
225              
226 36         49 $subroutine = $callinfo[3];
  43         122  
227             # If we're inside an eval, go up one level further.
228 43         86 if(defined $subroutine and
229             $subroutine eq "(eval)") {
230             print "Inside an eval, one up\n" if _INTERNAL_DEBUG;
231             $levels_up++;
232 43         68 redo;
233             }
234 43 100 100     145 }
235             $subroutine = "main::" unless $subroutine;
236 7         7 print "Subroutine is '$subroutine'\n" if _INTERNAL_DEBUG;
237 7         8 $info{M} = $subroutine;
238 7         14 $info{l} = "$subroutine $filename ($line)";
239             }
240             }
241 36 100       96  
242 36         49 $info{X} = "[No curlies defined]";
243 36         70 $info{x} = Log::Log4perl::NDC->get() if $self->{info_needed}->{x};
244 36         143 $info{c} = $category;
245             $info{d} = 1; # Dummy value, corrected later
246             $info{n} = "\n";
247             $info{p} = $priority;
248 338         593 $info{P} = $$;
249 338 100       667 $info{H} = $HOSTNAME;
250 338         532  
251 338         516 my $current_time;
252 338         533  
253 338         530 if($self->{info_needed}->{r} or $self->{info_needed}->{R}) {
254 338         826 if(!$TIME_HIRES_AVAILABLE_WARNED++ and
255 338         655 !$self->{timer}->hires_available()) {
256             warn "Requested %r/%R pattern without installed Time::HiRes\n";
257 338         445 }
258             $current_time = [$self->{timer}->gettimeofday()];
259 338 100 66     1080 }
260 53 50 66     114  
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       710  
268 53         127 # Stack trace wanted?
269             if($self->{info_needed}->{T}) {
270 338 100       665 local $Carp::CarpLevel =
271 8         18 $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       712 $mess =~ s/(?:\A\s*at.*\n|^\s*)//mg;
276 3         8 $mess =~ s/\n/, /g;
277             $info{T} = $mess;
278 3         457 }
279 3         226  
280             # As long as they're not implemented yet ..
281 3         30 $info{t} = "N/A";
282 3         9  
283 3         10 # Iterate over all info fields on the stack
284             for my $e (@{$self->{stack}}) {
285             my($op, $curlies) = @$e;
286              
287 338         570 my $result;
288              
289             if(exists $self->{USER_DEFINED_CSPECS}->{$op}) {
290 338         514 next unless $self->{info_needed}->{$op};
  338         678  
291 1140         1805 $self->{curlies} = $curlies;
292             $result = $self->{USER_DEFINED_CSPECS}->{$op}->($self,
293 1140         1270 $message, $category, $priority,
294             $caller_offset+1);
295 1140 100       2236 } elsif(exists $info{$op}) {
    50          
296 35 50       54 $result = $info{$op};
297 35         45 if($curlies) {
298 35         642 $result = $self->curly_action($op, $curlies, $info{$op},
299             $self->{printformat}, \@results);
300             } else {
301             # just for %d
302 1105         1462 if($op eq 'd') {
303 1105 100       1571 $result = $info{$op}->format($self->{timer}->gettimeofday());
304             }
305 436         1168 }
306             } else {
307             warn "Format %'$op' not implemented (yet)";
308 669 50       1136 $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       1850 !defined $results[0] ) {
318 1140         2028 return undef;
319             }
320              
321             return (sprintf $self->{printformat}, @results);
322 338 100 100     953 }
323              
324 2         8 ##################################################
325             ##################################################
326             my($self, $ops, $curlies, $data, $printformat, $results) = @_;
327 336         2093  
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 905 $data = Log::Log4perl::MDC->get($curlies);
334             } elsif($ops eq "d") {
335 436 100       2453 $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         28 chomp $data;
341             }
342 109         438 if(exists $curlies->{indent}) {
343             if(defined $curlies->{indent}) {
344 2         4 # fixed indent
345             $data =~ s/\n/ "\n" . (" " x $curlies->{indent})/ge;
346 288 100       593 } else {
347 4         10 # indent on the lead-in
348             no warnings; # trailing array elements are undefined
349 288 100       589 my $indent = length sprintf $printformat, @$results;
350 5 100       10 $data =~ s/\n/ "\n" . (" " x $indent)/ge;
351             }
352 2         12 }
  5         18  
353             } elsif($ops eq "F") {
354             my @parts = File::Spec->splitdir($data);
355 70     70   567 # Limit it to max curlies entries
  70         130  
  70         69741  
356 3         12 if(@parts > $curlies) {
357 3         14 splice @parts, 0, @parts - $curlies;
  7         24  
358             }
359             $data = File::Spec->catfile(@parts);
360             } elsif($ops eq "p") {
361 28         242 $data = substr $data, 0, $curlies;
362             }
363 28 100       87  
364 27         66 return $data;
365             }
366 28         227  
367             ##################################################
368 2         6 ##################################################
369             my($category, $len) = @_;
370              
371 436         865 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         26 }
380              
381 3 50       11 ##################################################
382 3         7 ##################################################
383 3         9 # This is a Class method.
384             # Accepts a coderef or text
385             ##################################################
386 3         9  
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         9 croak "Please don't redefine built-in cspecs [$CSPECS]\n".
402             "like you do for \"cspec.$letter\"\n "
403 4 50       13 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       44 $GLOBAL_USER_DEFINED_CSPECS{$letter} =
411             Log::Log4perl::Config::compile_if_perl($perlcode);
412              
413             if ($@) {
414 4 100       25 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         11  
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       15 ##################################################
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       23 unless $perlcode;
449 1         11  
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       31  
454             if (ref $perlcode eq 'CODE') {
455              
456 10 50       22 $self->{USER_DEFINED_CSPECS}{$letter} = $perlcode;
457              
458             }elsif (! ref $perlcode){
459            
460 10 50       67 $self->{USER_DEFINED_CSPECS}{$letter} =
461             Log::Log4perl::Config::compile_if_perl($perlcode);
462              
463             if ($@) {
464 10 50       39 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         36 "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       23  
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       29  
483             ###########################################
484             ###########################################
485             my($level, $info) = @_;
486 0         0  
487             my @called_by = caller(0);
488              
489             # Just for internal debugging
490 9         24 $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