File Coverage

blib/lib/Object/Remote/Logging/Logger.pm

Criterion	Covered	Total	%
statement	70	75	93.3
branch	14	18	77.7
condition	2	3	66.6
subroutine	16	19	84.2
pod	0	1	0.0
total	102	116	87.9

package Object::Remote::Logging::Logger;

use Moo;
use Carp qw(croak);

#TODO sigh invoking a logger with a log level name the same
#as an attribute could happen - restrict attributes to _ prefix
#and restrict log levels to not start with out that prefix?
has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
has level_names => ( is => 'ro', required => 1 );
has min_level => ( is => 'ro', required => 1, default => sub { 'info' } );
has max_level => ( is => 'lazy', required => 1 );
has _level_active => ( is => 'lazy' );

#just a stub so it doesn't get to AUTOLOAD
sub BUILD { }
sub DESTROY { }

sub AUTOLOAD {
  my $self = shift;
  (my $method) = (our $AUTOLOAD =~ /([^:]+)$/);

  no strict 'refs';

  if ($method =~ m/^_/) {
    croak "invalid method name $method for " . ref($self);
  }

  if ($method =~ m/^is_(.+)/) {
    my $level_name = $1;
    my $is_method = "is_$level_name";
    *{$is_method} = sub { shift(@_)->_level_active->{$level_name} };
    return $self->$is_method;
  }

  my $level_name = $method;
  *{$level_name} = sub {
    my $self = shift;
    unless(exists($self->_level_active->{$level_name})) {
      croak "$level_name is not a valid log level name";
    }

    $self->_log($level_name, @_);
  };

  return $self->$level_name(@_);
}

sub _build_max_level {
  my ($self) = @_;
  return $self->level_names->[-1];
}

sub _build__level_active {
  my ($self) = @_;
  my $should_log = 0;
  my $min_level = $self->min_level;
  my $max_level = $self->max_level;
  my %active;

  foreach my $level (@{$self->level_names}) {
    if($level eq $min_level) {
      $should_log = 1;
    }

    $active{$level} = $should_log;

    if (defined $max_level && $level eq $max_level) {
      $should_log = 0;
    }
  }

  return \%active;
}

sub _log {
  my ($self, $level, $content, $metadata_in) = @_;
  my %metadata = %$metadata_in;
  my $rendered = $self->_render($level, \%metadata, @$content);
  $self->_output($rendered);
}

sub _create_format_lookup {
  my ($self, $level, $metadata, $content) = @_;
  my $method = $metadata->{method};

  $method = '(none)' unless defined $method;

  return {
    '%' => '%', 'n' => "\n",
    t => $self->_render_time($metadata->{timestamp}),
    r => $self->_render_remote($metadata->{object_remote}),
    s => $self->_render_log(@$content), l => $level,
    c => $metadata->{exporter}, p => $metadata->{caller_package}, m => $method,
    f => $metadata->{filename}, i => $metadata->{line},
    h => $metadata->{hostname}, P => $metadata->{pid},
  };
}

sub _get_format_var_value {
  my ($self, $name, $data) = @_;
  my $val = $data->{$name};
  return $val if defined $val;
  return '(undefined)';
}

sub _render_time {
  my ($self, $time) = @_;
  return scalar(localtime($time));
}

sub _render_remote {
  my ($self, $remote) = @_;
  return 'local' unless defined $remote;
  my $conn_id = $remote->{connection_id};
  $conn_id = '(uninit)' unless defined $conn_id;
  return "remote #$conn_id";
}

sub _render_log {
  my ($self, @content) = @_;
  return join('', @content);
}
sub _render {
  my ($self, $level, $metadata, @content) = @_;
  my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
  my $template = $self->format;

  $template =~ s/%([\w%])/$self->_get_format_var_value($1, $var_table)/ge;

  chomp($template);
  $template =~ s/\n/\n /g;
  $template .= "\n";
  return $template;
}

sub _output {
  my ($self, $content) = @_;
  print STDERR $content;
}

1;

__END__