lib/Log/Contextual/Router.pm

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