128 lines
3.0 KiB
Perl
128 lines
3.0 KiB
Perl
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
package Zonemaster::Backend::Log;
|
||
|
|
|
||
|
|
use English qw( $PID );
|
||
|
|
use POSIX;
|
||
|
|
use JSON::PP;
|
||
|
|
use IO::Handle;
|
||
|
|
use Log::Any::Adapter::Util ();
|
||
|
|
use Carp;
|
||
|
|
use Data::Dumper;
|
||
|
|
|
||
|
|
use base qw(Log::Any::Adapter::Base);
|
||
|
|
|
||
|
|
|
||
|
|
my $default_level = Log::Any::Adapter::Util::numeric_level('info');
|
||
|
|
|
||
|
|
sub init {
|
||
|
|
my ($self) = @_;
|
||
|
|
|
||
|
|
if ( defined $self->{log_level} && $self->{log_level} =~ /\D/ ) {
|
||
|
|
$self->{log_level} = lc $self->{log_level};
|
||
|
|
my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
|
||
|
|
if ( !defined($numeric_level) ) {
|
||
|
|
croak "Error: Unrecognized log level " . $self->{log_level} . "\n";
|
||
|
|
}
|
||
|
|
$self->{log_level} = $numeric_level;
|
||
|
|
}
|
||
|
|
|
||
|
|
$self->{log_level} //= $default_level;
|
||
|
|
|
||
|
|
my $fd;
|
||
|
|
if ( !exists $self->{file} || $self->{file} eq '-') {
|
||
|
|
if ( $self->{stderr} ) {
|
||
|
|
$fd = fileno(STDERR);
|
||
|
|
} else {
|
||
|
|
$fd = fileno(STDOUT);
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
open( $fd, '>>', $self->{file} ) or croak "Can't open log file: $!";
|
||
|
|
}
|
||
|
|
|
||
|
|
$self->{handle} = IO::Handle->new_from_fd( $fd, "w" ) or croak "Can't fdopen file: $!";
|
||
|
|
$self->{handle}->autoflush(1);
|
||
|
|
|
||
|
|
if ( !exists $self->{formatter} ) {
|
||
|
|
if ( $self->{json} ) {
|
||
|
|
$self->{formatter} = \&format_json;
|
||
|
|
} else {
|
||
|
|
$self->{formatter} = \&format_text;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_text {
|
||
|
|
my ($self, $log_params) = @_;
|
||
|
|
my $msg;
|
||
|
|
$msg .= sprintf "%s ", $log_params->{timestamp};
|
||
|
|
delete $log_params->{timestamp};
|
||
|
|
$msg .= sprintf(
|
||
|
|
"[%d] [%s] [%s] %s",
|
||
|
|
delete $log_params->{pid},
|
||
|
|
uc delete $log_params->{level},
|
||
|
|
delete $log_params->{category},
|
||
|
|
delete $log_params->{message}
|
||
|
|
);
|
||
|
|
|
||
|
|
if ( %$log_params ) {
|
||
|
|
local $Data::Dumper::Indent = 0;
|
||
|
|
local $Data::Dumper::Terse = 1;
|
||
|
|
my $data = Dumper($log_params);
|
||
|
|
|
||
|
|
$msg .= " Extra parameters: $data";
|
||
|
|
}
|
||
|
|
|
||
|
|
return $msg
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_json {
|
||
|
|
my ($self, $log_params) = @_;
|
||
|
|
|
||
|
|
my $js = JSON::PP->new;
|
||
|
|
$js->canonical( 1 );
|
||
|
|
|
||
|
|
return $js->encode( $log_params );
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub structured {
|
||
|
|
my ($self, $level, $category, $string, @items) = @_;
|
||
|
|
|
||
|
|
my $log_level = Log::Any::Adapter::Util::numeric_level($level);
|
||
|
|
|
||
|
|
return if $log_level > $self->{log_level};
|
||
|
|
|
||
|
|
my %log_params = (
|
||
|
|
timestamp => strftime( "%FT%TZ", gmtime ),
|
||
|
|
level => $level,
|
||
|
|
category => $category,
|
||
|
|
message => $string,
|
||
|
|
pid => $PID,
|
||
|
|
);
|
||
|
|
|
||
|
|
for my $item ( @items ) {
|
||
|
|
if (ref($item) eq 'HASH') {
|
||
|
|
for my $key (keys %$item) {
|
||
|
|
$log_params{$key} = $item->{$key};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my $msg = $self->{formatter}->($self, \%log_params);
|
||
|
|
$self->{handle}->print($msg . "\n");
|
||
|
|
}
|
||
|
|
|
||
|
|
# From Log::Any::Adapter::File
|
||
|
|
foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
|
||
|
|
no strict 'refs';
|
||
|
|
my $base = substr($method,3);
|
||
|
|
my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
|
||
|
|
*{$method} = sub {
|
||
|
|
return !!( $method_level <= $_[0]->{log_level} );
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|