[Catalyst-commits] r12645 -
branches/Catalyst-Log-Log4perl/cleaner_implementation/lib/Catalyst/Log
Ned at dev.catalyst.perl.org
Ned at dev.catalyst.perl.org
Thu Jan 14 09:38:11 GMT 2010
Author: Ned
Date: 2010-01-14 09:38:11 +0000 (Thu, 14 Jan 2010)
New Revision: 12645
Modified:
branches/Catalyst-Log-Log4perl/cleaner_implementation/lib/Catalyst/Log/Log4perl.pm
Log:
Heavy refactoring to simplify implementation and make all the cspecs work
Modified: branches/Catalyst-Log-Log4perl/cleaner_implementation/lib/Catalyst/Log/Log4perl.pm
===================================================================
--- branches/Catalyst-Log-Log4perl/cleaner_implementation/lib/Catalyst/Log/Log4perl.pm 2010-01-14 09:26:04 UTC (rev 12644)
+++ branches/Catalyst-Log-Log4perl/cleaner_implementation/lib/Catalyst/Log/Log4perl.pm 2010-01-14 09:38:11 UTC (rev 12645)
@@ -64,79 +64,43 @@
use strict;
use Log::Log4perl;
-use Log::Log4perl::Layout;
-use Log::Log4perl::Level;
-use Params::Validate;
-use Data::Dump;
our $VERSION = '1.04';
{
my @levels = qw[ debug info warn error fatal ];
- for ( my $i = 0; $i < @levels; $i++ ) {
-
- my $name = $levels[$i];
- my $level = 1 << $i;
-
+ foreach my $name ( @levels ) {
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 ( $package ) = caller;
+ {
+ local $Log::Log4perl::caller_depth;
+ $Log::Log4perl::caller_depth++;
+ Log::Log4perl->get_logger($package)->$name(@message);
}
- 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 ( $package ) = caller;
my $func = "is_" . $name;
- return $logger->$func;
+ return Log::Log4perl->get_logger($package)->$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:
+two 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.
@@ -148,9 +112,6 @@
my $config = shift;
my %options = @_;
- my %foo;
- my $ref = \%foo;
-
my $watch_delay = 0;
if ( exists( $options{'watch_delay'} ) ) {
if ( $options{'watch_delay'} ) {
@@ -164,116 +125,23 @@
} 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);
}
- }
+ else {
+ my $default_config = q(
+ log4perl.rootLogger=DEBUG, LOG
- $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) = @_;
-
- local $SIG{CHLD} = 'DEFAULT'; # Some log backends spawn processes, and
- # don't play nicely unless we do this.
-
- 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() };
+ log4perl.appender.LOG=Log::Log4perl::Appender::ScreenColoredLevels
+ log4perl.appender.LOG.layout=PatternLayout
+ log4perl.appender.LOG.layout.ConversionPattern=%d{yyyy-MM-dd HH:mm:ss} [%5P] %20c{2} [%5L]: %5p - %m%n
+ );
+ Log::Log4perl::init(\$default_config);
}
-
- # 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};
+ return bless {}, $self;
}
+
=item debug($message)
Passes it's arguments to $logger->debug.
@@ -390,6 +258,8 @@
Tomas Doran (t0m) C<bobtfish at bobtfish.net> (Current maintainer)
+Martyn Smith (Ned) C<martyn at shoptime.co.nz> (Heavy refactoring)
+
=head1 COPYRIGHT
Copyright (c) 2005 - 2009
More information about the Catalyst-commits
mailing list