logger adapters namespace was changed

This commit is contained in:
Denis Fedoseev 2023-03-17 18:29:38 +03:00
parent 10b060dda8
commit 262253d670
12 changed files with 139 additions and 99 deletions

View file

@ -2,27 +2,35 @@ package Log::Mini;
use strict; use strict;
use warnings; use warnings;
use Module::Load qw/load/;
our $VERSION = "0.2.1"; require Carp;
sub new { our $VERSION = "0.3.0";
sub new
{
shift; shift;
my ( $type, @args ) = @_; my ($type, @args) = @_;
@args = () unless @args;
$type = 'stderr' unless defined $type; $type = 'stderr' unless defined $type;
if ( $type eq 'file' ) { if ($type eq 'file') {
require Log::Mini::LoggerFILE; unshift(@args, $type);
return Log::Mini::LoggerFILE->new(@_);
}
elsif ( $type eq 'null' ) {
require Log::Mini::LoggerNULL;
return Log::Mini::LoggerNULL->new(@args);
}
else {
require Log::Mini::LoggerSTDERR;
return Log::Mini::LoggerSTDERR->new(@args);
} }
my $module_name = sprintf('Log::Mini::Logger::%s', uc($type));
my $logger;
eval {
load $module_name;
$logger = $module_name->new(@args);
} or do { Carp::croak(sprintf("Failed to load adapter: %s, %s\n", $type, $@)) };
return $logger;
} }
1; 1;

View file

