package Log::Log4perl::Appender;
use 5.006;
use strict;
use warnings;
use Log::Log4perl::Level;
use Log::Log4perl::Config;
use constant _INTERNAL_DEBUG => 0;
our $unique_counter = 0;
sub reset {
$unique_counter = 0;
}
sub unique_name {
$unique_counter++;
my $unique_name = sprintf("app%03d", $unique_counter);
return $unique_name;
}
sub new {
my($class, $appenderclass, %params) = @_;
eval {
die "'$appenderclass' not a valid class name " if $appenderclass =~ /[^:\w]/;
no strict 'refs';
if(!scalar(keys %{"$appenderclass\::"})) {
eval "require $appenderclass";
die $@ if $@;
}
};
$@ and die "ERROR: can't load appenderclass '$appenderclass'\n$@";
$params{name} = unique_name() unless exists $params{name};
if ($appenderclass eq 'Log::Dispatch::File' &&
! exists $params{mode}) {
$params{mode} = 'append';
}
my $appender = $appenderclass->new(
min_level => 'debug',
map { $_ => $params{$_} } keys %params,
);
my $self = {
appender => $appender,
name => $params{name},
layout => undef,
level => $ALL,
composite => 0,
};
$self->{warp_message} = $params{warp_message};
if($self->{warp_message} and
my $cref =
Log::Log4perl::Config::compile_if_perl($self->{warp_message})) {
$self->{warp_message} = $cref;
}
bless $self, $class;
return $self;
}
sub composite { my ($self, $flag) = @_;
$self->{composite} = $flag if defined $flag;
return $self->{composite};
}
sub threshold { my ($self, $level) = @_;
print "Setting threshold to $level\n" if _INTERNAL_DEBUG;
if(defined $level) {
$self->{level} = ($level =~ /^(\d+)$/) ? $level :
Log::Log4perl::Level::to_priority($level);
}
return $self->{level};
}
sub log {
my ($self, $p, $category, $level) = @_;
if($self->{level} > $
Log::Log4perl::Level::PRIORITY{$level}) {
print "$self->{level} > $level, aborting\n" if _INTERNAL_DEBUG;
return undef;
}
if($self->{filter}) {
if($self->{filter}->ok(%$p,
log4p_category => $category,
log4p_level => $level )) {
print "Filter $self->{filter}->{name} passes\n" if _INTERNAL_DEBUG;
} else {
print "Filter $self->{filter}->{name} blocks\n" if _INTERNAL_DEBUG;
return undef;
}
}
unless($self->composite()) {
if (! defined $self->{warp_message} ){
$p->{message} =
join($Log::Log4perl::JOIN_MSG_ARRAY_CHAR,
@{$p->{message}}
) if ref $p->{message} eq "ARRAY";
} elsif (! $self->{warp_message}) {
;
} elsif (ref($self->{warp_message}) eq "CODE") {
$p->{message} =
[$self->{warp_message}->(@{$p->{message}})];
} else {
no strict qw(refs);
$p->{message} =
[$self->{warp_message}->(@{$p->{message}})];
}
$p->{message} = $self->{layout}->render($p->{message},
$category,
$level,
3 + $Log::Log4perl::caller_depth,
) if $self->layout();
}
$self->{appender}->log(%$p,
log4p_category => $category,
log4p_level => $level,
);
return 1;
}
sub name { my($self, $name) = @_;
if($name) {
$self->{name} = $name;
}
return $self->{name};
}
sub layout { my($self, $layout) = @_;
if($layout) {
$self->{layout} = $layout;
}elsif (! $self->{layout}) {
$self->{layout} = Log::Log4perl::Layout::SimpleLayout
->new($self->{name});
}
return $self->{layout};
}
sub filter { my ($self, $filter) = @_;
if($filter) {
print "Setting filter to $filter->{name}\n" if _INTERNAL_DEBUG;
$self->{filter} = $filter;
}
return $self->{filter};
}
sub AUTOLOAD {
my $self = shift;
no strict qw(vars);
$AUTOLOAD =~ s/.*:://;
return $self->{appender}->$AUTOLOAD(@_);
}
sub DESTROY {
foreach my $key (keys %{$_[0]}) {
delete $_[0]->{$key};
}
}
1;
__END__
=head1 NAME
Log::Log4perl::Appender - Log appender class
=head1 SYNOPSIS
use Log::Log4perl;
# Define a logger
my $logger = Log::Log4perl->get_logger("abc.def.ghi");
# Define a layout
my $layout = Log::Log4perl::Layout::PatternLayout->new(
"%d (%F:%L)> %m");
# Define an appender
my $appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::Screen",
name => 'dumpy');
# Set the appender's layout
$appender->layout($layout);
$logger->add_appender($appender);
=head1 DESCRIPTION
This class is a wrapper around the C<Log::Log4perl::Appender>
appender set.
It also supports the <Log::Dispatch::*> collections of appenders. The
module hides the idiosyncrasies of C<Log::Dispatch> (e.g. every
dispatcher gotta have a name, but there's no accessor to retrieve it)
from C<Log::Log4perl> and yet re-uses the extremely useful variety of
dispatchers already created and tested in C<Log::Dispatch>.
=head1 FUNCTIONS
=head2 Log::Log4perl::Appender->new($dispatcher_class_name, ...);
The constructor C<new()> takes the name of the appender
class to be created as a I<string> (!) argument, optionally followed by
a number of appender-specific parameters,
for example:
# Define an appender
my $appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::File"
filename => 'out.log');
In case of C<Log::Dispatch> appenders,
if no C<name> parameter is specified, the appender object will create
a unique one (format C<appNNN>), which can be retrieved later via
the C<name()> method:
print "The appender's name is ", $appender->name(), "\n";
Other parameters are specific to the appender class being used.
In the case above, the C<filename> parameter specifies the name of
the C<Log::Log4perl::Appender::File> dispatcher used.
However, if, for instance,
you're using a C<Log::Dispatch::Email> dispatcher to send you
email, you'll have to specify C<from> and C<to> email addresses.
Every dispatcher is different.
Please check the C<Log::Dispatch::*> documentation for the appender used
for details on specific requirements.
The C<new()> method will just pass these parameters on to a newly created
C<Log::Dispatch::*> object of the specified type.
When it comes to logging, the C<Log::Log4perl::Appender> will transparently
relay all messages to the C<Log::Dispatch::*> object it carries
in its womb.
=head2 $appender->layout($layout);
The C<layout()> method sets the log layout
used by the appender to the format specified by the
C<Log::Log4perl::Layout::*> object which is passed to it as a reference.
Currently there's two layouts available:
Log::Log4perl::Layout::SimpleLayout
Log::Log4perl::Layout::PatternLayout
Please check the L<Log::Log4perl::Layout::SimpleLayout> and
L<Log::Log4perl::Layout::PatternLayout> manual pages for details.
=head1 Supported Appenders
Here's the list of appender modules currently available via C<Log::Dispatch>,
if not noted otherwise, written by Dave Rolsky:
Log::Dispatch::ApacheLog
Log::Dispatch::DBI (by Tatsuhiko Miyagawa)
Log::Dispatch::Email,
Log::Dispatch::Email::MailSend,
Log::Dispatch::Email::MailSendmail,
Log::Dispatch::Email::MIMELite
Log::Dispatch::File
Log::Dispatch::FileRotate (by Mark Pfeiffer)
Log::Dispatch::Handle
Log::Dispatch::Screen
Log::Dispatch::Syslog
Log::Dispatch::Tk (by Dominique Dumont)
C<Log4perl> doesn't care which ones you use, they're all handled in
the same way via the C<Log::Log4perl::Appender> interface.
Please check the well-written manual pages of the
C<Log::Dispatch> hierarchy on how to use each one of them.
=head1 Parameters passed on to the appender's log() method
When calling the appender's log()-Funktion, Log::Log4perl will
submit a list of key/value pairs. Entries to the following keys are
guaranteed to be present:
=over 4
=item message
Text of the rendered message
=item log4p_category
Name of the category of the logger that triggered the event.
=item log4p_level
Log::Log4perl level of the event
=back
=head1 Pitfalls
Since the C<Log::Dispatch::File> appender truncates log files by default,
and most of the time this is I<not> what you want, we've instructed
C<Log::Log4perl> to change this behaviour by slipping it the
C<mode =E<gt> append> parameter behind the scenes. So, effectively
with C<Log::Log4perl> 0.23, a configuration like
log4perl.category = INFO, FileAppndr
log4perl.appender.FileAppndr = Log::Dispatch::File
log4perl.appender.FileAppndr.filename = test.log
log4perl.appender.FileAppndr.layout = Log::Log4perl::Layout::SimpleLayout
will always I<append> to an existing logfile C<test.log> while if you
specifically request clobbering like in
log4perl.category = INFO, FileAppndr
log4perl.appender.FileAppndr = Log::Dispatch::File
log4perl.appender.FileAppndr.filename = test.log
log4perl.appender.FileAppndr.mode = write
log4perl.appender.FileAppndr.layout = Log::Log4perl::Layout::SimpleLayout
it will overwrite an existing log file C<test.log> and start from scratch.
=head1 Appenders Expecting Message Chunks
Instead of simple strings, certain appenders are expecting multiple fields
as log messages. If a statement like
$logger->debug($ip, $user, "signed in");
causes an off-the-shelf C<Log::Log4perl::Screen>
appender to fire, the appender will
just concatenate the three message chunks passed to it
in order to form a single string.
The chunks will be separated by a string defined in
C<$Log::Log4perl::JOIN_MSG_ARRAY_CHAR> (defaults to the empty string
"").
However, different appenders might choose to
interpret the message above differently: An
appender like C<Log::Log4perl::Appender::DBI> might take the
three arguments passed to the logger and put them in three separate
rows into the DB.
The C<warp_message> appender option is used to specify the desired
behaviour.
If no setting for the appender property
# *** Not defined ***
# log4perl.appender.SomeApp.warp_message
is defined in the Log4perl configuration file, the
appender referenced by C<SomeApp> will fall back to the standard behaviour
and join all message chunks together, separating them by
C<$Log::Log4perl::JOIN_MSG_ARRAY_CHAR>.
If, on the other hand, it is set to a false value, like in
log4perl.appender.SomeApp.layout=NoopLayout
log4perl.appender.SomeApp.warp_message = 0
then the message chunks are passed unmodified to the appender as an
array reference. Please note that you need to set the appender's
layout to C<Log::Log4perl::Layout::NoopLayout> which just leaves
the messages chunks alone instead of formatting them or replacing
conversion specifiers.
B<Please note that the standard appenders in the Log::Dispatch hierarchy
will choke on a bunch of messages passed to them as an array reference.
You can't use C<warp_message = 0> (or the function name syntax
defined below) on them.
Only special appenders like Log::Log4perl::Appender::DBI can deal with
this.>
If (and now we're getting fancy)
an appender expects message chunks, but we would
like to pre-inspect and probably modify them before they're
actually passed to the appender's C<log>
method, an inspection subroutine can be defined with the
appender's C<warp_message> property:
log4perl.appender.SomeApp.layout=NoopLayout
log4perl.appender.SomeApp.warp_message = sub { \
$#_ = 2 if @_ > 3; \
return @_; }
The inspection subroutine defined by the C<warp_message>
property will receive the list of message chunks, like they were
passed to the logger and is expected to return a corrected list.
The example above simply limits the argument list to a maximum of
three by cutting off excess elements and returning the shortened list.
Also, the warp function can be specified by name like in
log4perl.appender.SomeApp.layout=NoopLayout
log4perl.appender.SomeApp.warp_message = main::filter_my_message
In this example,
C<filter_my_message> is a function in the C<main> package,
defined like this:
my $COUNTER = 0;
sub filter_my_message {
my @chunks = @_;
unshift @chunks, ++$COUNTER;
return @chunks;
}
The subroutine above will add an ever increasing counter
as an additional first field to
every message passed to the C<SomeApp> appender -- but not to
any other appender in the system.
=head1 SEE ALSO
Log::Dispatch
=head1 AUTHOR
Mike Schilli, E<lt>log4perl@perlmeister.comE<gt>
=cut