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
   8 sub before_import { }
   9
  10 sub after_import {
  11    my ($self, $controller, $importer, $spec) = @_;
  12    my $config = $spec->config;
  13
  14    if (my $l = $controller->arg_logger($config->{logger})) {
  15       $self->set_logger($l)
  16    }
  17
  18    if (my $l = $controller->arg_package_logger($config->{package_logger})) {
  19       $self->_set_package_logger_for($importer, $l)
  20    }
  21
  22    if (my $l = $controller->arg_default_logger($config->{default_logger})) {
  23       $self->_set_default_logger_for($importer, $l)
  24    }
  25 }
  26
  27 sub with_logger {
  28    my $logger = $_[1];
  29    if(ref $logger ne 'CODE') {
  30       die 'logger was not a CodeRef or a logger object.  Please try again.'
  31          unless blessed($logger);
  32       $logger = do { my $l = $logger; sub { $l } }
  33    }
  34    local $_[0]->{Get_Logger} = $logger;
  35    $_[2]->();
  36 }
  37
  38 sub set_logger {
  39    my $logger = $_[1];
  40    if(ref $logger ne 'CODE') {
  41       die 'logger was not a CodeRef or a logger object.  Please try again.'
  42          unless blessed($logger);
  43       $logger = do { my $l = $logger; sub { $l } }
  44    }
  45
  46    warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
  47       if $_[0]->{Get_Logger};
  48    $_[0]->{Get_Logger} = $logger;
  49
  50 }
  51
  52 sub _set_default_logger_for {
  53    my $logger = $_[2];
  54    if(ref $logger ne 'CODE') {
  55       die 'logger was not a CodeRef or a logger object.  Please try again.'
  56          unless blessed($logger);
  57       $logger = do { my $l = $logger; sub { $l } }
  58    }
  59    $_[0]->{Default_Logger}->{$_[1]} = $logger
  60 }
  61
  62 sub _set_package_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]->{Package_Logger}->{$_[1]} = $logger
  70 }
  71
  72 sub get_loggers {
  73    my ($self, $package, $level) = @_;
  74    my $logger = (
  75       $_[0]->{Package_Logger}->{$package} ||
  76       $_[0]->{Get_Logger} ||
  77       $_[0]->{Default_Logger}->{$package} ||
  78       die q( no logger set!  you can't try to log something without a logger! )
  79    );
  80
  81    $logger = $logger->($package, { caller_level => 2 });
  82
  83    return $logger if $logger->${\"is_$level"};
  84    return ();
  85 }
  86
  87 1;
  88