1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346
|
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__
=head1 NAME
Object::Remote::Logging::Logger - Format and output a log message
=head1 SYNOPSIS
use Object::Remote::Logging::Logger;
use Object::Remote::Logging qw( router arg_levels );
my $app_output = Object::Remote::Logging::Logger->new(
level_names => arg_levels, format => '%t %s',
min_level => 'verbose', max_level => 'info',
);
#Selector method can return 0 or more logger
#objects that will receive the messages
my $selector = sub {
my ($generating_package, $metadata) = @_;
return unless $metadata->{exporter} eq 'App::Logging::Subclass';
return $app_output;
};
#true value as second argument causes the selector
#to be stored with a weak reference
router->connect($selector, 1);
#disconnect the selector from the router
undef($selector);
#router will hold this logger forever
#and send it all log messages
router->connect(Object::Remote::Logging::Logger->new(
level_names => arg_levels, format => '%s at %f line %i, log level: %l'
min_level => 'warn', max_level => 'error',
));
=head1 DESCRIPTION
This class receives log messages from an instance of L<Object::Remote::Logging::Router>,
formats them according to configuration, and then outputs them to STDERR. In between
the router and the logger is a selector method which inspects the log message metadata
and can return 0 or more loggers that should receive the log message.
=head1 USAGE
A logger object receives the log messages that are generated and converts them to
formatted log entries then displays them to the end user. Each logger has a set
of active log levels and will only output a log entry if the log message is at
an active log level.
To gain access to the stream of log messages a connection is made to the log router.
A logger can directly connect to the router and receive an unfiltered stream of
log messages or a selector closure can be used instead. The selector will be executed
for each log message with the message metadata and returns a list of 0 or more loggers
that should receive the log message. When the selector is executed the first argument
is the name of the package that generated the log message and the second argument
is a hash reference containing the message metadata.
=head1 METADATA
The message metadata is a hash reference with the following keys:
=over 4
=item message_level
Name of the log level of the message.
=item exporter
Package name of the logging API that was used to generate the log message.
=item caller_package
Name of the package that generated the log message.
=item method
Name of the method the message was generated inside of.
=item timestamp
Unix time of the message generation.
=item pid
Process id of the Perl interpreter the message was generated in.
=item hostname
Hostname of the system where the message was generated.
=item filename
Name of the file the message was generated in.
=item line
Line of the source file the message was generated at.
=item object_remote
This is a reference to another hash that contains the Object::Remote
specific information. The keys are
=over 4
=item connection_id
If the log message was generated on a remote Perl interpreter then the
Object::Remote::Connection id of that interpreter will be available here.
=back
=back
=head1 ATTRIBUTES
=over 4
=item level_names
This is a required attribute. Must be an array ref with the list of log level names
in it. The list must be ordered with the lowest level as element 0 and the highest
level as the last element. There is no default value.
=item min_level
The lowest log level that will be output by the logger. There is no default value.
=item max_level
The highest log level that will be output by the logger. The default value is the
highest level present in level_names.
=item format
The printf style format string to use when rendering the log message. The following
sequences are significant:
=over 4
=item %l
Level name that the log message was generated at.
=item %s
Log message rendered into a string with a leading space before any additional lines in a
multiple line message.
=item %t
Time the log message was generated rendered into a string. The time value is taken from
the Perl interpreter that generated the log message; it is not the time that the logger
received the log message on the local interpreter if the log message was forwarded.
=item %r
Object::Remote connection information rendered into a string.
=item %c
Package name of the logging API that was used to generate the log message.
=item %p
Name of the package that generated the log message.
=item %m
Method name that generated the log message.
=item %f
Filename that the log message was generated in.
=item %i
Line number the log message was generated at.
=item %h
Hostname the log message was generated on.
=item %P
Process id of the Perl interpreter that generated the log message.
=item %%
A literal %.
=item %n
A newline.
=back
=back
|