117 lines
2.4 KiB
Perl
117 lines
2.4 KiB
Perl
use lib 'lib';
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Test::More;
|
|
use Test::Fatal;
|
|
|
|
subtest 'creates correct object' => sub {
|
|
isa_ok(LoggerTest->new, 'LoggerTest');
|
|
};
|
|
|
|
subtest 'has default log level' => sub {
|
|
my $logger = LoggerTest->new;
|
|
|
|
is $logger->level, 'error';
|
|
};
|
|
|
|
subtest 'sets log level' => sub {
|
|
my $logger = LoggerTest->new;
|
|
|
|
$logger->set_level('debug');
|
|
|
|
is $logger->level, 'debug';
|
|
};
|
|
|
|
subtest 'not throws when known log level' => sub {
|
|
my $log = LoggerTest->new;
|
|
|
|
for my $level (qw/error warn debug/) {
|
|
ok !exception { $log->set_level($level) };
|
|
}
|
|
};
|
|
|
|
subtest 'throws exception when invalid log level' => sub {
|
|
my $log = LoggerTest->new;
|
|
|
|
ok exception { $log->set_level('unknown') };
|
|
};
|
|
|
|
subtest 'prints formatted line' => sub {
|
|
my $output = [];
|
|
my $log = _build_logger(output => $output);
|
|
|
|
for my $level (qw/error warn debug/) {
|
|
$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/;
|
|
}
|
|
};
|
|
|
|
subtest 'logs when level is higher' => sub {
|
|
my $output = [];
|
|
my $log = _build_logger(output => $output);
|
|
|
|
my $levels = {
|
|
error => [qw/error/],
|
|
warn => [qw/error warn/],
|
|
info => [qw/error warn info/],
|
|
debug => [qw/error warn info debug/],
|
|
trace => [qw/error warn info debug trace/],
|
|
};
|
|
|
|
for my $level (keys %$levels) {
|
|
$log->set_level($level);
|
|
for my $test_level (@{$levels->{$level}}) {
|
|
$log->$test_level('message');
|
|
|
|
ok $output->[-1];
|
|
}
|
|
}
|
|
};
|
|
|
|
subtest 'not logs when level is lower' => sub {
|
|
my $output = [];
|
|
my $log = _build_logger(output => $output);
|
|
|
|
my $levels = {
|
|
error => [qw/warn debug/],
|
|
warn => [qw/debug/],
|
|
};
|
|
|
|
for my $level (keys %$levels) {
|
|
$log->set_level($level);
|
|
for my $test_level (@{$levels->{$level}}) {
|
|
$log->$test_level('message');
|
|
|
|
ok !$output->[-1], "not log '$test_level' when '$level'";
|
|
}
|
|
}
|
|
};
|
|
|
|
sub _build_logger {
|
|
my $logger = LoggerTest->new(@_);
|
|
$logger->set_level('debug');
|
|
return $logger;
|
|
}
|
|
|
|
done_testing;
|
|
|
|
package LoggerTest;
|
|
use base 'Log::Mini::LoggerBase';
|
|
|
|
sub new {
|
|
my $self = shift->SUPER::new(@_);
|
|
my (%params) = @_;
|
|
|
|
$self->{output} = $params{output};
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _print {
|
|
my $self = shift;
|
|
|
|
push @{$self->{output}}, @_;
|
|
}
|