X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogging%2FLogger.pm;h=16b278d87f3c0671fb95679fbf63c036018f7d51;hp=a073a4758e2a476372c2c480686d09c77c125289;hb=0fe333eb337345ecc842a14bf738b5db837936b0;hpb=c0b2df05c2f912c9ad4fb0642c95334564ca84ec diff --git a/lib/Object/Remote/Logging/Logger.pm b/lib/Object/Remote/Logging/Logger.pm index a073a47..16b278d 100644 --- a/lib/Object/Remote/Logging/Logger.pm +++ b/lib/Object/Remote/Logging/Logger.pm @@ -3,6 +3,7 @@ package Object::Remote::Logging::Logger; use Moo; use Scalar::Util qw(weaken); +has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } ); has level_names => ( is => 'ro', required => 1 ); has min_level => ( is => 'ro', required => 1 ); has max_level => ( is => 'ro' ); @@ -40,9 +41,9 @@ sub _install_methods { my ($self) = @_; my $should_log = 0; our $METHODS_INSTALLED = 1; - + no strict 'refs'; - + foreach my $level (@{$self->level_names}) { *{"is_$level"} = sub { shift(@_)->_level_active->{$level} }; *{$level} = sub { shift(@_)->_log($level, @_) }; @@ -51,26 +52,56 @@ sub _install_methods { sub _log { my ($self, $level, $content, $metadata_in) = @_; - #TODO this stinks but is backwards compatible with the original logger api my %metadata = %$metadata_in; my $rendered = $self->_render($level, \%metadata, @$content); $self->_output($rendered); } +sub _create_format_lookup { + my ($self, $level, $metadata, $content) = @_; + return { + '%' => '%', t => $self->_render_time($metadata->{timestamp}), + r => $self->_render_remote($metadata->{object_remote}), + s => $self->_render_log(@$content), l => $level, + p => $metadata->{package}, m => $metadata->{method}, + f => $metadata->{filename}, i => $metadata->{line}, + + }; +} + +sub _get_format_var_value { + my ($self, $name, $data) = @_; + my $val = $data->{$name}; + return $val if defined $val; + return ''; +} + +sub _render_time { + my ($self, $time) = @_; + return scalar(localtime($time)); +} + +sub _render_remote { + my ($self, $remote) = @_; + return 'local' if ! defined $remote || ! defined $remote->{connection_id}; + return 'remote #' . $remote->{connection_id}; +} + +sub _render_log { + my ($self, @content) = @_; + return join('', @content); +} sub _render { my ($self, $level, $metadata, @content) = @_; - my $rendered = "[$level] "; - my $remote_info = $metadata->{object_remote}; - - if ($remote_info) { - $rendered .= "[connection #$remote_info->{connection_id}] "; - } else { - $rendered .= "[local] "; - } - - $rendered .= join('', @content); - $rendered .= "\n" unless substr($rendered, -1) eq "\n"; - return $rendered; + 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 {