refactor_loggers #1
12 changed files with 139 additions and 99 deletions
|
@ -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;
|
||||||
|
|
|
@ -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;
|
|
@ -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;
|
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 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;
|
|
@ -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}}, @_;
|
||||||
|
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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;
|
Loading…
Reference in a new issue