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