package Log::Contextual::Router;
use Moo;
use Scalar::Util 'blessed';
with 'Log::Contextual::Role::Router',
'Log::Contextual::Role::Router::SetLogger',
'Log::Contextual::Role::Router::WithLogger';
eval {
require Log::Log4perl;
die if $Log::Log4perl::VERSION < 1.29;
Log::Log4perl->wrapper_register(__PACKAGE__)
};
has _default_logger => (
is => 'ro',
default => sub { {} },
init_arg => undef,
);
has _package_logger => (
is => 'ro',
default => sub { {} },
init_arg => undef,
);
has _get_logger => (
is => 'ro',
default => sub { {} },
init_arg => undef,
);
sub before_import { }
sub after_import {
my ($self, %import_info) = @_;
my $exporter = $import_info{exporter};
my $target = $import_info{target};
my $config = $import_info{arguments};
if (my $l = $exporter->arg_logger($config->{logger})) {
$self->set_logger($l);
}
if (my $l = $exporter->arg_package_logger($config->{package_logger})) {
$self->_set_package_logger_for($target, $l);
}
if (my $l = $exporter->arg_default_logger($config->{default_logger})) {
$self->_set_default_logger_for($target, $l);
}
}
sub with_logger {
my $logger = $_[1];
if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
unless blessed($logger);
$logger = do {
my $l = $logger;
sub { $l }
}
}
local $_[0]->_get_logger->{l} = $logger;
$_[2]->();
}
sub set_logger {
my $logger = $_[1];
if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
unless blessed($logger);
$logger = do {
my $l = $logger;
sub { $l }
}
}
warn 'set_logger (or -logger) called more than once! This is a bad idea!'
if $_[0]->_get_logger->{l};
$_[0]->_get_logger->{l} = $logger;
}
sub _set_default_logger_for {
my $logger = $_[2];
if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
unless blessed($logger);
$logger = do {
my $l = $logger;
sub { $l }
}
}
$_[0]->_default_logger->{$_[1]} = $logger
}
sub _set_package_logger_for {
my $logger = $_[2];
if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
unless blessed($logger);
$logger = do {
my $l = $logger;
sub { $l }
}
}
$_[0]->_package_logger->{$_[1]} = $logger
}
sub get_loggers {
my ($self, %info) = @_;
my $package = $info{caller_package};
my $log_level = $info{message_level};
my $logger =
( $_[0]->_package_logger->{$package}
|| $_[0]->_get_logger->{l}
|| $_[0]->_default_logger->{$package}
|| die
q( no logger set! you can't try to log something without a logger! ));
$info{caller_level}++;
$logger = $logger->($package, \%info);
return $logger if $logger ->${\"is_${log_level}"};
return ();
}
sub handle_log_request {
my ($self, %message_info) = @_;
my $generator = $message_info{message_sub};
my $args = $message_info{message_args};
my $log_level = $message_info{message_level};
$message_info{caller_level}++;
foreach my $logger ($self->get_loggers(%message_info)) {
$logger->$log_level($generator->(@$args));
}
}
1;