package Catalyst::Log::Log4perl;
=head1 NAME
Catalyst::Log::Log4perl - Log::Log4perl logging for Catalyst
=head1 SYNOPSIS
In MyApp.pm:
use Catalyst::Log::Log4perl;
# then we create a custom logger object for catalyst to use.
# If we dont supply any arguments to new, it will work almost
# like the default catalyst-logger.
__PACKAGE__->log(Catalyst::Log::Log4perl->new());
# But the real power of Log4perl lies in the configuration, so
# lets try that. example.conf is included in the distribution,
# alongside the README and Changes.
__PACKAGE__->log(Catalyst::Log::Log4perl->new('example.conf'));
And later...
$c->log->debug("This is using log4perl!");
=head1 DESCRIPTION
This module provides a L<Catalyst::Log> implementation that uses
L<Log::Log4perl> as the underlying log mechanism. It provides all
the methods listed in L<Catalyst::Log>, with the exception of:
levels
enable
disable
These methods simply return 0 and do nothing, as similar functionality
is already provided by L<Log::Log4perl>.
These methods will all instantiate a logger with the component set to
the package who called it. For example, if you were in the
MyApp::C::Main package, the following:
package MyApp::C::Main;
sub default : Private {
my ( $self, $c ) = @_;
my $logger = $c->log;
$logger->debug("Woot!");
}
Would send a message to the Myapp.C.Main L<Log::Log4perl> component.
See L<Log::Log4perl> for more information on how to configure different
logging mechanisms based on the component.
=head1 METHODS
=over 4
=cut
use strict;
use Log::Log4perl;
use Log::Log4perl::Layout;
use Log::Log4perl::Level;
use Params::Validate;
use Data::Dump;
our $VERSION = '1.00';
{
my @levels = qw[ debug info warn error fatal ];
for ( my $i = 0; $i < @levels; $i++ ) {
my $name = $levels[$i];
my $level = 1 << $i;
no strict 'refs';
*{$name} = sub {
my ( $self, @message ) = @_;
my ( $package, $filename, $line ) = caller;
my $depth = $Log::Log4perl::caller_depth;
unless ( $depth > 0 ) {
$depth = 1;
}
my @info = ( $package, $name, $depth, \@message );
if ( $self->{override_cspecs} ) {
my %caller;
@caller{qw/package filename line/} = caller;
# I really have no idea why the correct subroutine
# is on a different call stack
$caller{subroutine} = ( caller(1) )[3]; #wtf?
push @info, \%caller;
}
$self->_log( \@info );
return 1;
};
*{"is_$name"} = sub {
my ( $self, @message ) = @_;
my ( $package, $filename, $line ) = caller;
my $logger = Log::Log4perl->get_logger($package);
my $func = "is_" . $name;
return $logger->$func;
};
}
}
sub _log {
my $self = shift;
push @{ $self->{log4perl_stack} }, @_;
}
sub _dump {
my $self = shift;
$self->debug( Data::Dump::dump(@_) );
}
=item new($config, [%options])
This builds a new L<Catalyst::Log::Log4perl> object. If you provide an argument
to new(), it will be passed directly to Log::Log4perl::init.
The second (optional) parameter is a hash with extra options. Currently
three additional parameters are defined:
'autoflush' - Set it to a true value to disable abort(1) support.
'watch_delay' - Set it to a true value to use L<Log::Log4perl>'s init_and_watch
'override_cspecs' - EXPERIMENTAL
Set it to a true value to locally override some parts of
L<Log::Log4perl::Layout::PatternLayout>. See L<OVERRIDING CSPECS> below
Without any arguments, new() will initialize a root logger with a single appender,
L<Log::Log4perl::Appender::Screen>, configured to have an identical layout to
the default L<Catalyst::Log> object.
=cut
sub new {
my $self = shift;
my $config = shift;
my %options = @_;
my %foo;
my $ref = \%foo;
my $watch_delay = 0;
if ( exists( $options{'watch_delay'} ) ) {
if ( $options{'watch_delay'} ) {
$watch_delay = $options{'watch_delay'};
}
}
unless ( Log::Log4perl->initialized ) {
if ( defined($config) ) {
if ($watch_delay) {
Log::Log4perl::init_and_watch( $config, $watch_delay );
} else {
Log::Log4perl::init($config);
}
} else {
my $log = Log::Log4perl->get_logger("");
my $layout =
Log::Log4perl::Layout::PatternLayout->new(
"[%d] [catalyst] [%p] %m%n");
my $appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::Screen",
'name' => 'screenlog',
'stderr' => 1,
);
$appender->layout($layout);
$log->add_appender($appender);
$log->level($DEBUG);
}
}
$ref->{autoflush} = $options{autoflush} || 0;
$ref->{override_cspecs} = $options{override_cspecs} || 0;
if ( $ref->{override_cspecs} ) {
@{ $ref->{local_cspecs} }{qw/L F C M l/} = (
sub { $ref->{context}->{line} },
sub { $ref->{context}->{filename} },
sub { $ref->{context}->{package} },
sub { $ref->{context}->{subroutine} },
sub {
sprintf '%s %s (%d)',
@{ $ref->{context} }{qw/subroutine filename line/};
}
);
}
$ref->{abort} = 0;
$ref->{log4perl_stack} = [];
bless $ref, $self;
return $ref;
}
=item _flush()
Flushes the cache. Much like the way Catalyst::Log does it.
=cut
sub _flush {
my ($self) = @_;
my @stack = @{ $self->{log4perl_stack} };
$self->{log4perl_stack} = [];
if ( !$self->{autoflush} and $self->{abort} ) {
$self->{abort} = 0;
return 0;
}
foreach my $logmsg (@stack) {
my ( $package, $type, $depth, $message ) = @{$logmsg}[ 0 .. 3 ];
$self->{context} = $logmsg->[-1] if $self->{override_cspecs};
# fetch all instances of pattern layouts
my @patterns;
if ( $self->{override_cspecs} ) {
@patterns =
grep { $_->isa('Log::Log4perl::Layout::PatternLayout') }
map { $_->layout } values %{ Log::Log4perl->appenders() };
}
# localize the cspecs so we don't disturb modules that
# directly operate on Log4perl
local $_->{USER_DEFINED_CSPECS} for @patterns;
for my $layout (@patterns) {
while ( my ( $cspec, $subref ) = each %{ $self->{local_cspecs} } )
{
# overriding USER_DEFINED_CSPECS relies on an missing internal
# check in Log4perl: cspecs that collide with a predefined one
# can't be added via the API but are executed nonetheless
# and override the originals. This behaviour is only verified
# with version 1.08 of Log::Log4perl
$layout->{USER_DEFINED_CSPECS}->{$cspec} = $subref;
}
}
local $Log::Log4perl::caller_depth = $depth;
my $logger = Log::Log4perl->get_logger($package);
$logger->$type(@$message);
}
}
=item abort($abort)
Causes the current log-object to not log anything, effectivly shutting
up this request, making it disapear from the logs.
=cut
sub abort {
my $self = shift;
my $abort = shift;
$self->{abort} = $abort;
return $self->{abort};
}
=item debug($message)
Passes it's arguments to $logger->debug.
=item info($message)
Passes it's arguments to $logger->info.
=item warn($message)
Passes it's arguments to $logger->warn.
=item error($message)
Passes it's arguments to $logger->error.
=item fatal($message)
Passes it's arguments to $logger->fatal.
=item is_debug()
Calls $logger->is_debug.
=item is_info()
Calls $logger->is_info.
=item is_warn()
Calls $logger->is_warn.
=item is_error()
Calls $logger->is_error.
=item is_fatal()
Calls $logger->is_fatal.
=item levels()
This method does nothing but return "0". You should use L<Log::Log4perl>'s
built in mechanisms for setting up log levels.
=cut
sub levels {
return 0;
}
=item enable()
This method does nothing but return "0". You should use L<Log::Log4perl>'s
built in mechanisms for enabling log levels.
=cut
sub enable {
return 0;
}
=item disable()
This method does nothing but return "0". You should use L<Log::Log4perl>'s
built in mechanisms for disabling log levels.
=cut
sub disable {
return 0;
}
1;
__END__
=back
=head1 OVERRIDING CSPECS
Due to some fundamental design incompatibilities of L<Log::Log4perl>
and L<Catalyst::Log> all cspecs of L<Log::Log4perl::Layout::PatternLayout>
that rely on call stack information fail to work as expected. Affected
are the format strings %L, %F, %C, %M, %l and %T. You can instruct
B<Catalyst::Log::Log4perl> to try to hijack these patterns which seems to
work reasonable well, but be adviced that this feature is HIGHLY EXPERIMENTAL
and relies on a few internals of L<Log::Log4perl> that might change in later
versions of this library. Additionally, this feature is currently only tested
with L<Log::Log4perl> version 1.08 allthough the underlying internals of
L<Log::Log4perl> seem to be stable since at least version 0.47.
=head1 BUGS AND LIMITATIONS
The %T cspec of L<Log::Log4perl::Layout::PatternLayout> is currently
unimplemented. The implementation to get %M defies any logical approach
but seems to work perfectly.
=head1 SEE ALSO
L<Log::Log4perl>, L<Catalyst::Log>, L<Catalyst>.
=head1 AUTHOR
Adam Jacob, C<adam@stalecoffee.org>
Andreas Marienborg, C<omega@palle.net>
Gavin Henry, C<ghenry@suretecsystems.com> (Typos)
Sebastian Willert (Overriding CSPECS)
J. Shirley C<jshirley@gmail.com> (Adding _dump)
=head1 LICENSE
This library is free software. You can redistribute it and/or modify it under
the same terms as perl itself.
=cut