@ -1,4 +1,4 @@
package Log::Mini::LoggerBase; package Log::Mini::Logger::Base;
use strict; use strict;
use warnings; use warnings;
@ -7,6 +7,7 @@ use Carp qw(croak);
use List::Util qw(first); use List::Util qw(first);
use Time::Moment; use Time::Moment;
my $LEVELS = { my $LEVELS = {
error => 1, error => 1,
warn => 2, warn => 2,
@ -15,9 +16,8 @@ my $LEVELS = {
trace => 5 trace => 5
}; };
sub new { sub new
{
# say STDERR Dumper(\@_);
my $class = shift; my $class = shift;
my (%params) = @_; my (%params) = @_;
@ -29,39 +29,42 @@ sub new {
return $self; return $self;
} }
sub set_level { sub set_level
{
my $self = shift; my $self = shift;
my ($new_level) = @_; my ($new_level) = @_;
croak('Unknown log level') croak('Unknown log level')
unless first { $new_level eq $_ } keys %$LEVELS; unless $LEVELS->{$new_level};
$self->{'level'} = $new_level; $self->{'level'} = $new_level;
return; return;
} }
sub level { sub level
{
my $self = shift; my $self = shift;
return $self->{level} || 'error'; return $self->{level} || 'error';
} }
sub log { return shift->_log( shift, @_) } sub log { return shift->_log(shift, @_) }
sub info { return shift->_log( 'info', @_ ) } sub info { return shift->_log('info', @_) }
sub error { return shift->_log( 'error', @_ ) } sub error { return shift->_log('error', @_) }
sub warn { return shift->_log( 'warn', @_ ) } sub warn { return shift->_log('warn', @_) }
sub debug { return shift->_log( 'debug', @_ ) } sub debug { return shift->_log('debug', @_) }
sub trace { return shift->_log( 'trace', @_ ) } sub trace { return shift->_log('trace', @_) }
sub _log { sub _log
{
my $self = shift; my $self = shift;
my $level = shift; my $level = shift;
my $message = shift; my $message = shift;
return if $LEVELS->{$level} > $LEVELS->{ $self->{'level'} }; return if $LEVELS->{$level} > $LEVELS->{$self->{'level'}};
my $time = Time::Moment->now->strftime('%Y-%m-%d %T%3f'); my $time = $self->_getCurrentTime();
my $text = sprintf("%s [%s] %s\n", $time, $level, $message); my $text = sprintf("%s [%s] %s\n", $time, $level, $message);
$text = sprintf($text, @_) if (@_); $text = sprintf($text, @_) if (@_);
@ -73,4 +76,9 @@ sub _log {
sub _print { croak 'Not implemented!' } sub _print { croak 'Not implemented!' }
sub _getCurrentTime
{
return Time::Moment->now->strftime('%Y-%m-%d %T%3f');
}
1; 1;

View file

@ -1,13 +1,13 @@
package Log::Mini::LoggerFILE; package Log::Mini::Logger::FILE;
use strict; use strict;
use warnings; use warnings;
use IO::Handle; use IO::Handle;
use base 'Log::Mini::Logger::Base';
use base 'Log::Mini::LoggerBase'; sub new
{
sub new {
my $self = shift->SUPER::new(@_); my $self = shift->SUPER::new(@_);
my (%params) = @_; my (%params) = @_;
@ -24,16 +24,18 @@ sub new {
return $self; return $self;
} }
sub _print { sub _print
{
my $self = shift; my $self = shift;
my $fh = $self->{fh}; my $fh = $self->{fh};
print $fh @_; print $fh @_;
} }
sub DESTROY
sub DESTROY { {
close shift->{'fh'}; close shift->{'fh'};
return; return;
} }
1; 1;

View file

@ -0,0 +1,12 @@
package Log::Mini::Logger::NULL;
use strict;
use warnings;
use base 'Log::Mini::Logger::Base';
sub _log {
return;
}
1;

View file

@ -0,0 +1,13 @@
package Log::Mini::Logger::STDERR;
use strict;
use warnings;
use base 'Log::Mini::Logger::Base';
sub _print
{
print STDERR $_[1];
}
1;

View file

@ -1,12 +0,0 @@
package Log::Mini::LoggerNULL;
use strict;
use warnings;
use base 'Log::Mini::LoggerBase';
sub _log {
return;
}
1;

View file

@ -1,12 +0,0 @@
package Log::Mini::LoggerSTDERR;
use strict;
use warnings;
use base 'Log::Mini::LoggerBase';
sub _print {
print STDERR $_[1];
}
1;

View file

@ -7,28 +7,37 @@ use Test::Fatal;
use File::Temp; use File::Temp;
use Log::Mini; use Log::Mini;
subtest 'creates stderr logger' => sub { subtest 'creates stderr logger' => sub {
my $logger = Log::Mini->new('stderr'); my $logger = Log::Mini->new('stderr');
isa_ok $logger, 'Log::Mini::LoggerSTDERR'; isa_ok $logger, 'Log::Mini::Logger::STDERR';
}; };
subtest 'creates null logger' => sub { subtest 'creates null logger' => sub {
my $logger = Log::Mini->new('null'); my $logger = Log::Mini->new('null');
isa_ok $logger, 'Log::Mini::LoggerNULL'; isa_ok $logger, 'Log::Mini::Logger::NULL';
}; };
subtest 'creates file logger' => sub { subtest 'creates file logger' => sub {
my $file = File::Temp->new; my $file = File::Temp->new;
my $logger = Log::Mini->new('file' => $file->filename); my $logger = Log::Mini->new('file' => $file->filename);
isa_ok $logger, 'Log::Mini::LoggerFILE'; isa_ok $logger, 'Log::Mini::Logger::FILE';
}; };
subtest 'return STDERR on unknown logger' => sub { subtest 'return STDERR on no logger name given' => sub {
my $logger = Log::Mini->new('unknown'); my $logger = Log::Mini->new();
isa_ok $logger, 'Log::Mini::LoggerSTDERR'; isa_ok $logger, 'Log::Mini::Logger::STDERR';
};
subtest 'throw on unknown logger adapter' => sub {
like(
exception { Log::Mini->new('unknown'); },
qr/^Failed to load adapter: unknown, .*/,
"the code died on unknown adapter",
);
}; };
done_testing; done_testing;

View file

@ -5,6 +5,7 @@ use warnings;
use Test::More; use Test::More;
use Test::Fatal; use Test::Fatal;
subtest 'creates correct object' => sub { subtest 'creates correct object' => sub {
isa_ok(LoggerTest->new, 'LoggerTest'); isa_ok(LoggerTest->new, 'LoggerTest');
}; };
@ -26,7 +27,7 @@ subtest 'sets log level' => sub {
subtest 'not throws when known log level' => sub { subtest 'not throws when known log level' => sub {
my $log = LoggerTest->new; my $log = LoggerTest->new;
for my $level (qw/error warn debug/) { for my $level (qw/error warn debug info trace/) {
ok !exception { $log->set_level($level) }; ok !exception { $log->set_level($level) };
} }
}; };
@ -41,15 +42,15 @@ subtest 'prints formatted line' => sub {
my $output = []; my $output = [];
my $log = _build_logger(output => $output); my $log = _build_logger(output => $output);
for my $level (qw/error warn debug/) { for my $level (qw/error warn debug info trace/) {
$log->set_level($level);
$log->$level('message'); $log->$level('message');
like $output->[-1], like $output->[-1], qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d.\d{3} \[$level\] message/;
qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d.\d{3} \[$level\] message/;
} }
}; };
subtest 'logs when level is higher' => sub { subtest 'log all suitable levels' => sub {
my $output = []; my $output = [];
my $log = _build_logger(output => $output); my $log = _build_logger(output => $output);
@ -76,8 +77,10 @@ subtest 'not logs when level is lower' => sub {
my $log = _build_logger(output => $output); my $log = _build_logger(output => $output);
my $levels = { my $levels = {
error => [qw/warn debug/], error => [qw/warn info debug trace/],
warn => [qw/debug/], warn => [qw/info debug trace/],
info => [qw/debug trace/],
debug => [qw/trace/],
}; };
for my $level (keys %$levels) { for my $level (keys %$levels) {
@ -90,7 +93,8 @@ subtest 'not logs when level is lower' => sub {
} }
}; };
sub _build_logger { sub _build_logger
{
my $logger = LoggerTest->new(@_); my $logger = LoggerTest->new(@_);
$logger->set_level('debug'); $logger->set_level('debug');
return $logger; return $logger;
@ -99,9 +103,10 @@ sub _build_logger {
done_testing; done_testing;
package LoggerTest; package LoggerTest;
use base 'Log::Mini::LoggerBase'; use base 'Log::Mini::Logger::Base';
sub new { sub new
{
my $self = shift->SUPER::new(@_); my $self = shift->SUPER::new(@_);
my (%params) = @_; my (%params) = @_;
@ -110,7 +115,8 @@ sub new {
return $self; return $self;
} }
sub _print { sub _print
{
my $self = shift; my $self = shift;
push @{$self->{output}}, @_; push @{$self->{output}}, @_;

View file

@ -5,11 +5,11 @@ use warnings;
use Test::More; use Test::More;
use Test::Fatal; use Test::Fatal;
use File::Temp; use File::Temp;
use Log::Mini::LoggerFILE; use Log::Mini::Logger::FILE;
subtest 'creates correct object' => sub { subtest 'creates correct object' => sub {
isa_ok(Log::Mini::LoggerFILE->new, 'Log::Mini::LoggerFILE'); isa_ok(Log::Mini::Logger::FILE->new, 'Log::Mini::Logger::FILE');
}; };
subtest 'prints to file' => sub { subtest 'prints to file' => sub {
@ -79,7 +79,7 @@ sub _slurp {
} }
sub _build_logger { sub _build_logger {
my $logger = Log::Mini::LoggerFILE->new(@_); my $logger = Log::Mini::Logger::FILE->new(@_);
$logger->set_level('debug'); $logger->set_level('debug');
return $logger; return $logger;
} }

View file

@ -5,10 +5,11 @@ use warnings;
use Test::More; use Test::More;
use Test::Fatal; use Test::Fatal;
use Capture::Tiny qw(capture_stderr); use Capture::Tiny qw(capture_stderr);
use Log::Mini::LoggerSTDERR; use Log::Mini::Logger::STDERR;
subtest 'creates correct object' => sub { subtest 'creates correct object' => sub {
isa_ok(Log::Mini::LoggerSTDERR->new, 'Log::Mini::LoggerSTDERR'); isa_ok(Log::Mini::Logger::STDERR->new, 'Log::Mini::Logger::STDERR');
}; };
subtest 'prints to stderr' => sub { subtest 'prints to stderr' => sub {
@ -50,7 +51,7 @@ subtest 'prints sprintf formatted line' => sub {
}; };
sub _build_logger { sub _build_logger {
my $logger = Log::Mini::LoggerSTDERR->new; my $logger = Log::Mini::Logger::STDERR->new;
$logger->set_level('debug'); $logger->set_level('debug');
return $logger; return $logger;
} }

View file

@ -8,15 +8,20 @@ use File::Temp;
use Log::Mini; use Log::Mini;
subtest 'creates correct object Logger::FILE' => sub {
subtest 'creates correct object LoggerFILE' => sub {
my $file = File::Temp->new; my $file = File::Temp->new;
isa_ok(Log::Mini->new( file => $file->filename), 'Log::Mini::LoggerFILE'); isa_ok(Log::Mini->new(file => $file->filename), 'Log::Mini::Logger::FILE');
isa_ok(Log::Mini::Logger::FILE->new(file => $file->filename), 'Log::Mini::Logger::FILE');
}; };
subtest 'creates correct object LoggerSTDERR' => sub { subtest 'creates correct object Logger::STDERR' => sub {
isa_ok(Log::Mini->new('stderr', level => 'debug'), 'Log::Mini::LoggerSTDERR'); isa_ok(Log::Mini->new('stderr', level => 'debug'), 'Log::Mini::Logger::STDERR');
isa_ok(Log::Mini::LoggerSTDERR->new(level => 'debug'), 'Log::Mini::LoggerSTDERR'); isa_ok(Log::Mini::Logger::STDERR->new(level => 'debug'), 'Log::Mini::Logger::STDERR');
};
subtest 'creates correct object Logger::NULL' => sub {
isa_ok(Log::Mini->new('null', level => 'debug'), 'Log::Mini::Logger::NULL');
isa_ok(Log::Mini::Logger::NULL->new(level => 'debug'), 'Log::Mini::Logger::NULL');
}; };
done_testing; done_testing;