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