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 sub before_import { }
  17
  18 sub after_import {
  19    my ($self, %import_info) = @_;
  20    my $exporter = $import_info{exporter};
  21    my $target = $import_info{target};
  22    my $config = $import_info{arguments};
  23
  24    if (my $l = $exporter->arg_logger($config->{logger})) {
  25       $self->set_logger($l);
  26    }
  27
  28    if (my $l = $exporter->arg_package_logger($config->{package_logger})) {
  29       $self->_set_package_logger_for($target, $l);
  30    }
  31
  32    if (my $l = $exporter->arg_default_logger($config->{default_logger})) {
  33       $self->_set_default_logger_for($target, $l);
  34    }
  35 }
  36
  37 sub with_logger {
  38    my $logger = $_[1];
  39    if(ref $logger ne 'CODE') {
  40       die 'logger was not a CodeRef or a logger object.  Please try again.'
  41          unless blessed($logger);
  42       $logger = do { my $l = $logger; sub { $l } }
  43    }
  44    local $_[0]->{Get_Logger} = $logger;
  45    $_[2]->();
  46 }
  47
  48 sub set_logger {
  49    my $logger = $_[1];
  50    if(ref $logger ne 'CODE') {
  51       die 'logger was not a CodeRef or a logger object.  Please try again.'
  52          unless blessed($logger);
  53       $logger = do { my $l = $logger; sub { $l } }
  54    }
  55
  56    warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
  57       if $_[0]->{Get_Logger};
  58    $_[0]->{Get_Logger} = $logger;
  59
  60 }
  61
  62 sub _set_default_logger_for {
  63    my $logger = $_[2];
  64    if(ref $logger ne 'CODE') {
  65       die 'logger was not a CodeRef or a logger object.  Please try again.'
  66          unless blessed($logger);
  67       $logger = do { my $l = $logger; sub { $l } }
  68    }
  69    $_[0]->{Default_Logger}->{$_[1]} = $logger
  70 }
  71
  72 sub _set_package_logger_for {
  73    my $logger = $_[2];
  74    if(ref $logger ne 'CODE') {
  75       die 'logger was not a CodeRef or a logger object.  Please try again.'
  76          unless blessed($logger);
  77       $logger = do { my $l = $logger; sub { $l } }
  78    }
  79    $_[0]->{Package_Logger}->{$_[1]} = $logger
  80 }
  81
  82 sub get_loggers {
  83    my ($self, %info) = @_;
  84    my $package = $info{caller_package};
  85    my $log_level = $info{message_level};
  86    my $logger = (
  87       $_[0]->{Package_Logger}->{$package} ||
  88       $_[0]->{Get_Logger} ||
  89       $_[0]->{Default_Logger}->{$package} ||
  90       die q( no logger set!  you can't try to log something without a logger! )
  91    );
  92
  93    $info{caller_level}++;
  94    $logger = $logger->($package, \%info);
  95
  96    return $logger if $logger->${\"is_${log_level}"};
  97    return ();
  98 }
  99
 100 sub handle_log_request {
 101    my ($self, %message_info) = @_;
 102    my $generator = $message_info{message_sub};
 103    my $args = $message_info{message_args};
 104    my $log_level = $message_info{message_level};
 105
 106    $message_info{caller_level}++;
 107
 108    foreach my $logger ($self->get_loggers(%message_info)) {
 109       $logger->$log_level($generator->(@$args));
 110    }
 111 }
 112
 113 1;
 114