File: logger.t

package info (click to toggle)
libobject-remote-perl 0.004000-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 488 kB
  • ctags: 248
  • sloc: perl: 2,408; makefile: 7
file content (61 lines) | stat: -rw-r--r-- 2,360 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
use strictures 1;
use Test::More;
use Sys::Hostname;

$ENV{OBJECT_REMOTE_TEST_LOGGER} = 1;

use Object::Remote::Logging qw(:log router arg_levels);
use Object::Remote::Logging::Logger;
require 't/lib/ORFeedbackLogger.pm';

my $level_names = [qw(test1 test2 test3 test4 test5)];
my $logger = Object::Remote::Logging::Logger->new(
  level_names => $level_names, min_level => 'test1'
);

isa_ok($logger, 'Object::Remote::Logging::Logger');
is($logger->max_level, 'test5', 'Logger sets max_level correctly');
is($logger->format, '%l: %s', 'Default format is correct');
foreach(@$level_names) {
  is($logger->_level_active->{$_}, 1, "Level $_ is active");
}

$logger = Object::Remote::Logging::Logger->new(
  level_names => $level_names, min_level => 'test3'
);

foreach(qw(test1 test2)) {
  is($logger->_level_active->{$_}, 0, "Level $_ is inactive");
}

foreach(qw(test3 test4 test5)) {
  is($logger->_level_active->{$_}, 1, "Level $_ is active");
}

is(render_log("%%")->[0], "%\n", "Percent renders correctly");
is(render_log("%n")->[0], "\n", "New line renders correctly");
is(render_log("%p")->[0], "main\n", "Package renders correctly");
ok(defined render_log("%t")->[0], "There was a time value");
is(render_log("%r")->[0], "local\n", "Remote info renders correctly");
is(render_log("%s")->[0], "Test message\n", "Log message renders correctly");
is(render_log("%l")->[0], "info\n", "Log level renders correctly");
is(render_log("%c")->[0], "Object::Remote::Logging\n", "Log controller renders correctly");
is(render_log("%p")->[0], "main\n", "Log generating package renders correctly");
is(render_log("%m")->[0], "render_log\n", "Log generating method renders correctly");
is(render_log("%f")->[0], __FILE__ . "\n", "Log generating filename renders correctly");
my $ret = render_log("%i");
is($ret->[0], $ret->[1] . "\n", "Log generating line number renders correctly");
is(render_log("%h")->[0], hostname() . "\n", "Log generating hostname renders correctly");
is(render_log("%P")->[0], "$$\n", "Log generating process id renders correctly");

done_testing;

sub render_log {
  my ($format)= @_;
  $logger = ORFeedbackLogger->new(
    format => $format, level_names => arg_levels(), min_level => 'info');
  my $selector= sub { $logger };
  router->connect($selector, 1);
  log_info { "Test message" };
  return [$logger->feedback_output, __LINE__ - 1];
}