/lib/Teto/Role/Log.pm

 1package Teto::Role::Log;
 2use Mouse::Role;
 3use Data::Dumper;
 4use POSIX qw(strftime);
 5use Coro::Debug;
 6use Carp;
 7
 8my $LOG_LEVEL_TO_NUM = {
 9    DEBUG   => 9,
10    INFO    => 3,
11    NOTICE  => 2,
12    WARNING => 1,
13    ERROR   => 0,
14};
15
16sub log_extra_info { '' }
17
18sub log {
19    my ($self, $level, @args) = @_;
20    my $pkg = ref $self || $self;
21    $pkg =~ s/^Teto:://;
22    if (my $extra = $self->log_extra_info) {
23        $pkg .= " <$extra>";
24    }
25
26    my $message = join ' ', map {
27        local $Data::Dumper::Indent = 0;
28        local $Data::Dumper::Maxdepth = 1;
29        local $Data::Dumper::Terse = 1;
30        !ref $_ || overload::Method($_, '""') ? "$_" : Data::Dumper::Dumper($_);
31    } @args;
32
33    utf8::encode $message if utf8::is_utf8 $message;
34
35    if (defined (my $n = $LOG_LEVEL_TO_NUM->{ uc $level })) {
36        Coro::Debug::log $n, $message;
37    } else {
38        carp qq(Could not convert log level '$level' into Coro::Debug::log level);
39    }
40
41    my $full_message = sprintf "[%d %s] %-6s %s - %s\n",
42        0+$Coro::current, strftime('%T', localtime()), uc $level, $pkg, $message;
43
44    print STDERR $full_message;
45}
46
47sub log_coro {
48    my ($self, @args) = @_;
49    my ($pkg, $filename) = caller;
50    $pkg =~ s/^Teto:://;
51    $pkg = $filename if $filename !~ /\.pm$/;
52    my $msg = sprintf "%s - %s\n",
53        $pkg,
54        join ' ', map {
55            local $Data::Dumper::Indent = 0;
56            local $Data::Dumper::Maxdepth = 1;
57            local $Data::Dumper::Terse = 1;
58            !ref $_ || overload::Method($_, '""') ? "$_" : Data::Dumper::Dumper($_);
59        } @args;
60    $msg =~ s/[\r\n]//g;
61    $Coro::current->desc($msg);
62}
63
641;