refactor_loggers #1
16 changed files with 166 additions and 123 deletions
4
.gitignore
vendored
4
.gitignore
vendored
|
@ -32,4 +32,6 @@ MYMETA.*
|
|||
|
||||
Log-Mini.iml
|
||||
Log-Mini.ipr
|
||||
Log-Mini.iws
|
||||
Log-Mini.iws
|
||||
|
||||
.idea/
|
3
Changes
3
Changes
|
@ -2,6 +2,9 @@ Revision history for Perl extension Log-Mini
|
|||
|
||||
{{$NEXT}}
|
||||
|
||||
0.3.0 2023-03-17T19:35:35Z
|
||||
- Adapter namespace changed
|
||||
|
||||
0.2.1 2019-04-18T20:57:59Z
|
||||
- Unused imports were removed
|
||||
|
||||
|
|
18
META.json
18
META.json
|
@ -4,7 +4,7 @@
|
|||
"Denis Fedoseev <denis.fedoseev@gmail.com>"
|
||||
],
|
||||
"dynamic_config" : 0,
|
||||
"generated_by" : "Minilla/v3.1.4, CPAN::Meta::Converter version 2.150010",
|
||||
"generated_by" : "Minilla/v3.1.21, CPAN::Meta::Converter version 2.150010",
|
||||
"license" : [
|
||||
"perl_5"
|
||||
],
|
||||
|
@ -35,7 +35,7 @@
|
|||
"requires" : {
|
||||
"Test::CPAN::Meta" : "0",
|
||||
"Test::MinimumVersion::Fast" : "0.04",
|
||||
"Test::PAUSE::Permissions" : "0.04",
|
||||
"Test::PAUSE::Permissions" : "0.07",
|
||||
"Test::Pod" : "1.41",
|
||||
"Test::Spellunker" : "v0.2.7"
|
||||
}
|
||||
|
@ -58,17 +58,15 @@
|
|||
},
|
||||
"release_status" : "unstable",
|
||||
"resources" : {
|
||||
"bugtracker" : {
|
||||
"web" : "https://github.com/alpha6/Log-Mini/issues"
|
||||
},
|
||||
"homepage" : "https://github.com/alpha6/Log-Mini",
|
||||
"repository" : {
|
||||
"type" : "git",
|
||||
"url" : "git://github.com/alpha6/Log-Mini.git",
|
||||
"web" : "https://github.com/alpha6/Log-Mini"
|
||||
"url" : "ssh://git@git.whataco.de:2221/medvedych/Log-Mini.git"
|
||||
}
|
||||
},
|
||||
"version" : "0.2.1",
|
||||
"x_serialization_backend" : "JSON::PP version 2.93",
|
||||
"version" : "0.3.0",
|
||||
"x_contributors" : [
|
||||
"Denis Fedoseev <denis@fedoseev.work>"
|
||||
],
|
||||
"x_serialization_backend" : "JSON::PP version 4.07",
|
||||
"x_static_install" : 1
|
||||
}
|
||||
|
|
|
@ -25,7 +25,7 @@ Log::Mini - It's a very simple logger which can log your messages to a file or S
|
|||
$logger->log('info', 'information message');
|
||||
|
||||
#Null logger - drops all messages to /dev/null
|
||||
my $logger = Log::Mini->new('null');
|
||||
my $logger = Log::Mini->new('null);
|
||||
$logger->error('Error message'); #Message will be dropped
|
||||
|
||||
# DESCRIPTION
|
||||
|
|
|
@ -2,27 +2,35 @@ package Log::Mini;
|
|||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Module::Load qw/load/;
|
||||
|
||||
our $VERSION = "0.2.1";
|
||||
require Carp;
|
||||
|
||||
sub new {
|
||||
our $VERSION = "0.3.0";
|
||||
|
||||
sub new
|
||||
{
|
||||
shift;
|
||||
my ( $type, @args ) = @_;
|
||||
my ($type, @args) = @_;
|
||||
|
||||
@args = () unless @args;
|
||||
|
||||
$type = 'stderr' unless defined $type;
|
||||
|
||||
if ( $type eq 'file' ) {
|
||||
require Log::Mini::LoggerFILE;
|
||||
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);
|
||||
if ($type eq 'file') {
|
||||
unshift(@args, $type);
|
||||
}
|
||||
|
||||
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,23 +1,23 @@
|
|||
package Log::Mini::LoggerBase;
|
||||
package Log::Mini::Logger::Base;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(croak);
|
||||
use Carp qw(croak);
|
||||
use List::Util qw(first);
|
||||
use Time::Moment;
|
||||
|
||||
|
||||
my $LEVELS = {
|
||||
error => 1,
|
||||
warn => 2,
|
||||
info => 3,
|
||||
debug => 4,
|
||||
trace => 5
|
||||
trace => 5,
|
||||
};
|
||||
|
||||
sub new {
|
||||
|
||||
# say STDERR Dumper(\@_);
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my (%params) = @_;
|
||||
|
||||
|
@ -29,48 +29,56 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub set_level {
|
||||
sub set_level
|
||||
{
|
||||
my $self = shift;
|
||||
my ($new_level) = @_;
|
||||
|
||||
croak('Unknown log level')
|
||||
unless first { $new_level eq $_ } keys %$LEVELS;
|
||||
unless $LEVELS->{$new_level};
|
||||
|
||||
$self->{'level'} = $new_level;
|
||||
|
||||
return;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub level {
|
||||
sub level
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{level} || 'error';
|
||||
}
|
||||
|
||||
sub log { return shift->_log( shift, @_) }
|
||||
sub info { return shift->_log( 'info', @_ ) }
|
||||
sub error { return shift->_log( 'error', @_ ) }
|
||||
sub warn { return shift->_log( 'warn', @_ ) }
|
||||
sub debug { return shift->_log( 'debug', @_ ) }
|
||||
sub trace { return shift->_log( 'trace', @_ ) }
|
||||
sub log { return shift->_log(shift, @_) }
|
||||
sub info { return shift->_log('info', @_) }
|
||||
sub error { return shift->_log('error', @_) }
|
||||
sub warn { return shift->_log('warn', @_) }
|
||||
sub debug { return shift->_log('debug', @_) }
|
||||
sub trace { return shift->_log('trace', @_) }
|
||||
|
||||
sub _log {
|
||||
my $self = shift;
|
||||
my $level = shift;
|
||||
sub _log
|
||||
{
|
||||
my $self = shift;
|
||||
my $level = 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);
|
||||
$text = sprintf($text, @_) if (@_);
|
||||
|
||||
$self->_print($text);
|
||||
|
||||
return;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub _print { croak 'Not implemented!' }
|
||||
|
||||
sub _getCurrentTime
|
||||
{
|
||||
return Time::Moment->now->strftime('%Y-%m-%d %T%3f');
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,13 +1,13 @@
|
|||
package Log::Mini::LoggerFILE;
|
||||
package Log::Mini::Logger::FILE;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Handle;
|
||||
|
||||
use base 'Log::Mini::Logger::Base';
|
||||
|
||||
use base 'Log::Mini::LoggerBase';
|
||||
|
||||
sub new {
|
||||
sub new
|
||||
{
|
||||
my $self = shift->SUPER::new(@_);
|
||||
my (%params) = @_;
|
||||
|
||||
|
@ -24,16 +24,18 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub _print {
|
||||
sub _print
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $fh = $self->{fh};
|
||||
print $fh @_;
|
||||
}
|
||||
|
||||
|
||||
sub DESTROY {
|
||||
sub DESTROY
|
||||
{
|
||||
close shift->{'fh'};
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
12
lib/Log/Mini/Logger/NULL.pm
Normal file
12
lib/Log/Mini/Logger/NULL.pm
Normal file
|
@ -0,0 +1,12 @@
|
|||
package Log::Mini::Logger::NULL;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use base 'Log::Mini::Logger::Base';
|
||||
|
||||
sub _log {
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
13
lib/Log/Mini/Logger/STDERR.pm
Normal file
13
lib/Log/Mini/Logger/STDERR.pm
Normal 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;
|
|
@ -1,12 +0,0 @@
|
|||
package Log::Mini::LoggerNULL;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use base 'Log::Mini::LoggerBase';
|
||||
|
||||
sub _log {
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,12 +0,0 @@
|
|||
package Log::Mini::LoggerSTDERR;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use base 'Log::Mini::LoggerBase';
|
||||
|
||||
sub _print {
|
||||
print STDERR $_[1];
|
||||
}
|
||||
|
||||
1;
|
|
@ -7,28 +7,37 @@ use Test::Fatal;
|
|||
use File::Temp;
|
||||
use Log::Mini;
|
||||
|
||||
|
||||
subtest 'creates stderr logger' => sub {
|
||||
my $logger = Log::Mini->new('stderr');
|
||||
|
||||
isa_ok $logger, 'Log::Mini::LoggerSTDERR';
|
||||
isa_ok $logger, 'Log::Mini::Logger::STDERR';
|
||||
};
|
||||
|
||||
subtest 'creates null logger' => sub {
|
||||
my $logger = Log::Mini->new('null');
|
||||
|
||||
isa_ok $logger, 'Log::Mini::LoggerNULL';
|
||||
isa_ok $logger, 'Log::Mini::Logger::NULL';
|
||||
};
|
||||
|
||||
subtest 'creates file logger' => sub {
|
||||
my $file = File::Temp->new;
|
||||
my $file = File::Temp->new;
|
||||
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 {
|
||||
my $logger = Log::Mini->new('unknown');
|
||||
isa_ok $logger, 'Log::Mini::LoggerSTDERR';
|
||||
subtest 'return STDERR on no logger name given' => sub {
|
||||
my $logger = Log::Mini->new();
|
||||
isa_ok $logger, 'Log::Mini::Logger::STDERR';
|
||||
};
|
||||
|
||||
done_testing;
|
||||
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;
|
||||
|
|
|
@ -5,6 +5,7 @@ use warnings;
|
|||
use Test::More;
|
||||
use Test::Fatal;
|
||||
|
||||
|
||||
subtest 'creates correct object' => sub {
|
||||
isa_ok(LoggerTest->new, 'LoggerTest');
|
||||
};
|
||||
|
@ -26,7 +27,7 @@ subtest 'sets log level' => sub {
|
|||
subtest 'not throws when known log level' => sub {
|
||||
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) };
|
||||
}
|
||||
};
|
||||
|
@ -39,19 +40,19 @@ subtest 'throws exception when invalid log level' => sub {
|
|||
|
||||
subtest 'prints formatted line' => sub {
|
||||
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');
|
||||
|
||||
like $output->[-1],
|
||||
qr/\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d.\d{3} \[$level\] message/;
|
||||
like $output->[-1], 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 $log = _build_logger(output => $output);
|
||||
my $log = _build_logger(output => $output);
|
||||
|
||||
my $levels = {
|
||||
error => [qw/error/],
|
||||
|
@ -73,11 +74,13 @@ subtest 'logs when level is higher' => sub {
|
|||
|
||||
subtest 'not logs when level is lower' => sub {
|
||||
my $output = [];
|
||||
my $log = _build_logger(output => $output);
|
||||
my $log = _build_logger(output => $output);
|
||||
|
||||
my $levels = {
|
||||
error => [qw/warn debug/],
|
||||
warn => [qw/debug/],
|
||||
error => [qw/warn info debug trace/],
|
||||
warn => [qw/info debug trace/],
|
||||
info => [qw/debug trace/],
|
||||
debug => [qw/trace/],
|
||||
};
|
||||
|
||||
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(@_);
|
||||
$logger->set_level('debug');
|
||||
return $logger;
|
||||
|
@ -99,9 +103,10 @@ sub _build_logger {
|
|||
done_testing;
|
||||
|
||||
package LoggerTest;
|
||||
use base 'Log::Mini::LoggerBase';
|
||||
use base 'Log::Mini::Logger::Base';
|
||||
|
||||
sub new {
|
||||
sub new
|
||||
{
|
||||
my $self = shift->SUPER::new(@_);
|
||||
my (%params) = @_;
|
||||
|
||||
|
@ -110,7 +115,8 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub _print {
|
||||
sub _print
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
push @{$self->{output}}, @_;
|
||||
|
|
|
@ -5,18 +5,18 @@ use warnings;
|
|||
use Test::More;
|
||||
use Test::Fatal;
|
||||
use File::Temp;
|
||||
use Log::Mini::LoggerFILE;
|
||||
use Log::Mini::Logger::FILE;
|
||||
|
||||
|
||||
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 {
|
||||
|
||||
for my $level (qw/error warn debug/) {
|
||||
for my $level (qw/error warn info debug trace/) {
|
||||
my $file = File::Temp->new;
|
||||
my $log = _build_logger(file => $file->filename);
|
||||
my $log = _build_logger(file => $file->filename, level => $level);
|
||||
|
||||
$log->$level('message');
|
||||
undef $log;
|
||||
|
@ -31,7 +31,8 @@ subtest 'prints to file synced' => sub {
|
|||
my $file = File::Temp->new;
|
||||
my $log = _build_logger(file => $file->filename, synced => 1);
|
||||
|
||||
for my $level (qw/error warn debug/) {
|
||||
for my $level (qw/error warn info debug trace /) {
|
||||
$log->set_level($level);
|
||||
$log->$level('message');
|
||||
|
||||
my $content = _slurp($file);
|
||||
|
@ -41,10 +42,9 @@ subtest 'prints to file synced' => sub {
|
|||
};
|
||||
|
||||
subtest 'prints to stderr with \n' => sub {
|
||||
for my $level (qw/error warn debug/) {
|
||||
|
||||
for my $level (qw/error warn info debug trace/) {
|
||||
my $file = File::Temp->new;
|
||||
my $log = _build_logger(file => $file->filename);
|
||||
my $log = _build_logger(file => $file->filename, level => $level);
|
||||
|
||||
$log->$level('message');
|
||||
|
||||
|
@ -57,9 +57,9 @@ subtest 'prints to stderr with \n' => sub {
|
|||
};
|
||||
|
||||
subtest 'prints sprintf formatted line' => sub {
|
||||
for my $level (qw/error warn debug/) {
|
||||
for my $level (qw/error warn info debug trace/) {
|
||||
my $file = File::Temp->new;
|
||||
my $log = _build_logger(file => $file->filename);
|
||||
my $log = _build_logger(file => $file->filename, level => $level);
|
||||
|
||||
$log->$level('message %s', 'formatted');
|
||||
|
||||
|
@ -79,8 +79,8 @@ sub _slurp {
|
|||
}
|
||||
|
||||
sub _build_logger {
|
||||
my $logger = Log::Mini::LoggerFILE->new(@_);
|
||||
$logger->set_level('debug');
|
||||
my $logger = Log::Mini::Logger::FILE->new(@_);
|
||||
|
||||
return $logger;
|
||||
}
|
||||
|
||||
|
|
|
@ -5,10 +5,11 @@ use warnings;
|
|||
use Test::More;
|
||||
use Test::Fatal;
|
||||
use Capture::Tiny qw(capture_stderr);
|
||||
use Log::Mini::LoggerSTDERR;
|
||||
use Log::Mini::Logger::STDERR;
|
||||
|
||||
|
||||
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 {
|
||||
|
@ -50,7 +51,7 @@ subtest 'prints sprintf formatted line' => sub {
|
|||
};
|
||||
|
||||
sub _build_logger {
|
||||
my $logger = Log::Mini::LoggerSTDERR->new;
|
||||
my $logger = Log::Mini::Logger::STDERR->new;
|
||||
$logger->set_level('debug');
|
||||
return $logger;
|
||||
}
|
||||
|
|
|
@ -8,15 +8,20 @@ use File::Temp;
|
|||
use Log::Mini;
|
||||
|
||||
|
||||
|
||||
subtest 'creates correct object LoggerFILE' => sub {
|
||||
subtest 'creates correct object Logger::FILE' => sub {
|
||||
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 {
|
||||
isa_ok(Log::Mini->new('stderr', level => 'debug'), 'Log::Mini::LoggerSTDERR');
|
||||
isa_ok(Log::Mini::LoggerSTDERR->new(level => 'debug'), 'Log::Mini::LoggerSTDERR');
|
||||
subtest 'creates correct object Logger::STDERR' => sub {
|
||||
isa_ok(Log::Mini->new('stderr', level => 'debug'), 'Log::Mini::Logger::STDERR');
|
||||
isa_ok(Log::Mini::Logger::STDERR->new(level => 'debug'), 'Log::Mini::Logger::STDERR');
|
||||
};
|
||||
|
||||
done_testing;
|
||||
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;
|
||||
|
|
Loading…
Reference in a new issue