lib/Log/Contextual/Router.pm

   1 package Log::Contextual::Router;
   2
   3 use Moo;
   4 use Scalar::Util 'blessed';
   5
   6 with 'Log::Contextual::Role::Router',
   7   'Log::Contextual::Role::Router::SetLogger',
   8   'Log::Contextual::Role::Router::WithLogger';
   9
  10 eval {
  11    require Log::Log4perl;
  12    die if $Log::Log4perl::VERSION < 1.29;
  13    Log::Log4perl->wrapper_register(__PACKAGE__)
  14 };
  15
  16 has _default_logger => (
  17    is       => 'ro',
  18    default  => sub { {} },
  19    init_arg => undef,
  20 );
  21
  22 has _package_logger => (
  23    is       => 'ro',
  24    default  => sub { {} },
  25    init_arg => undef,
  26 );
  27
  28 has _get_logger => (
  29    is       => 'ro',
  30    default  => sub { {} },
  31    init_arg => undef,
  32 );
  33
  34 sub before_import { }
  35
  36 sub after_import {
  37    my ($self, %import_info) = @_;
  38    my $exporter = $import_info{exporter};
  39    my $target   = $import_info{target};
  40    my $config   = $import_info{arguments};
  41
  42    if (my $l = $exporter->arg_logger($config->{logger})) {
  43       $self->set_logger($l);
  44    }
  45
  46    if (my $l = $exporter->arg_package_logger($config->{package_logger})) {
  47       $self->_set_package_logger_for($target, $l);
  48    }
  49
  50    if (my $l = $exporter->arg_default_logger($config->{default_logger})) {
  51       $self->_set_default_logger_for($target, $l);
  52    }
  53 }
  54
  55 sub with_logger {
  56    my $logger = $_[1];
  57    if (ref $logger ne 'CODE') {
  58       die 'logger was not a CodeRef or a logger object.  Please try again.'
  59         unless blessed($logger);
  60       $logger = do {
  61          my $l = $logger;
  62          sub { $l }
  63         }
  64    }
  65    local $_[0]->_get_logger->{l} = $logger;
  66    $_[2]->();
  67 }
  68
  69 sub set_logger {
  70    my $logger = $_[1];
  71    if (ref $logger ne 'CODE') {
  72       die 'logger was not a CodeRef or a logger object.  Please try again.'
  73         unless blessed($logger);
  74       $logger = do {
  75          my $l = $logger;
  76          sub { $l }
  77         }
  78    }
  79
  80    warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
  81      if $_[0]->_get_logger->{l};
  82    $_[0]->_get_logger->{l} = $logger;
  83 }
  84
  85 sub _set_default_logger_for {
  86    my $logger = $_[2];
  87    if (ref $logger ne 'CODE') {
  88       die 'logger was not a CodeRef or a logger object.  Please try again.'
  89         unless blessed($logger);
  90       $logger = do {
  91          my $l = $logger;
  92          sub { $l }
  93         }
  94    }
  95    $_[0]->_default_logger->{$_[1]} = $logger
  96 }
  97
  98 sub _set_package_logger_for {
  99    my $logger = $_[2];
 100    if (ref $logger ne 'CODE') {
 101       die 'logger was not a CodeRef or a logger object.  Please try again.'
 102         unless blessed($logger);
 103       $logger = do {
 104          my $l = $logger;
 105          sub { $l }
 106         }
 107    }
 108    $_[0]->_package_logger->{$_[1]} = $logger
 109 }
 110
 111 sub get_loggers {
 112    my ($self, %info) = @_;
 113    my $package   = $info{caller_package};
 114    my $log_level = $info{message_level};
 115    my $logger =
 116      (     $_[0]->_package_logger->{$package}
 117         || $_[0]->_get_logger->{l}
 118         || $_[0]->_default_logger->{$package}
 119         || die
 120         q( no logger set!  you can't try to log something without a logger! ));
 121
 122    $info{caller_level}++;
 123    $logger = $logger->($package, \%info);
 124
 125    return $logger if $logger ->${\"is_${log_level}"};
 126    return ();
 127 }
 128
 129 sub handle_log_request {
 130    my ($self, %message_info) = @_;
 131    my $generator = $message_info{message_sub};
 132    my $args      = $message_info{message_args};
 133    my $log_level = $message_info{message_level};
 134
 135    $message_info{caller_level}++;
 136
 137    foreach my $logger ($self->get_loggers(%message_info)) {
 138       $logger->$log_level($generator->(@$args));
 139    }
 140 }
 141
 142 1;
 143