env var OBJECT_REMOTE_LOG_SELECTIONS allows selection of 1 or more controller classes...
[scpubgit/Object-Remote.git] / lib / Object / Remote / Logging / Logger.pm
1 package Object::Remote::Logging::Logger;
2
3 use Moo;
4 use Scalar::Util qw(weaken);
5
6 has format => ( is => 'ro', required => 1, default => sub { '%l: %s' } );
7 has level_names => ( is => 'ro', required => 1 );
8 has min_level => ( is => 'ro', required => 1 );
9 has max_level => ( is => 'ro' );
10 has _level_active => ( is => 'lazy' );
11
12 sub BUILD {
13   my ($self) = @_;
14   our $METHODS_INSTALLED; 
15   $self->_install_methods unless $METHODS_INSTALLED;
16 }
17
18 sub _build__level_active {
19   my ($self) = @_; 
20   my $should_log = 0;
21   my $min_level = $self->min_level;
22   my $max_level = $self->max_level;
23   my %active;
24     
25   foreach my $level (@{$self->level_names}) {
26     if($level eq $min_level) {
27       $should_log = 1; 
28     }
29
30     $active{$level} = $should_log;
31         
32     if (defined $max_level && $level eq $max_level) {
33       $should_log = 0;
34     }
35   }
36
37   return \%active;
38 }
39
40 sub _install_methods {
41   my ($self) = @_;
42   my $should_log = 0;
43   our $METHODS_INSTALLED = 1;
44
45   no strict 'refs';
46
47   foreach my $level (@{$self->level_names}) {
48     *{"is_$level"} = sub { shift(@_)->_level_active->{$level} };
49     *{$level} = sub { shift(@_)->_log($level, @_) };
50   }
51 }
52
53 sub _log {
54   my ($self, $level, $content, $metadata_in) = @_;
55   my %metadata = %$metadata_in;
56   my $rendered = $self->_render($level, \%metadata, @$content);
57   $self->_output($rendered);
58 }
59
60 sub _create_format_lookup {
61   my ($self, $level, $metadata, $content) = @_;
62   my $method = $metadata->{method};
63   
64   $method = '(none)' unless defined $method;
65   
66   return { 
67     '%' => '%', t => $self->_render_time($metadata->{timestamp}),
68     r => $self->_render_remote($metadata->{object_remote}),
69     s => $self->_render_log(@$content), l => $level, 
70     c => $metadata->{controller}, p => $metadata->{package}, m => $method,
71     f => $metadata->{filename}, i => $metadata->{line},
72     
73   };
74 }
75
76 sub _get_format_var_value {
77   my ($self, $name, $data) = @_;
78   my $val = $data->{$name};
79   return $val if defined $val;
80   return '';
81 }
82
83 sub _render_time {
84   my ($self, $time) = @_;
85   return scalar(localtime($time));
86 }
87
88 sub _render_remote {
89   my ($self, $remote) = @_;
90   return 'local' if ! defined $remote || ! defined $remote->{connection_id};
91   return 'remote #' . $remote->{connection_id};
92 }
93
94 sub _render_log {
95   my ($self, @content) = @_;
96   return join('', @content);
97 }
98 sub _render {
99   my ($self, $level, $metadata, @content) = @_;
100   my $var_table = $self->_create_format_lookup($level, $metadata, [@content]);
101   my $template = $self->format;
102   
103   $template =~ s/%([\w])/$self->_get_format_var_value($1, $var_table)/ge;
104   
105   chomp($template);
106   $template =~ s/\n/\n /g;
107   $template .= "\n";
108   return $template;
109 }
110
111 sub _output {
112   my ($self, $content) = @_;
113   print STDERR $content;
114 }
115
116
117 1;
118