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;