lib/Object/Remote/Logging.pm

   1 package Object::Remote::Logging;
   2
   3 use Moo;
   4 use Scalar::Util qw(blessed);
   5 use Object::Remote::Logging::Logger;
   6 use Exporter::Declare;
   7 use Carp qw(carp croak);
   8
   9 extends 'Log::Contextual';
  10
  11 exports(qw( ____ router arg_levels ));
  12 #exception log - log a message then die with that message
  13 export_tag elog => ('____');
  14 #fatal log - log a message then call exit(1)
  15 export_tag flog => ('____');
  16
  17 sub router {
  18   our $Router_Instance ||= do {
  19     require Object::Remote::Logging::Router;
  20     Object::Remote::Logging::Router->new;
  21   }
  22 }
  23
  24 #log level descriptions
  25 #info - standard log level - normal program output for the end user
  26 #warn - output for program that is executing quietly
  27 #error - output for program that is running more quietly
  28 #fatal - it is not possible to continue execution; this level is as quiet as is possible
  29 #verbose - output for program executing verbosely (-v)
  30 #debug - output for program running more verbosely (-v -v)
  31 #trace - output for program running extremely verbosely (-v -v -v)
  32 sub arg_levels {
  33   #the order of the log levels is significant with the
  34   #most verbose level being first in the list and the
  35   #most quiet as the last item
  36   return [qw( trace debug verbose info warn error fatal )];
  37 }
  38
  39 sub before_import {
  40    my ($class, $importer, $spec) = @_;
  41    my $router = $class->router;
  42
  43    $class->SUPER::before_import($importer, $spec);
  44
  45    my @levels = @{$class->arg_levels($spec->config->{levels})};
  46    for my $level (@levels) {
  47       if ($spec->config->{elog}) {
  48          $spec->add_export("&Elog_$level", sub (&) {
  49             my ($code, @args) = @_;
  50             $router->handle_log_request({
  51                controller => $class,
  52                package => scalar(caller),
  53                caller_level => 1,
  54                level => $level,
  55             }, $code);
  56             #TODO this should get fed into a logger so it can be formatted
  57             croak $code->();
  58          });
  59       }
  60       if ($spec->config->{flog}) {
  61          #TODO that prototype isn't right
  62          $spec->add_export("&Flog_$level", sub (&@) {
  63             my ($code, $exit_value) = @_;
  64             $exit_value = 1 unless defined $exit_value;
  65             $router->handle_log_request({
  66                controller => $class,
  67                package => scalar(caller),
  68                caller_level => 1,
  69                level => $level,
  70             }, $code);
  71             #TODO this should get fed into a logger so it can be formatted
  72             carp $code->();
  73             exit($exit_value);
  74          });
  75       }
  76    }
  77 }
  78
  79 #this is invoked on all nodes
  80 sub init_logging {
  81   my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL};
  82   my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT};
  83   #TODO allow the selections value to be * so it selects everything
  84   my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS};
  85   my %controller_should_log;
  86
  87   return unless defined $level;
  88   $format = "[%l %r] %s" unless defined $format;
  89   $selections = __PACKAGE__ unless defined $selections;
  90   %controller_should_log = map { $_ => 1 } split(' ', $selections);
  91
  92   my $logger = Object::Remote::Logging::Logger->new(
  93     min_level => lc($level), format => $format,
  94     level_names => Object::Remote::Logging::arg_levels(),
  95   );
  96
  97   router()->connect(sub {
  98     my $controller = $_[1]->{controller};
  99     return unless  $controller_should_log{'*'} || $controller_should_log{$controller};
 100     #skip things from remote hosts because they log to STDERR
 101     #when OBJECT_REMOTE_LOG_LEVEL is in effect
 102     return if $_[1]->{remote}->{connection_id};
 103     $logger
 104   });
 105 }
 106
 107 #this is invoked by the controlling node
 108 #on the remote nodes
 109 sub init_logging_forwarding {
 110   my ($self, %controller_info) = @_;
 111
 112   router()->_remote_metadata({ connection_id => $controller_info{connection_id} });
 113   router()->_forward_destination($controller_info{router}) if $ENV{OBJECT_REMOTE_LOG_FORWARDING};
 114 }
 115
 116 1;
 117